summaryrefslogtreecommitdiffstats
path: root/scripts
diff options
context:
space:
mode:
Diffstat (limited to 'scripts')
-rw-r--r--scripts/0x0st.pl215
-rw-r--r--scripts/8-ball.pl131
-rw-r--r--scripts/Cirssi.pl802
-rw-r--r--scripts/UNIBG-autoident.pl242
-rw-r--r--scripts/XMMSInfo.pm308
-rw-r--r--scripts/accent.pl153
-rw-r--r--scripts/act.pl54
-rw-r--r--scripts/active_notice.pl207
-rw-r--r--scripts/active_notify.pl157
-rw-r--r--scripts/adv_windowlist.pl2988
-rw-r--r--scripts/ai.pl265
-rw-r--r--scripts/aidle.pl80
-rw-r--r--scripts/akftp.pl96
-rw-r--r--scripts/akilluser.pl92
-rw-r--r--scripts/alame.pl36
-rw-r--r--scripts/anotherway.pl54
-rw-r--r--scripts/antiplenk.pl47
-rw-r--r--scripts/apm.pl122
-rw-r--r--scripts/armeija.pl267
-rw-r--r--scripts/ascii.pl405
-rw-r--r--scripts/auto_away.pl90
-rw-r--r--scripts/auto_whois.pl80
-rw-r--r--scripts/autoaway.pl130
-rw-r--r--scripts/autochannel.pl69
-rw-r--r--scripts/autocycle.pl47
-rw-r--r--scripts/autolimit.pl53
-rw-r--r--scripts/autoopper.pl412
-rw-r--r--scripts/autorealname.pl304
-rw-r--r--scripts/autorejoinpunish.pl124
-rw-r--r--scripts/autoreminder.pl147
-rw-r--r--scripts/autoversion.pl25
-rw-r--r--scripts/autovoice.pl684
-rw-r--r--scripts/autowhois.pl39
-rw-r--r--scripts/autowrap.pl38
-rw-r--r--scripts/away.pl199
-rw-r--r--scripts/away2web.pl58
-rw-r--r--scripts/away_hilight_notice.pl215
-rw-r--r--scripts/away_verbose.pl234
-rw-r--r--scripts/awaybar.pl44
-rw-r--r--scripts/awaylogcnt.pl59
-rw-r--r--scripts/awayproxy.pl279
-rw-r--r--scripts/badword.pl163
-rw-r--r--scripts/ban.pl394
-rw-r--r--scripts/bandwidth.pl115
-rw-r--r--scripts/bansearch.pl421
-rw-r--r--scripts/bantime.pl110
-rw-r--r--scripts/beep.pl50
-rw-r--r--scripts/beep_beep.pl54
-rw-r--r--scripts/beepaway.pl41
-rw-r--r--scripts/bestoiber.pl61
-rw-r--r--scripts/bgta.pl284
-rw-r--r--scripts/binary.pl114
-rw-r--r--scripts/bitlbee_blist.pl77
-rw-r--r--scripts/bitlbee_join_notice.pl109
-rw-r--r--scripts/bitlbee_nick_change.pl72
-rw-r--r--scripts/bitlbee_tab_completion.pl88
-rw-r--r--scripts/bitlbee_typing_notice.pl349
-rw-r--r--scripts/blowjob.pl555
-rw-r--r--scripts/bmi.pl45
-rw-r--r--scripts/calc.pl30
-rw-r--r--scripts/callerid.pl135
-rw-r--r--scripts/cap_sasl.pl437
-rw-r--r--scripts/centericq.pl342
-rw-r--r--scripts/cgrep.pl192
-rw-r--r--scripts/challenge.pl106
-rw-r--r--scripts/chanact.pl756
-rw-r--r--scripts/chanfull.pl48
-rw-r--r--scripts/chanfull_duden.pl47
-rw-r--r--scripts/chankeys.pl570
-rw-r--r--scripts/chanpeak.pl182
-rw-r--r--scripts/chansearch.pl300
-rw-r--r--scripts/chanshare.pl122
-rw-r--r--scripts/chansort.pl79
-rw-r--r--scripts/chansync.pl75
-rw-r--r--scripts/chops.pl144
-rw-r--r--scripts/cleanpublic.pl41
-rw-r--r--scripts/clipboard.pl90
-rw-r--r--scripts/cloneprot.pl89
-rw-r--r--scripts/clones.pl55
-rw-r--r--scripts/colored_nicks.pl479
-rw-r--r--scripts/colorize_nicks.pl217
-rw-r--r--scripts/colorkick.pl69
-rw-r--r--scripts/connectcmd.pl165
-rw-r--r--scripts/copy.pl290
-rw-r--r--scripts/countdown.pl59
-rw-r--r--scripts/country.pl325
-rw-r--r--scripts/cp1250_kick.pl65
-rw-r--r--scripts/crapbuster.pl45
-rw-r--r--scripts/cron.pl306
-rw-r--r--scripts/ctrlact.pl1087
-rw-r--r--scripts/cubes.pl55
-rw-r--r--scripts/cwho.pl79
-rw-r--r--scripts/dancer_forwardfix.pl58
-rw-r--r--scripts/dancer_hide_477.pl54
-rw-r--r--scripts/dau.pl5750
-rw-r--r--scripts/dcc_ip.pl117
-rw-r--r--scripts/dccmove.pl43
-rw-r--r--scripts/dccself.pl38
-rw-r--r--scripts/dccstat.pl501
-rw-r--r--scripts/defaultchanmode.pl98
-rw-r--r--scripts/desktop-notify.pl120
-rw-r--r--scripts/df.pl157
-rw-r--r--scripts/dice.pl191
-rw-r--r--scripts/dictcomplete.pl78
-rw-r--r--scripts/dim_nicks.pl431
-rw-r--r--scripts/discord_unbridge.pl45
-rw-r--r--scripts/dispatch.pl26
-rw-r--r--scripts/doc.pl276
-rw-r--r--scripts/doublefilter.pl113
-rw-r--r--scripts/dtach_away.pl209
-rw-r--r--scripts/duckduckgo.pl256
-rw-r--r--scripts/elist.pl137
-rw-r--r--scripts/eliza.pl107
-rw-r--r--scripts/email_msgs.pl305
-rw-r--r--scripts/emaildb.pl131
-rw-r--r--scripts/emaildb1.0.pl0
-rw-r--r--scripts/eng_no_translate_dpryo.pl57
-rw-r--r--scripts/events.pl54
-rw-r--r--scripts/exec_clean.pl52
-rw-r--r--scripts/fakectcp.pl277
-rw-r--r--scripts/figlet.pl58
-rw-r--r--scripts/file.pl102
-rw-r--r--scripts/find.pl45
-rw-r--r--scripts/findbot.pl984
-rw-r--r--scripts/fleech.pl948
-rw-r--r--scripts/fnotify.pl140
-rw-r--r--scripts/follow.pl72
-rw-r--r--scripts/foo.pl75
-rw-r--r--scripts/foreach_user.pl59
-rw-r--r--scripts/fortune.pl124
-rw-r--r--scripts/forward.pl128
-rw-r--r--scripts/fpaste.pl264
-rw-r--r--scripts/freenode_filter.pl122
-rw-r--r--scripts/friends_shasta.pl2719
-rw-r--r--scripts/fserve.pl3578
-rw-r--r--scripts/fuckem.pl86
-rw-r--r--scripts/getop.pl387
-rw-r--r--scripts/gimmie.pl39
-rw-r--r--scripts/gitscriptassist.pl631
-rw-r--r--scripts/go.pl115
-rw-r--r--scripts/go2.pl495
-rw-r--r--scripts/google.pl224
-rw-r--r--scripts/gpgvalidator.pl224
-rw-r--r--scripts/grep.pl82
-rw-r--r--scripts/guts.pl21
-rw-r--r--scripts/hddtemp.pl183
-rw-r--r--scripts/hello.pl55
-rw-r--r--scripts/hide.pl177
-rw-r--r--scripts/hideauth.pl63
-rw-r--r--scripts/hideshow.pl319
-rw-r--r--scripts/highlite.pl113
-rw-r--r--scripts/hignore.pl78
-rw-r--r--scripts/hilightwin.pl85
-rw-r--r--scripts/history_search.pl146
-rw-r--r--scripts/hl.pl53
-rw-r--r--scripts/hlbot.pl217
-rw-r--r--scripts/hostname.pl157
-rw-r--r--scripts/iMPD.pl1179
-rw-r--r--scripts/identify-md5.pl168
-rw-r--r--scripts/idlesince.pl32
-rw-r--r--scripts/idletime.pl70
-rw-r--r--scripts/idonkey.pl1408
-rw-r--r--scripts/ignore_log.pl78
-rw-r--r--scripts/ignoreoc.pl65
-rw-r--r--scripts/il.pl133
-rw-r--r--scripts/imdb.pl115
-rw-r--r--scripts/intercept.pl217
-rw-r--r--scripts/invitejoin.pl298
-rw-r--r--scripts/ipupdate.pl39
-rw-r--r--scripts/irccomplete.pl213
-rw-r--r--scripts/ircgallery.pl257
-rw-r--r--scripts/ircgmessagenotify.pl218
-rw-r--r--scripts/ircops.pl44
-rw-r--r--scripts/ircsec.pl205
-rw-r--r--scripts/irssiBlaster.pl446
-rw-r--r--scripts/isdn.pl58
-rw-r--r--scripts/itime.pl47
-rw-r--r--scripts/ixmmsa.pl63
-rw-r--r--scripts/joininfo.pl1097
-rw-r--r--scripts/kban-referrals.pl372
-rw-r--r--scripts/kblamehost.pl65
-rw-r--r--scripts/keepnick.pl387
-rw-r--r--scripts/kenny.pl92
-rw-r--r--scripts/kernel.pl37
-rw-r--r--scripts/kicks.pl253
-rw-r--r--scripts/kill_fake_gets.pl131
-rw-r--r--scripts/kline_warning.pl147
-rw-r--r--scripts/l33tmusic.pl283
-rw-r--r--scripts/lastspoke.pl210
-rw-r--r--scripts/len.pl374
-rw-r--r--scripts/leodict.pl435
-rw-r--r--scripts/licq.pl66
-rw-r--r--scripts/linkchan.pl488
-rw-r--r--scripts/listen.pl163
-rw-r--r--scripts/loadavg.pl47
-rw-r--r--scripts/localize.pl1642
-rw-r--r--scripts/log2ansi.pl419
-rw-r--r--scripts/logcompress.pl24
-rw-r--r--scripts/logresume.pl253
-rw-r--r--scripts/ls.pl40
-rw-r--r--scripts/mailcheck_imap.pl566
-rw-r--r--scripts/mailcheck_mbox_flux.pl126
-rw-r--r--scripts/mailcheck_pop3_kimmo.pl120
-rw-r--r--scripts/mangle.pl721
-rw-r--r--scripts/map.pl129
-rw-r--r--scripts/mass_hilight_blocker.pl62
-rw-r--r--scripts/miodek.pl368
-rw-r--r--scripts/mkick.pl114
-rw-r--r--scripts/mkshorterlink.pl219
-rw-r--r--scripts/mldonkey_bandwidth.pl51
-rw-r--r--scripts/modelist-r.pl468
-rw-r--r--scripts/modelist.pl153
-rw-r--r--scripts/mood.pl202
-rw-r--r--scripts/morse.pl347
-rw-r--r--scripts/mouse.pl168
-rw-r--r--scripts/mpg123.pl86
-rw-r--r--scripts/multipaste.pl151
-rw-r--r--scripts/my_beep.pl61
-rw-r--r--scripts/mygoogle.pl114
-rw-r--r--scripts/myimdb.pl114
-rw-r--r--scripts/mysqlurllogger.pl82
-rw-r--r--scripts/nact.pl335
-rw-r--r--scripts/news.pl282
-rw-r--r--scripts/newsline.pl453
-rw-r--r--scripts/nickban.pl66
-rw-r--r--scripts/nickcolor_expando.pl1065
-rw-r--r--scripts/nickident.pl230
-rw-r--r--scripts/nickignore.pl49
-rw-r--r--scripts/nicklist.pl828
-rw-r--r--scripts/nickmix-c0ffee.pl89
-rw-r--r--scripts/nickmix_pasky.pl74
-rw-r--r--scripts/nickserv.pl684
-rw-r--r--scripts/niq.pl296
-rw-r--r--scripts/nocaps.pl96
-rw-r--r--scripts/nocollide.pl118
-rw-r--r--scripts/noisyquery.pl33
-rw-r--r--scripts/nopl.pl66
-rw-r--r--scripts/norepeat.pl76
-rw-r--r--scripts/noteserve.pl89
-rw-r--r--scripts/noticemove.pl49
-rw-r--r--scripts/notonline.pl76
-rw-r--r--scripts/ogg123.pl95
-rw-r--r--scripts/oidenty.pl75
-rw-r--r--scripts/on.pl287
-rw-r--r--scripts/ontv.pl339
-rw-r--r--scripts/oops.pl90
-rw-r--r--scripts/oopsie.pl50
-rw-r--r--scripts/openurl.pl269
-rw-r--r--scripts/operit.pl320
-rw-r--r--scripts/operview.pl422
-rw-r--r--scripts/opnotice.pl56
-rw-r--r--scripts/opnotify.pl47
-rw-r--r--scripts/osd.pl313
-rw-r--r--scripts/page-c0ffee.pl116
-rw-r--r--scripts/page_reeler.pl47
-rw-r--r--scripts/pager.pl127
-rw-r--r--scripts/pangotext.pl253
-rw-r--r--scripts/paste-derwan.pl184
-rw-r--r--scripts/paste_derwan.pl381
-rw-r--r--scripts/paste_huggie.pl187
-rw-r--r--scripts/paste_kimmoke.pl110
-rw-r--r--scripts/pelix.pl235
-rw-r--r--scripts/perlalias.pl1026
-rw-r--r--scripts/pggb_sound.pl251
-rw-r--r--scripts/phpdoc.pl134
-rw-r--r--scripts/poison.pl341
-rw-r--r--scripts/postpone.pl119
-rw-r--r--scripts/ppl.pl210
-rw-r--r--scripts/print_signals.pl319
-rw-r--r--scripts/q_username.pl26
-rw-r--r--scripts/query-connection-notifier.pl67
-rw-r--r--scripts/query.pl593
-rw-r--r--scripts/queryresume.pl64
-rw-r--r--scripts/quiet.pl90
-rw-r--r--scripts/quitrand.pl52
-rw-r--r--scripts/quiz.pl451
-rw-r--r--scripts/quizgr.pl655
-rw-r--r--scripts/quizmaster.pl354
-rw-r--r--scripts/rainbow.pl173
-rw-r--r--scripts/randaway.pl119
-rw-r--r--scripts/randname.pl46
-rw-r--r--scripts/relm.pl93
-rw-r--r--scripts/remote.pl91
-rw-r--r--scripts/repeat.pl144
-rw-r--r--scripts/resize_split.pl62
-rw-r--r--scripts/revolve.pl388
-rw-r--r--scripts/rk.pl53
-rw-r--r--scripts/romaji.pl273
-rw-r--r--scripts/romajibind.pl301
-rw-r--r--scripts/rot13.pl77
-rw-r--r--scripts/rotator.pl138
-rw-r--r--scripts/sana.pl66
-rw-r--r--scripts/sana_cmd.pl57
-rw-r--r--scripts/schwaebisch.pl191
-rw-r--r--scripts/screen_away.pl248
-rw-r--r--scripts/scripthelp.pl39
-rw-r--r--scripts/scriptinfo.pl118
-rw-r--r--scripts/scroller.pl97
-rw-r--r--scripts/seen.pl1198
-rw-r--r--scripts/servercomplete.pl85
-rw-r--r--scripts/seti.pl50
-rw-r--r--scripts/shortenurl.pl170
-rw-r--r--scripts/showhilight.pl32
-rw-r--r--scripts/showhost.pl68
-rw-r--r--scripts/showmode.pl83
-rw-r--r--scripts/smiley.pl43
-rw-r--r--scripts/sms.pl439
-rw-r--r--scripts/snmpup.pl101
-rw-r--r--scripts/spambot.pl80
-rw-r--r--scripts/special_complete.pl30
-rw-r--r--scripts/spellcheck.pl301
-rw-r--r--scripts/sping.pl41
-rw-r--r--scripts/stocks.pl431
-rw-r--r--scripts/synccheck.pl346
-rw-r--r--scripts/sysinfo277-irssi.pl546
-rw-r--r--scripts/sysinfo_dg.pl330
-rw-r--r--scripts/sysinfoplus.pl107
-rw-r--r--scripts/tab_stop.pl61
-rw-r--r--scripts/talk.pl274
-rw-r--r--scripts/target.pl163
-rw-r--r--scripts/thankop.pl134
-rw-r--r--scripts/theme.pl451
-rw-r--r--scripts/thistory.pl162
-rw-r--r--scripts/tictactoe.pl665
-rw-r--r--scripts/timer.pl177
-rw-r--r--scripts/tinyurl.pl47
-rw-r--r--scripts/title.pl150
-rw-r--r--scripts/tlock.pl81
-rw-r--r--scripts/tmux-nicklist-portable.pl432
-rw-r--r--scripts/topic-diff.pl86
-rw-r--r--scripts/topics.pl126
-rw-r--r--scripts/topicsed.pl61
-rw-r--r--scripts/track.pl310
-rw-r--r--scripts/trackbar.pl606
-rw-r--r--scripts/tracknick.pl201
-rw-r--r--scripts/trigger.pl1300
-rw-r--r--scripts/trustweb.pl374
-rw-r--r--scripts/tvmusor.pl143
-rw-r--r--scripts/twirssi.pl4217
-rw-r--r--scripts/twprompt.pl100
-rw-r--r--scripts/twsocials.pl1154
-rw-r--r--scripts/twtopic.pl120
-rw-r--r--scripts/u.pl69
-rw-r--r--scripts/upgradeinfo.pl87
-rw-r--r--scripts/uptime.pl138
-rw-r--r--scripts/url.pl329
-rw-r--r--scripts/url_log.pl399
-rw-r--r--scripts/urlfeed.pl262
-rw-r--r--scripts/urlgrab.pl71
-rw-r--r--scripts/urlplot.pl841
-rw-r--r--scripts/urlwindow.pl47
-rw-r--r--scripts/userhost.pl103
-rw-r--r--scripts/users.pl270
-rw-r--r--scripts/version-stat.pl88
-rw-r--r--scripts/verstats.pl81
-rw-r--r--scripts/vowels.pl93
-rw-r--r--scripts/warnkick.pl71
-rw-r--r--scripts/washnicks.pl79
-rw-r--r--scripts/watch.pl179
-rw-r--r--scripts/whitelist.pl445
-rw-r--r--scripts/whois.pl38
-rw-r--r--scripts/whos.pl109
-rw-r--r--scripts/wilm.pl54
-rw-r--r--scripts/wkb.pl68
-rw-r--r--scripts/wlstat.pl669
-rw-r--r--scripts/wordcompletition.pl144
-rw-r--r--scripts/wordscramble.pl160
-rw-r--r--scripts/xauth.pl546
-rw-r--r--scripts/xcmd.pl65
-rw-r--r--scripts/xdccget.pl650
-rw-r--r--scripts/xetra.pl209
-rw-r--r--scripts/xlist.pl65
-rw-r--r--scripts/xmms.pl161
-rw-r--r--scripts/xmms2.pl86
-rw-r--r--scripts/xmmsinfo.pl116
-rw-r--r--scripts/xqf.pl238
376 files changed, 99772 insertions, 0 deletions
diff --git a/scripts/0x0st.pl b/scripts/0x0st.pl
new file mode 100644
index 0000000..be57ba1
--- /dev/null
+++ b/scripts/0x0st.pl
@@ -0,0 +1,215 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use POSIX;
+use Irssi;
+use HTTP::Request::Common;
+use LWP::UserAgent;
+use Storable qw/store_fd fd_retrieve/;
+use File::Glob qw/:bsd_glob/;
+
+$VERSION = '0.04';
+%IRSSI = (
+ authors => 'bw1',
+ contact => 'bw1@aol.at',
+ name => '0x0st',
+ description => 'upload file to https://0x0.st/',
+ license => 'ISC',
+ url => 'https://scripts.irssi.org/',
+ changed => '2021-01-13',
+ modules => 'POSIX HTTP::Request::Common LWP::UserAgent Storable File::Glob',
+ commands=> '0x0st',
+ selfcheckcmd=> '0x0st -c',
+);
+
+my $help = << "END";
+%9Name%9
+ $IRSSI{name}
+%9Version%9
+ $VERSION
+%9Syntax%9
+ /0x0st [-p] [-s <URL> | -u <URL> | file ]
+ /0x0st -c
+%9Description%9
+ $IRSSI{description}
+ -p past url to channel
+ -s shorten url
+ -u file from url
+ -c self check
+%9See also%9
+ https://0x0.st/
+ https://github.com/lachs0r/0x0
+END
+
+my $test_str;
+
+my $base_uri;
+
+my %bg_process= ();
+my $self_check_timer;
+
+sub background {
+ my ($cmd) =@_;
+ my ($fh_r, $fh_w);
+ pipe $fh_r, $fh_w;
+ my $pid = fork();
+ if ($pid ==0 ) {
+ my @res;
+ @res= &{$cmd->{cmd}}(@{$cmd->{args}});
+ store_fd \@res, $fh_w;
+ close $fh_w;
+ POSIX::_exit(1);
+ } else {
+ $cmd->{fh_r}=$fh_r;
+ Irssi::pidwait_add($pid);
+ $bg_process{$pid}=$cmd;
+ }
+}
+
+sub sig_pidwait {
+ my ($pid, $status) = @_;
+ if (exists $bg_process{$pid}) {
+ my @res= @{ fd_retrieve($bg_process{$pid}->{fh_r})};
+ $bg_process{$pid}->{res}=[@res];
+ if (exists $bg_process{$pid}->{last}) {
+ foreach my $p (@{$bg_process{$pid}->{last}}) {
+ &$p($bg_process{$pid});
+ }
+ } else {
+ Irssi::print(join(" ",@res), MSGLEVEL_CLIENTCRAP);
+ }
+ delete $bg_process{$pid};
+ }
+}
+
+sub upload {
+ my ($filename) = @_;
+ my $ua = LWP::UserAgent->new(agent=>'wget');
+ my $filename = bsd_glob $filename;
+ if (-e $filename) {
+ my $re = $ua->request(POST $base_uri,
+ Content_Type => 'form-data',
+ Content =>
+ {file=>[$filename]}
+ );
+ my $res= $re->content;
+ my $code= $re->code();
+ chomp $res;
+ return $res, $code;
+ }
+}
+
+sub url {
+ my ($url) = @_;
+ my $ua = LWP::UserAgent->new(agent=>'wget');
+ my $re = $ua->request(POST $base_uri,
+ {url=> $url}
+ );
+ my $res= $re->content;
+ my $code= $re->code();
+ chomp $res;
+ return $res, $code;
+}
+
+sub shorten {
+ my ($url) = @_;
+ my $ua = LWP::UserAgent->new(agent=>'wget');
+ my $re = $ua->request(POST $base_uri,
+ {shorten=> $url}
+ );
+ my $res= $re->content;
+ my $code= $re->code();
+ chomp $res;
+ return $res, $code;
+}
+
+sub past2channel {
+ my ($cmd) = @_;
+ my $witem = $cmd->{witem};
+ if (defined $witem && (int($cmd->{res}[1] / 100) == 2)) {
+ $witem->command("msg * $cmd->{res}[0]");
+ } else {
+ Irssi::print($cmd->{res}[0],MSGLEVEL_CLIENTCRAP);
+ }
+}
+
+sub cmd {
+ my ($args, $server, $witem)=@_;
+ my ($opt, $arg) = Irssi::command_parse_options($IRSSI{'name'}, $args);
+
+ if (length($args) >0 ) {
+ my $cmd;
+ if (exists $opt->{p}) {
+ $cmd->{last}=[\&past2channel];
+ $cmd->{witem}=$witem;
+ }
+ if (exists $opt->{u}) {
+ $cmd->{cmd}=\&url;
+ $cmd->{args}=[$arg];
+ background( $cmd );
+ } elsif (exists $opt->{s}) {
+ $cmd->{cmd}=\&shorten;
+ $cmd->{args}=[$arg];
+ background( $cmd );
+ } elsif (exists $opt->{c}) {
+ $cmd->{cmd}=\&shorten;
+ $cmd->{args}=['https://scripts.irssi.org/'];
+ $cmd->{last}=[\&self_check];
+ $self_check_timer= Irssi::timeout_add_once(2000, \&self_check, '');
+ background( $cmd );
+ } else {
+ $cmd->{cmd}=\&upload;
+ $cmd->{args}=[$arg];
+ background( $cmd );
+ }
+ } else {
+ cmd_help($IRSSI{'name'});
+ }
+}
+
+sub self_check {
+ my ( $arg )=@_;
+ my $s='ok';
+ my @res;
+ if ( ref($arg) ne 'HASH' ) {
+ $s = 'Error: timeout';
+ } else {
+ @res= @{$arg->{res}};
+ Irssi::timeout_remove($self_check_timer);
+ Irssi::print("0x0st: surl: $res[0] stat: $res[1]", MSGLEVEL_CLIENTCRAP);
+ if ( 2 != scalar (@res ) ) {
+ $s = 'Error: arg count';
+ } elsif ( $res[1] != 200 ) {
+ $s = "Error: HTTP status code ($res[1])";
+ } elsif ( $res[0] !~ m/^http/ ) {
+ $s = "Error: result ($res[0])";
+ }
+ }
+ Irssi::print("0x0st: selfcheck $s", MSGLEVEL_CLIENTCRAP);
+ my $schs_version = $Irssi::Script::selfcheckhelperscript::VERSION;
+ Irssi::command("selfcheckhelperscript $s") if (defined $schs_version);
+}
+
+sub cmd_help {
+ my ($args, $server, $witem)=@_;
+ $args=~ s/\s+//g;
+ if ($IRSSI{name} eq $args) {
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop();
+ }
+}
+
+sub sig_setup_changed {
+ $base_uri= Irssi::settings_get_str($IRSSI{name}.'_base_uri');
+}
+
+Irssi::signal_add('setup changed', \&sig_setup_changed);
+Irssi::signal_add('pidwait', \&sig_pidwait);
+
+Irssi::settings_add_str($IRSSI{name} ,$IRSSI{name}.'_base_uri', 'https://0x0.st/');
+
+Irssi::command_bind($IRSSI{name}, \&cmd);
+Irssi::command_bind('help', \&cmd_help);
+Irssi::command_set_options($IRSSI{name},"p u s c");
+
+sig_setup_changed();
diff --git a/scripts/8-ball.pl b/scripts/8-ball.pl
new file mode 100644
index 0000000..cb8a0df
--- /dev/null
+++ b/scripts/8-ball.pl
@@ -0,0 +1,131 @@
+#8-ball / decision ball
+#
+#What is this?
+#
+#The 8-ball (Eight-ball) is a decision ball which i bought
+#in a gadget shop when i was in London. I then came up with
+#the idea to make an irc-version of this one :)
+#There are 16 possible answers that the ball may give you.
+#
+#
+#usage
+#
+#Anyone in the same channel as the one who runs this script may
+#write "8-ball: question ?" without quotes and where question is
+#a question to ask the 8-ball.
+#An answer is given randomly. The possible answers are the exact
+#same answers that the real 8-ball gives.
+#
+#Write "8-ball" without quotes to have the the ball tell you
+#how money questions it've got totally.
+#
+#Write "8-ball version" without quotes to have him tell what
+#his version is.
+#
+#
+use strict;
+use warnings;
+use vars qw($VERSION %IRSSI);
+
+use Irssi qw(command_bind signal_add);
+use IO::File;
+$VERSION = '0.23';
+%IRSSI = (
+ authors => 'Patrik Akerfeldt',
+ contact => 'patrik.akerfeldt@gmail.com',
+ name => '8-ball',
+ description => 'Dont like to take decisions? Have the 8-ball do it for you instead.',
+ license => 'GPL',
+);
+
+my $filename= Irssi::get_irssi_dir().'/8-ball';
+
+sub own_question {
+ my ($server, $msg, $target) = @_;
+ question($server, $msg, "", $target);
+}
+
+sub public_question {
+ my ($server, $msg, $nick, $address, $target) = @_;
+ question($server, $msg, $nick.": ", $target);
+}
+sub question {
+ my ($server, $msg, $nick, $target) = @_;
+ $_ = $msg;
+ if (!/^8-ball/i) { return 0; }
+
+ if (/^8-ball:.+\?$/i) {
+ # From: "The 8-Ball Answers", http://8ball.ofb.net/answers.html
+ my @answers = (
+ 'Signs point to yes.',
+ 'Yes.',
+ 'Reply hazy, try again.',
+ 'Without a doubt.',
+ 'My sources say no.',
+ 'As I see it, yes.',
+ 'You may rely on it.',
+ 'Concentrate and ask again.',
+ 'Outlook not so good.',
+ 'It is decidedly so.',
+ 'Better not tell you now.',
+ 'Very doubtful.',
+ 'Yes - definitely.',
+ 'It is certain.',
+ 'Cannot predict now.',
+ 'Most likely.',
+ 'Ask again later.',
+ 'My reply is no.',
+ 'Outlook good.',
+ 'Don\'t count on it.'
+ );
+
+ $server->command('msg '.$target.' '.$nick.'8-ball says: '.$answers[rand @answers]);
+
+ my ($fh, $count);
+ $fh = new IO::File;
+ $count = 0;
+ if ($fh->open($filename, 'r')){
+ $count = <$fh>;
+ $fh->close;
+ }
+ $count++;
+ $fh = new IO::File;
+ if ($fh->open($filename, 'w')){
+ print $fh $count;
+ $fh->close;
+ }else{
+ print "Couldn't open file for output. The value $count couldn't be written.";
+ return 1;
+ }
+ return 0;
+ } elsif (/^8-ball$/i) {
+
+ my ($fh, $count);
+ $fh = new IO::File;
+ $count = 0;
+ if ($fh->open($filename, 'r')){
+ $count = <$fh>;
+ $server->command('msg '.$target.' 8-ball says: I\'ve got '.$count.' questions so far.');
+ $fh->close;
+ }else{
+ print "Couldn't open file for input";
+ return 1;
+ }
+ return 0;
+
+ } elsif (/^8-ball version$/i){
+ $server->command('msg '.$target.' My version is: '.$VERSION);
+ return 0;
+ } else {
+ if(!/^8-ball says/i){
+ $server->command('msg '.$target.' '.$nick.'A question please.');
+ return 0;
+ }
+ }
+
+}
+
+signal_add("message public", "public_question");
+signal_add("message own_public", "own_question");
+
+# vim:set ts=8 sw=8:
diff --git a/scripts/Cirssi.pl b/scripts/Cirssi.pl
new file mode 100644
index 0000000..92e0b9f
--- /dev/null
+++ b/scripts/Cirssi.pl
@@ -0,0 +1,802 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+# Consolidate Irssi Player
+#
+# Copyright (C) 2009 Dani Soufi
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+#
+# Change Log:
+# v2.2:
+# - change the audacious and audtool command name
+# v2.0.1b:
+# - Cleaning some unusefull code.
+# - Show an error when a command is executed in a wrong window, instead of exiting silently.
+# v2.0.0:
+# - Start/Play(Toggle)/Stop/Pause/Unpause/Next/Previous/Volume MOC Player control functions are added.
+# - MOC Player support is implemented.
+# v1.1.2:
+# - The script is now meant to be a bit more intelligent in dealing with song tags and different user song display settings.
+# - Display album name in --details if it exists.
+# v1.1.0:
+# - Script's name is renamed to Consolidate Irssi Player on global basis to expand it's use in the future.
+# - Removed cmd_shuffle{} and cmd_repeat{} functions since they aren't supported anymore by Audacious2.
+# - Added use --details flag for bitrate and frequency details in current playing song.
+# - Added Jump to specific song in the playing list according to track number.
+# - Added Volume control support from Irssi.
+# - Updated the script to work with the newest Audacious v2 and audtool2 available.
+# v1.0.4:
+# - Added Repeat on/off capability
+# - Added Shuffle on/off capability
+# - Fixed script output handling for audacious version in case audacious isn't running
+# - If encountered a problem with audacious version, try changing `audacious --version` to `audtool -v`
+# v1.0.3:
+# - Added Playlist functionality
+# - Added Song details (Bitrate/Frequency/Length/Volume)
+# - Current song notice with song details (Optional)
+# v1.0.2:
+# - The script now handles warning support if you got audacious not running
+# - Added track number, current time elapse and total track time
+# - Added Stop functionality
+# v1.0.1:
+# - Added ability to autonotify the channel after skipping a song (optional)
+# - Added Skip/Play/Pause/Resume calls
+#
+# How To Use?
+# Copy your script into ~/.irssi/scripts/ directory
+# Load your script with /script load audacious in your Irssi Client
+# Type '/audacious help' in any channel for script commands
+# For autoload insert your script into ~/.irssi/scripts/autorun/ directory
+# Even better would be if you placed them in ~/.irssi/scripts/ and created symlinks in autorun directory
+#
+use Irssi;
+use IPC::Open3;
+
+$VERSION = '2.2';
+%IRSSI = (
+ authors => "Dani Soufi (compengi)",
+ contact => "IRC: Freenode network, #ubuntu-lb",
+ name => "Consolidate Irssi Player",
+ description => "Controls Audacious2 and MOCP from Irssi",
+ license => "GNU General Public License",
+ url => "http://git.peersnode.net/",
+ changed => "2019-01-20",
+);
+
+#################################################################################
+# Please do not change anything below this, unless you know what you are doing. #
+#################################################################################
+
+# command names of audacious and audtool
+my $c_audtool="audtool";
+my $c_audacious="audacious";
+
+# Give an error when a command is used where it was not supposed to, instead
+# of exiting silently. Much better this way.
+sub cmd_err {
+ print "Error: This command can't be executed in this window.";
+}
+
+sub cmd_aud_song {
+ my ($data, $server, $witem) = @_;
+ # Get current song information.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ my ($position, $song, $current, $total, $artist, $album, $title,
+ $total, $bitrate, $frequency, $album);
+
+ chomp($position = `$c_audtool --playlist-position`);
+ chomp($song = `$c_audtool --current-song`);
+ chomp($current = `$c_audtool --current-song-output-length`);
+ chomp($total = `$c_audtool --current-song-length`);
+ chomp($artist = `$c_audtool --current-song-tuple-data artist`);
+ chomp($album = `$c_audtool current-song-tuple-data album`);
+ chomp($title = `$c_audtool --current-song-tuple-data title`);
+ chomp($total = `$c_audtool --current-song-length`);
+ chomp($bitrate = `$c_audtool --current-song-bitrate-kbps`);
+ chomp($frequency = `$c_audtool --current-song-frequency-khz`);
+ chomp($album = `$c_audtool current-song-tuple-data album`);
+
+
+ # Read output.
+ my ( $wtr, $rdr, $err );
+ my $pid = open3( $wtr, $rdr, $err,
+ $c_audtool, '--current-song-tuple-data', 'file-name') or die $!;
+
+ # Make it global.
+ my $file;
+ {
+ local $/;
+ $file = <$rdr>;
+ $file =~ s/\.(?i:mp3|cda|aa3|ac3|aif|ape|med|mpu|wave|mpc|oga|wma|ogg|wav|aac|flac)\n//;
+ }
+
+ if (`ps -C $c_audacious` =~ /audacious/) {
+ if ($data ne "--details") {
+
+ # If we notice that the user sorted his playlist
+ # by song title, we will try to be nice and parse
+ # the existing artist for him.
+ if ($song !~ /$artist/) {
+ # If $song is different from $album,
+ # we add the artist to output line.
+ # Else strip the album from $song.
+ if ($song !~ /$album/) {
+ # If we have no song tags, $song will be set to the file's name.
+ # In this case, we drop the file's extension know to us and print it.
+ if ($song =~ /$file/) {
+ $witem->command("/me is listening to: $file ($current/$total)");
+ }
+ else {
+ $witem->command("/me is listening to: $artist - $song ($current/$total)");
+ }
+ }
+ else {
+ $song =~ s/$album - //im;
+ $witem->command("/me is listening to: $artist - $song ($current/$total)");
+ }
+ }
+ else {
+ $witem->command("/me is listening to: $artist - $title ($current/$total)");
+ }
+ }
+ # Show more details in our output.
+ if ($data eq "--details") {
+
+ # Check against an empty string.
+ # If it's empty, we don't print it.
+ if ($album ne "") {
+ # Make sure $song doesn't match $artist.
+ # Else we print the $song as it is.
+ if ($song !~ /$artist/) {
+ # If $song is different from $album,
+ # we add the artist to output line.
+ # Else strip the album from $song.
+ if ($song !~ /$album/) {
+ if ($song =~ /$file/) {
+ $witem->command("/me is listening to: $artist - $song from $album ($current/$total) [$bitrate Kbps/$frequency KHz]");
+ }
+ }
+ else {
+ $witem->command("/me is listening to: $artist - $title from $album ($current/$total) [$bitrate Kbps/$frequency KHz]");
+ }
+ }
+ elsif ($song =~ /\[ $album \]/) {
+ $witem->command("/me is listening to: $artist - $title from $album ($current/$total) [$bitrate Kbps/$frequency KHz]");
+ }
+ else {
+ $song =~ s/$album - //im;
+ $witem->command("/me is listening to: $song from $album ($current/$total) [$bitrate Kbps/$frequency KHz]");
+ }
+ }
+ elsif ($song =~ /$file/) {
+ $witem->command("/me is listening to: $file ($current/$total) [$bitrate Kbps/$frequency KHz]");
+ }
+ else {
+ $witem->command("/me is listening to: $artist - $title ($current/$total) [$bitrate Kbps/$frequency KHz]");
+ }
+ }
+ }
+ else {
+ $witem->print("Audacious is not currently running.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_aud_next {
+ my ($data, $server, $witem) = @_;
+ # Skip to the next track.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ if (`ps -C audacious` =~ /audacious/) {
+ my $next = `$c_audtool --playlist-advance`;
+
+ $witem->print("Skipped to next track.");
+ }
+ else {
+ $witem->print("Can't skip to next track. Check your Audacious.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_aud_previous {
+ my ($data, $server, $witem) = @_;
+ # Skip to the previous track.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ if (`ps -C $c_audacious` =~ /audacious/) {
+ my $reverse = `$c_audtool --playlist-reverse`;
+
+ $witem->print("Skipped to previous track.");
+ }
+ else {
+ $witem->print("Can't skip to next track. Check your Audacious.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_aud_play {
+ my ($data, $server, $witem) = @_;
+ # Start playback.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ if (`ps -C $c_audacious` =~ /audacious/) {
+ my $play = `$c_audtool --playback-play`;
+
+ $witem->print("Started playback.");
+ }
+ else {
+ $witem->print("Playback can't be performed now.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_aud_pause {
+ my ($data, $server, $witem) = @_;
+ # Pause playback.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ if (`ps -C $c_audacious` =~ /audacious/) {
+ my $pause = `$c_audtool --playback-pause`;
+
+ $witem->print("Paused playback.");
+ }
+ else {
+ $witem->print("Pause can be only performed when Audacious is running.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_aud_stop {
+ my ($data, $server, $witem) = @_;
+ # Pause playback.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ if (`ps -C $c_audacious` =~ /audacious/) {
+ my $stop = `$c_audtool --playback-stop`;
+
+ $witem->print("Stopped playback.");
+ }
+ else {
+ $witem->print("This way you can't start Audacious.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_aud_volume {
+ my ($data, $server, $witem) = @_;
+ # Set volume and make sure the value is an integer
+ # that lays between 0 and 100.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ if (`ps -C $c_audacious` =~ /audacious/) {
+
+ if ($data eq "") {
+ $witem->print("Use /audacious volume <value> to set a specific volume value");
+ }
+ elsif ($data < 0 or $data > 100) {
+ $witem->print("Given value is out of range [0-100].");
+ return 0;
+ }
+ elsif ($data =~ /^[\d]+$/) {
+ system $c_audtool,'--set-volume', $data;
+ my $volume = `$c_audtool --get-volume`;
+ chomp($volume);
+ $witem->print("Volume is changed to $volume%%");
+ }
+ else {
+ $witem->print("Please use a value [0-100] instead.");
+ }
+ }
+ else {
+ $witem->print("Volume can't be set in the current state.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_aud_jump {
+ my ($data, $server, $witem) = @_;
+ # Jump to a specific track, making sure that
+ # the selected track number exists.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ if (`ps -C $c_audacious` =~ /audacious/) {
+
+ if ($data eq "") {
+ $witem->print("Use /audacious jump <track> number to jump to it in your playlist.");
+ }
+ elsif ($data =~ /^[\d]+$/) {
+ # Many thanks to Khisanth for this awesome fix!
+ my ( $wtr, $rdr, $err );
+ my $pid = open3( $wtr, $rdr, $err,
+ $c_audtool, '--playlist-jump', $data) or die $!;
+ my $output;
+ {
+ local $/;
+ $output = <$rdr>;
+ }
+ if ($output =~ /invalid/) {
+ $witem->print("Track #$data isn't found in your playlist.");
+ }
+ else {
+ $witem->print("Jumped to track #$data.");
+ }
+ }
+ else {
+ $witem->print("Please use a valid integer.");
+ }
+ }
+ else {
+ $witem->print("Start your audacious first.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_aud_playlist {
+ my ($data, $server, $witem) = @_;
+ # Displays entire playlist loaded.
+ if (`ps -C $c_audacious` =~ /audacious/) {
+ my $display = `$c_audtool --playlist-display`;
+ chomp($display);
+
+ Irssi::print("$display");
+ }
+ else {
+ $witem->print("Start your player first.");
+ }
+ return 1;
+}
+
+sub cmd_aud_search {
+ my ($data, $server, $witem) = @_;
+
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ if (`ps -C $c_audacious` =~ /audacious/) {
+ my $playlist = `$c_audtool --playlist-display`;
+ my @matches;
+
+ for (split /\n/, $playlist) {
+ push @matches, $_ if /$data/i;
+ }
+ if (@matches) {
+ $witem->print("Search Results:");
+ for (@matches) {
+ $_ =~ s/^\s+|\s+$//g;
+ $witem->print("$_");
+ }
+ }
+ else {
+ $witem->print("Couldn't find any match(s) for your keyword '$data'.");
+ }
+ }
+ else {
+ $witem->print("Audacious is not running.");
+ }
+ }
+ else {
+ cmd_err();
+ }
+}
+
+
+sub cmd_aud_details {
+ my ($data, $server, $witem) = @_;
+
+ # Displays current song's details.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ if (`ps -C $c_audacious` =~ /audacious/) {
+ my ($bitrate, $frequency, $length, $volume);
+
+ chomp($bitrate = `$c_audtool --current-song-bitrate-kbps`);
+ chomp($frequency = `$c_audtool --current-song-frequency-khz`);
+ chomp($length = `$c_audtool --current-song-length`);
+ chomp($volume = `$c_audtool --get-volume`);
+
+ $witem->print("Current song details: rate: $bitrate kbps - freq: $frequency KHz - l: $length min - vol: $volume%%");
+ }
+ else {
+ $witem->print("Your player doesn't seem to be running");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_aud_version {
+ my ($data, $server, $witem) = @_;
+
+ my ($audtool, $audacious);
+ chop($audtool = `$c_audtool --version`);
+ chop($audacious = `$c_audacious --version`);
+
+ # Displays version information to the channel.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+
+ if ($data eq "--audtool") {
+ $witem->command("/me is running: Consolidate Irssi Player v$VERSION with $audtool");
+ }
+ elsif ($data eq "--audacious") {
+ $witem->command("/me is running: Consolidate Irssi Player v$VERSION with $audacious");
+ }
+ return 1;
+ }
+ else {
+ Irssi::print("Consolidate Irssi Player v$VERSION on $audacious with $audtool");
+ }
+}
+
+sub cmd_audacious {
+ my ($data, $server, $witem) = @_;
+ if ($data =~ m/^[(song)|(next)|(previous)|(play)|(pause)|(stop)|(help)|(volume)|(jump)|(playlist)|(details)|(about)|(search)]/i) {
+ Irssi::command_runsub('audacious', $data, $server, $witem);
+ }
+ else {
+ Irssi::print("Use /audacious <option> or check /help audacious for the complete list");
+ }
+}
+
+sub cmd_aud_help {
+ my ($data, $server) = @_;
+ # Displays usage screen.
+ Irssi::print("* /audacious song - Displays the current playing song in a channel.");
+ Irssi::print("* /audacious song --details - Displays bitrate and frequency with the current playing song.");
+ Irssi::print("* /audacious next - Skips to the next song.");
+ Irssi::print("* /audacious previous - Skips to the previous song.");
+ Irssi::print("* /audacious play - Starts playback.");
+ Irssi::print("* /audacious pause - Pauses playback.");
+ Irssi::print("* /audacious stop - Stops playback.");
+ Irssi::print("* /audacious volume <value> - Sets volume [0-100].");
+ Irssi::print("* /audacious jump <track> - Jumps to specified track.");
+ Irssi::print("* /audacious playlist - Displays entire playlist.");
+ Irssi::print("* /audacious search <keyword> - Searches for the keyword in your playlist and displays the results.");
+ Irssi::print("* /audacious details - Displays current song's details.");
+ Irssi::print("* /audacious version --audtool - Displays version of the script and audtool in the channel.");
+ Irssi::print("* /audacious version --audacious - Displays version of the script and audacious in the channel.");
+}
+
+sub cmd_moc_song {
+ my ($data, $server, $witem) = @_;
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+
+ if (`ps -C mocp` =~ /mocp/) {
+
+ my $mocp = `mocp -i`;
+ $mocp =~ /^State: (.*)$/m;
+ my $state = $1;
+ $mocp =~ /.*Title: (.*).*/;
+ my $title = $1;
+ $mocp =~ /.*TotalTime: (.*).*/;
+ my $totaltime = $1;
+ $mocp =~ /.*CurrentTime: (.*).*/;
+ my $currenttime = $1;
+
+ if ($data ne "--details") {
+ if ($state eq '' || $state eq 'STOP') {
+ $witem->print("MOC is not playing.");
+ }
+ else {
+ $witem->command("/me is listening to: $title ($currenttime/$totaltime)");
+ }
+ }
+
+ if ($data eq "--details") {
+ if ($state eq '' || $state eq 'STOP') {
+ $witem->print("MOC is not playing.");
+ }
+ else {
+ $mocp =~ /.*Bitrate: (.*).*/;
+ my $bitrate = $1;
+ $mocp =~ /.*Rate: (.*).*/;
+ my $rate = $1;
+ $witem->command("/me is listening to: $title ($currenttime/$totaltime) [$bitrate/$rate]");
+ }
+ }
+ }
+ else {
+ $witem->print("MOC is not started.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_moc_next {
+ my ($data, $server, $witem) = @_;
+ # Advance to next track in playlist.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+
+ if (`ps -C mocp` =~ /mocp/) {
+ my $mocp = `mocp -i`;
+ $mocp =~ /^State: (.*)$/m;
+ my $state = $1;
+
+ if ($state eq '' || $state eq 'STOP') {
+ $witem->print("MOC is not playing.");
+ }
+ else {
+ my $next = `mocp -f`;
+ $witem->print("Skipped to next track.");
+ }
+ }
+ else {
+ $witem->print("Can't skip to next track. Check your MOC Player.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_moc_previous {
+ my ($data, $server, $witem) = @_;
+ # Skip to previous track in playlist.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+
+ if (`ps -C mocp` =~ /mocp/) {
+ my $mocp = `mocp -i`;
+ $mocp =~ /^State: (.*)$/m;
+ my $state = $1;
+
+ if ($state eq '' || $state eq 'STOP') {
+ $witem->print("MOC is not playing.");
+ }
+ else {
+ my $next = `mocp -r`;
+ $witem->print("Skipped to previous track.");
+ }
+ }
+ else {
+ $witem->print("Can't skip to previous track. Check your MOC Player.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_moc_play_toggle {
+ my ($data, $server, $witem) = @_;
+ # Start playback.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+
+ if (`ps -C mocp` =~ /mocp/) {
+ my $mocp = `mocp -i`;
+ $mocp =~ /^State: (.*)$/m;
+ my $state = $1;
+
+ if ($state eq '' || $state eq 'STOP') {
+ $witem->print("MOC is not playing.");
+ }
+ elsif ($state eq 'PLAY') {
+ my $play_toggle = `mocp -G`;
+ $witem->print("Paused playing song.");
+ }
+ else {
+ my $play = `mocp -G`;
+ $witem->print("Started playback.");
+ }
+ }
+ else {
+ $witem->print("Playback can't be performed now.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_moc_pause {
+ my ($data, $server, $witem) = @_;
+ # Pause playback.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+
+ if (`ps -C mocp` =~ /mocp/) {
+ my $mocp = `mocp -i`;
+ $mocp =~ /^State: (.*)$/m;
+ my $state = $1;
+
+ if ($state eq '' || $state eq 'STOP') {
+ $witem->print("MOC is not playing.");
+ }
+ elsif ($state eq 'PAUSE') {
+ $witem->print("The song is already paused.");
+ }
+ else {
+ my $pause = `mocp -P`;
+ $witem->print("Paused playback.");
+ }
+ }
+ else {
+ $witem->print("Pause can be only performed when your MOC Player is running.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_moc_unpause {
+ my ($data, $server, $witem) = @_;
+ # Unpause playback, if and only if the previous song was paused.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+
+ if (`ps -C mocp` =~ /mocp/) {
+ my $mocp = `mocp -i`;
+ $mocp =~ /^State: (.*)$/m;
+ my $state = $1;
+
+ if ($state eq '' || $state eq 'STOP') {
+ $witem->print("MOC is not playing.");
+ }
+ elsif ($state eq 'PAUSE') {
+ my $pause = `mocp -U`;
+ $witem->print("Unpaused playback.");
+ }
+ else {
+ $witem->print("Can't unpause your playing song.");
+ }
+ }
+ else {
+ $witem->print("Unpause can be only performed when your MOC Player is running.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_moc_stop {
+ my ($data, $server, $witem) = @_;
+ # Stop the current playing song.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+
+ if (`ps -C mocp` =~ /mocp/) {
+ my $mocp = `mocp -i`;
+ $mocp =~ /^State: (.*)$/m;
+ my $state = $1;
+
+ if ($state eq '' || $state eq 'STOP') {
+ $witem->print("MOC is not playing.");
+ }
+ else {
+ my $stop = `mocp -s`;
+ $witem->print("Stopped playback.");
+ }
+ }
+ else {
+ $witem->print("This way you can't stop a song. Double check your player.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_moc_volume {
+ my ($data, $server, $witem) = @_;
+ # Set volume and make sure the value is an integer
+ # that lays between 0 and 100.
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ if (`ps -C mocp` =~ /mocp/) {
+
+ if ($data eq "") {
+ $witem->print("Use /mocp volume <value> to set a specific volume value");
+ }
+ elsif ($data < 0 or $data > 100) {
+ $witem->print("Given value is out of range [0-100].");
+ return 0;
+ }
+ elsif ($data =~ /^[\d]+$/) {
+ system 'mocp','-v', $data;
+ $witem->print("Volume is changed to $data%%");
+ }
+ else {
+ $witem->print("Please use a value [0-100] instead.");
+ }
+ }
+ else {
+ $witem->print("Volume can't be set when MOC Player is not functioning.");
+ }
+ return 1;
+ }
+ else {
+ cmd_err();
+ }
+}
+
+sub cmd_moc {
+ my ($data, $server, $witem) = @_;
+ if ($data =~ m/^[(song)|(next)|(previous)|(play)|(pause)|(unpause)|(stop)|(help)|(volume)]/i) {
+ Irssi::command_runsub('mocp', $data, $server, $witem);
+ }
+ else {
+ Irssi::print("Use /mocp <option> or check /help mocp for the complete list");
+ }
+}
+
+sub cmd_moc_help {
+ my ($data, $server) = @_;
+ # Displays usage screen.
+ Irssi::print("* /mocp song - Displays the current playing song in a channel.");
+ Irssi::print("* /mocp song --details - Displays bitrate and frequency with the current playing song.");
+ Irssi::print("* /mocp next - Skips to the next song.");
+ Irssi::print("* /mocp previous - Skips to the previous song.");
+ Irssi::print("* /mocp play - Starts playback.");
+ Irssi::print("* /mocp pause - Pauses playback.");
+ Irssi::print("* /mocp stop - Stops playback.");
+ Irssi::print("* /mocp volume <value> - Sets volume [0-100].");
+}
+
+Irssi::command_bind ('audacious song', 'cmd_aud_song');
+Irssi::command_bind ('audacious next', 'cmd_aud_next');
+Irssi::command_bind ('audacious previous', 'cmd_aud_previous');
+Irssi::command_bind ('audacious play', 'cmd_aud_play');
+Irssi::command_bind ('audacious pause', 'cmd_aud_pause');
+Irssi::command_bind ('audacious stop', 'cmd_aud_stop');
+Irssi::command_bind ('audacious help', 'cmd_aud_help');
+Irssi::command_bind ('audacious volume', 'cmd_aud_volume');
+Irssi::command_bind ('audacious jump', 'cmd_aud_jump');
+Irssi::command_bind ('audacious playlist', 'cmd_aud_playlist');
+Irssi::command_bind ('audacious details', 'cmd_aud_details');
+Irssi::command_bind ('audacious version', 'cmd_aud_version');
+Irssi::command_bind ('audacious', 'cmd_audacious');
+Irssi::command_bind ('mocp song', 'cmd_moc_song');
+Irssi::command_bind ('mocp next', 'cmd_moc_next');
+Irssi::command_bind ('mocp previous', 'cmd_moc_previous');
+Irssi::command_bind ('mocp play', 'cmd_moc_play_toggle');
+Irssi::command_bind ('mocp pause', 'cmd_moc_pause');
+Irssi::command_bind ('mocp unpause', 'cmd_moc_unpause');
+Irssi::command_bind ('mocp stop', 'cmd_moc_stop');
+Irssi::command_bind ('mocp help', 'cmd_moc_help');
+Irssi::command_bind ('mocp volume', 'cmd_moc_volume');
+Irssi::command_bind ('mocp', 'cmd_moc');
+Irssi::command_bind ('audacious search', 'cmd_aud_search');
+
+Irssi::print("Consolidate Irssi Player v$VERSION is loaded successfully.");
+
+# vim:set expandtab sw=2 ts=2:
diff --git a/scripts/UNIBG-autoident.pl b/scripts/UNIBG-autoident.pl
new file mode 100644
index 0000000..c8bee32
--- /dev/null
+++ b/scripts/UNIBG-autoident.pl
@@ -0,0 +1,242 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi::TextUI;
+
+$VERSION = "0.2";
+%IRSSI = (
+ authors => 'Doncho N. Gunchev',
+ contact => 'mr_700@yahoo.com',
+ name => 'UNIBG-autoident',
+ description => 'Automaticaly /msg ident NS yourpassword when you connect or services come back from death',
+ license => 'Public Domain',
+ url => 'http://not.available.yet/',
+ changed => '2018-09-10'
+);
+
+# UNIBG NS auto identifyer
+# for irssi 0.8.1 by Doncho N. Gunchev
+#
+# Check /id help for help.
+
+
+my $msghead='autoident:';
+# list of nicks/passwords
+my %passwords = ();
+my $numpasswords = 0;
+my $passwordspassword = '';
+my $nsnick='NS';
+my $nshost='NickServ@UniBG.services';
+my $nsreq='This nickname is registered and protected';
+my $nsok ='Password accepted - you are now recognized';
+my $nscmd ='identify';
+# 2DO
+# 0. Do it!
+# 1. Make it take nick, passwor and network as parameters
+# 2. Make NS, CS, MS and maybe OS support
+# 3. Add eggdrop support
+# 4. Add encrypted passwords in config file...
+# 5. Add Global support or maybe /notify NS or bouth?
+# 6. Don't autoident 2 times in less than xxx seconds
+# 7. Change nick if we don't have the password / ask user for it
+# in xxx seconds before changing nicks
+# 8. Add /id newpass,setpass,permpas,ghost,kill....
+# 9. Add /id chanadd chandel chan....
+#
+
+sub cmd_print_help {
+ Irssi::print(<<EOF, MSGLEVEL_CRAP);
+$msghead
+ WELL... as I'm starting to write this - no help!
+ /id add nick password - add new nick with password to autoident
+ /id del nick - delete nick from autoident list
+ /id list - show nicks in autoident list
+ /id show - same as /id list
+ /id help - this one
+EOF
+# /id check - see if current nick is in autoident list
+}
+
+
+sub msg {
+ my ($msg, $lvl) = @_;
+ Irssi::print("$msghead $msg", $lvl);
+}
+
+
+sub event_notice {
+ # $server = server record where the message came
+ # $data = the raw data received from server, with NOTICEs it is:
+ # "target :text" where target is either your nick or #channel
+ # $nick = the nick who sent the message
+ # $host = host of the nick who sent the message
+ my ($server, $data, $nick, $host) = @_;
+ #04:06 -!- autoident(debug): server= Irssi::Irc::Server=HASH(0x86786cc)
+ #04:06 -!- autoident(debug): data = Mr_700 :This nickname is owned by someone else
+ #04:06 -!- autoident(debug): nick = NS
+ #04:06 -!- autoident(debug): host = NickServ@UniBG.services
+ #04:06 -!- autoident(debug): target = Mr_700
+ #04:06 -!- autoident(debug): text = This nickname is owned by someone else
+
+ # split data to target/text
+ my ($target, $text) = $data =~ /^(\S*)\s:(.*)/;
+
+ # check the sent text
+ return if ($text !~ /$nsreq/) && ($text !~ /$nsok/);
+
+ # check the sender's nick
+ return if ($nick !~ /$nsnick/);
+
+ # check the sender's host
+ if ($host !~ /$nshost/) {
+ msg("!!! '$nsnick' host is bad, hack attempt? !!!", MSGLEVEL_CRAP);
+ msg("!!!", MSGLEVEL_CRAP);
+ msg("!!! sender: '$nick!$host'", MSGLEVEL_CRAP);
+ msg("!!! target: '$target'", MSGLEVEL_CRAP);
+ msg("!!! text : '$text'", MSGLEVEL_CRAP);
+ msg("!!!", MSGLEVEL_CRAP);
+ msg("!!! '$nsnick' host is bad, hack attempt? !!!", MSGLEVEL_CRAP);
+ return;
+ }
+
+ # check if sent to us directly
+ return if ($target !~ /$server->{nick}/);
+
+ if ($text =~ /$nsreq/) {
+ if (exists($passwords{$server->{nick}})) {
+ msg("'$nsnick!$nshost' requested identity, sending...", MSGLEVEL_CRAP);
+ $server->command("MSG $nsnick $nscmd " . $passwords{$server->{nick}});
+ } else {
+ msg("'$nsnick!$nshost' says '$nsreq' and we have no password set for it!", MSGLEVEL_CRAP);
+ msg(" use /id add " . $server->{nick} . " <password> to set it!", MSGLEVEL_CRAP);
+ msg(" ... autoident has left you in /dev/random", MSGLEVEL_CRAP);
+ }
+ } else {
+ msg("'$nsnick!$nshost' accepted identity", MSGLEVEL_CRAP);
+ }
+}
+
+
+sub addpassword {
+ my ($name, $password) = @_;
+
+ if (exists($passwords{$name})) {
+ if ($password eq $passwords{$name}) {
+ msg("Nick $name already has this password for autoident", MSGLEVEL_CRAP);
+ } else {
+ msg("Nick $name's autoident password changed", MSGLEVEL_CRAP);
+ $passwords{$name} = $password;
+ }
+ } else {
+ $passwords{$name} = $password;
+ $numpasswords++;
+ msg("Nick $name added to autoident list ($numpasswords total)", MSGLEVEL_CRAP);
+ }
+}
+
+sub delpassword {
+ my $name = $_[0];
+
+ if (exists($passwords{$name})) {
+ delete($passwords{$name});
+ $numpasswords--;
+ msg("Nick $name removed from autoidentify list ($numpasswords left)", MSGLEVEL_CRAP);
+ } else {
+ msg("Nick $name is not in autoident list", MSGLEVEL_CRAP);
+ }
+}
+
+sub init_passwords {
+ # Add the passwords at startup of the script
+ my $passwordsstring = Irssi::settings_get_str('autoident');
+ if (length($passwordsstring) > 0) {
+ my @passwords = split(/,/, $passwordsstring);
+
+ foreach my $i (@passwords) {
+ my $name = substr($i, 0, index($i, '='));
+ my $password = substr($i, index($i, '=') + 1, length($i));
+ addpassword($name, $password);
+ }
+ }
+}
+
+
+sub read_settings {
+# my $passwords = Irssi::settings_get_str('passwords');
+}
+
+
+sub update_settings_string {
+ my $setting;
+
+ foreach my $name (keys(%passwords)) {
+ $setting .= $name . "=" . $passwords{$name} . ",";
+ }
+
+ Irssi::settings_set_str("autoident", $setting);
+}
+
+
+sub cmd_addpassword {
+ my ($name, $password) = split(/ +/, $_[0]);
+
+ if ($name eq "" || $password eq "") {
+ msg("Use /id add <name> <password> to add new nick to autoident list", MSGLEVEL_CRAP);
+ return;
+ }
+ addpassword($name, $password);
+ update_settings_string();
+}
+
+sub cmd_delpassword {
+ my $name = $_[0];
+
+ if ($name eq "") {
+ msg("Use /id del <name> to delete a nick from autoident list", MSGLEVEL_CRAP);
+ return;
+ }
+
+ delpassword($name);
+ update_settings_string();
+}
+
+sub cmd_showpasswords {
+ if ($numpasswords == 0) {
+ msg("No nicks defined for autoident", MSGLEVEL_CRAP);
+ return;
+ }
+ msg("Nicks for autoident:", MSGLEVEL_CRAP);
+ my $n = 1;
+ foreach my $nick (keys(%passwords)) {
+# msg("$nick: " . $mailboxes{$password}, MSGLEVEL_CRAP);
+ msg("$n. $nick: ***", MSGLEVEL_CRAP);
+ $n++;
+ }
+}
+
+sub cmd_id {
+ my ($data, $server, $item) = @_;
+ if ($data =~ m/^[(show)|(add)|(del)|(help)]/i ) {
+ Irssi::command_runsub('id', $data, $server, $item);
+ } else {
+ msg("Use /id (show|add|del|help)", MSGLEVEL_CRAP);
+ }
+}
+
+Irssi::command_bind('id show', 'cmd_showpasswords');
+Irssi::command_bind('id list', 'cmd_showpasswords');
+Irssi::command_bind('id add', 'cmd_addpassword');
+Irssi::command_bind('id del', 'cmd_delpassword');
+Irssi::command_bind('id help', 'cmd_print_help');
+Irssi::command_bind('id', 'cmd_id');
+Irssi::settings_add_str('misc', 'autoident', '');
+
+read_settings();
+init_passwords();
+Irssi::signal_add('setup changed', 'read_settings');
+
+#Irssi::signal_add('event privmsg', 'event_privmsg');
+Irssi::signal_add('event notice', 'event_notice');
+
+msg("loaded ok", MSGLEVEL_CRAP);
+
+# EOF
diff --git a/scripts/XMMSInfo.pm b/scripts/XMMSInfo.pm
new file mode 100644
index 0000000..39d51ad
--- /dev/null
+++ b/scripts/XMMSInfo.pm
@@ -0,0 +1,308 @@
+# XMMSInfo.pm
+# this should be in a separate file...
+package XMMSInfo;
+
+# should write docs...
+
+use strict;
+use POSIX;
+use IO::File;
+use MP3::Info;
+use vars qw($PIPE $STATUS @ISA @EXPORT);
+
+@ISA = qw(Exporter);
+@EXPORT = qw($STATUS);
+
+$PIPE = '/tmp/xmms-info';
+$STATUS = {
+ -1 => 'Fatal error',
+ 0 => 'Not running',
+ 1 => 'Stopped',
+ 2 => 'Playing',
+ 3 => 'Paused',
+};
+
+sub new {
+ my($class) = shift;
+
+ my($self) = {};
+ bless($self, $class);
+
+ $self->die("Try calling some methods first. \$obj->getInfo() is currently the only one available...");
+
+ $self;
+}
+
+sub parseArgs {
+ my($self) = shift;
+
+ $#_ % 2 || return $self->die("Invalid number of arguments");
+ for(my $i = 0; $i < $#_; $i += 2) {
+ my($k, $v) = ($_[$i], $_[$i + 1]);
+ $self->{Args}->{'.'.uc($k)} = $v;
+ }
+
+ 1;
+}
+
+sub die {
+ my($self) = shift;
+ $self->setError(shift);
+ $self->setStatus(-1);
+ undef;
+}
+
+sub round {
+ my($d) = shift;
+ return $d unless $d =~ /^(\d+)\.(\d)/;
+ $d = $1;
+ $d++ if $2 >= 5;
+ $d;
+}
+
+sub getInfo {
+ my($self) = shift;
+
+ $self->parseArgs(@_) || return;
+
+ my($f) = $self->argPipe || $PIPE;
+ -r $f || return $self->setStatus(0);
+ my($fh) = IO::File->new($f) ||
+ return $self->die("Can't open $f for reading: $!");
+
+ while(<$fh>) {
+ chomp;
+ next unless /^(.+?): (.+)$/;
+ if($1 eq 'Status') {
+ $self->setStatus($2);
+ } else {
+ $self->{Info}->{'.'.uc($1)} = $2;
+ }
+ }
+ $fh->close;
+
+ return $self->die("Invalid input") unless $self->{Info}->{'.INFOPIPE PLUGIN VERSION'};
+
+ my($t) = get_mp3tag($self->infoFile) || return $self->die("Can't read ID3 tag: ". $self->infoFile);
+ my($i) = get_mp3info($self->infoFile) || return $self->die("Can't read MP3 info: ". $self->infoFile);
+
+ my($k, $v);
+ while(($k, $v) = (each(%$t), each(%$i))) {
+ $self->{Info}->{'.'.$k} = $v;
+ }
+
+ $self->getStatus;
+}
+
+sub setStatus {
+ my($self, $s) = @_;
+ if($s =~ /^*\d+$/) {
+ $self->{Status}->{'.STATUS'} = $s;
+ $self->{Status}->{'.STATUSSTRING'} = $STATUS->{$s};
+ } else {
+ foreach my $k (keys %$STATUS) {
+ my($v) = $STATUS->{$k};
+ if($s eq $v) {
+ $self->{Status}->{'.STATUS'} = $k;
+ $self->{Status}->{'.STATUSSTRING'} = $s;
+ return $self->getStatus;
+ }
+ }
+ die "HELP";
+ }
+
+ $self->getStatus;
+}
+
+sub setError {
+ shift->{Status}->{'.ERROR'} = pop;
+}
+
+sub getStatus {
+ shift->{Status}->{'.STATUS'};
+}
+
+sub getStatusString {
+ shift->{Status}->{'.STATUSSTRING'};
+}
+
+sub getError {
+ shift->{Status}->{'.ERROR'};
+}
+
+sub isFatalError {
+ shift->getStatus == -1;
+}
+
+sub isXmmsRunning {
+ shift->getStatus > 0;
+}
+
+sub isPlaying {
+ shift->getStatus == 2;
+}
+
+sub isPaused {
+ shift->getStatus == 3;
+}
+
+sub isStopped {
+ shift->getStatus == 1;
+}
+
+sub argPipe {
+ shift->{Args}->{'.PIPE'};
+}
+
+sub infoPlayListItems {
+ shift->{Info}->{'.TUNES IN PLAYLIST'};
+}
+
+sub infoCurrentItemInPlaylist {
+ shift->{Info}->{'.CURRENTLY PLAYING'};
+}
+
+sub infoTimeNow {
+ shift->{Info}->{'.POSITION'};
+}
+
+sub infoTimeTotal {
+ shift->{Info}->{'.TIME'};
+}
+
+sub infoSecondsTotal {
+ POSIX::ceil (shift->{Info}->{'.SECS'});
+}
+
+sub infoSecondsNow {
+ my($self) = shift;
+ my($s) = $self->infoTimeNow;
+ die "HELP" unless $s =~ /^(\d+):(\d+)$/;
+ $1 * 60 + $2;
+}
+
+sub infoMinutesTotal {
+ shift->{Info}->{'.MM'};
+}
+
+sub infoMinutesNow {
+ my($self) = shift;
+ my($s) = $self->infoTimeNow;
+ die "HELP" unless $s =~ /^(\d+):\d+$/;
+ $1;
+}
+
+sub infoSecondsTotalLeftover {
+ shift->{Info}->{'.SS'};
+}
+
+sub infoSecondsNowLeftover {
+ my($self) = shift;
+ $self->infoSecondsNow - ($self->infoMinutesNow * 60);
+}
+
+sub infouSecTotal {
+ shift->{Info}->{'.USECTIME'};
+}
+
+sub infouSecNow {
+ shift->{Info}->{'.USECPOSITION'};
+}
+
+sub infoPercentage {
+ my($self) = shift;
+ my($p) = ($self->infouSecNow / $self->infouSecTotal) * 100;
+ round($p);
+}
+
+sub infoTitle {
+ shift->{Info}->{'.TITLE'};
+}
+
+sub infoFile {
+ shift->{Info}->{'.FILE'};
+}
+
+sub infoArtist {
+ shift->{Info}->{'.ARTIST'};
+}
+
+sub infoAlbum {
+ shift->{Info}->{'.ALBUM'};
+}
+
+sub infoYear {
+ shift->{Info}->{'.YEAR'};
+}
+
+sub infoComment {
+ shift->{Info}->{'.COMMENT'};
+}
+
+sub infoGenre {
+ shift->{Info}->{'.GENRE'};
+}
+
+sub infoVersion {
+ shift->{Info}->{'.VERSION'};
+}
+
+sub infoLayer {
+ shift->{Info}->{'.LAYER'};
+}
+
+sub infoIsStereo {
+ shift->{Info}->{'.STEREO'};
+}
+
+sub infoIsVbr {
+ shift->{Info}->{'.VBR'};
+}
+
+sub infoBitrate {
+ shift->{Info}->{'.BITRATE'};
+}
+
+sub infoFrequency {
+ shift->{Info}->{'.FREQUENCY'};
+}
+
+sub infoSizeBytes {
+ shift->{Info}->{'.SIZE'};
+}
+
+sub infoSize {
+ shift->infoSizeBytes;
+}
+
+sub infoSizeKiloBytes {
+ round(shift->infoSizeBytes / 1024);
+}
+
+sub infoSizeMegaBytes {
+ round(shift->infoSizeKiloBytes / 1024);
+}
+
+sub infoIsCopyright {
+ shift->{Info}->{'.COPYRIGHT'};
+}
+
+sub infoIsPadded {
+ shift->{Info}->{'.PADDING'};
+}
+
+sub infoFrames {
+ shift->{Info}->{'.FRAMES'};
+}
+
+sub infoFramesLength {
+ shift->{Info}->{'.FRAMESLENGTH'};
+}
+
+sub infoVbrScale {
+ shift->{Info}->{'.VBR_SCALE'};
+}
+
+1;
+
+# EOF
diff --git a/scripts/accent.pl b/scripts/accent.pl
new file mode 100644
index 0000000..3fe0ffa
--- /dev/null
+++ b/scripts/accent.pl
@@ -0,0 +1,153 @@
+#to run it if it is here (but in this case it will run automagically when
+#irssi will start):
+#
+#/script load ~/.irssi/scripts/autorun/accent.pl
+#
+#you can simply remove the script:
+#
+#/script unload accent
+#
+#and it will strips your incoming and outgoing hungarian accents
+#but you can:
+#
+#/set accent_strip_in <on|off> -- strips the incoming accents (on) or not (off)
+#/set accent_strip_out <on|off> -- strips the outgoing accents (on) or not (off)
+#
+#/set accent_tag_in <string, default: [A]> indicates the incoming msg filtered
+#/set accent_tag_out <string, default: [A]> indicates the outgoing msg filtered
+#
+#/set accent_latin <string, default: iso 8859-2: A',a',E',e',I',i',O',o',O:,o:,O",o",U',u',U:,u:,U",u"> which to strip
+#/set accent_ascii <string, default: AaEeIiOoOoOoUuUuUu> will be the stripped
+#
+#be careful, accent_latin and accent_latin must be charlist and must have
+#the same length to be matched as a pair.
+#
+#/set accent_debug <on|off> -- if you have a problem try to turn this on
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+($VERSION) = '$Id: accent.pl,v 1.34 2003/03/27 15:54:25 toma Exp $' =~ / (\d+\.\d+) /;
+%IRSSI = (
+ authors => 'Tamas SZERB',
+ contact => 'toma@rulez.org',
+ name => 'accent',
+ description => 'This script strips the hungarian accents.',
+ license => 'GPL',
+);
+
+my $stripped_out = 0;
+my $stripped_in = 0;
+
+sub accent_out {
+ if(Irssi::settings_get_bool('accent_strip_out') && !$stripped_out) {
+ my $accent_tag = Irssi::settings_get_str('accent_tag_out');
+
+ my $debug=Irssi::settings_get_bool('accent_debug');
+
+ my $accent_latin = Irssi::settings_get_str('accent_latin');
+ my $accent_ascii = Irssi::settings_get_str('accent_ascii');
+ if (length($accent_latin) != length($accent_ascii)) {
+ if ($debug) {
+ Irssi::print("`$accent_latin' and `$accent_ascii' hasn't same length");
+ }
+ }
+ else {
+ my $emitted_signal = Irssi::signal_get_emitted();
+ my ($msg, $dummy1, $dummy2) = @_;
+
+ if ($debug) {
+ Irssi::print("signal emitted: $emitted_signal");
+ }
+
+ if ( $msg =~ /[$accent_latin]/ ) {
+ if ($debug) {
+ Irssi::print("outgoing contains accent: $msg");
+ }
+ eval "\$msg =~ tr/$accent_latin/$accent_ascii/;";
+ $msg = $msg . ' ' . $accent_tag;
+ $stripped_out=1;
+
+ Irssi::signal_emit("$emitted_signal", $msg, $dummy1, $dummy2 );
+ Irssi::signal_stop();
+ $stripped_out=0;
+ }
+ }
+ }
+}
+
+sub accent_in {
+ if(Irssi::settings_get_bool('accent_strip_in') && !$stripped_in) {
+ my $accent_tag = Irssi::settings_get_str('accent_tag_in');
+
+ my $debug=Irssi::settings_get_bool('accent_debug');
+
+ my $accent_latin = Irssi::settings_get_str('accent_latin');
+ my $accent_ascii = Irssi::settings_get_str('accent_ascii');
+ if (length($accent_latin) != length($accent_ascii)) {
+ if ($debug) {
+ Irssi::print("`$accent_latin' and `$accent_ascii' hasn't same length");
+ }
+ }
+ else {
+ my $emitted_signal = Irssi::signal_get_emitted();
+
+ my ($dummy0, $text, $dummy3, $dummy4, $dummy5) = @_;
+ if ($debug) {
+ Irssi::print("signal emitted: $emitted_signal");
+ }
+ if ( $text =~ /[$accent_latin]/ ) {
+ if ($debug) {
+ Irssi::print("incoming contains accent: $text");
+ }
+ if ($debug) {
+ Irssi::print("text=$text");
+ }
+ #no idea why w/o eval doesn't work:
+ eval "\$text =~ tr/$accent_latin/$accent_ascii/;";
+ $text = $text . ' ' . $accent_tag;
+ $stripped_in=1;
+
+ if ($debug) {
+ Irssi::print("text=$text");
+ }
+ Irssi::signal_emit("$emitted_signal", $dummy0, $text, $dummy3, $dummy4, $dummy5 );
+ Irssi::signal_stop();
+ $stripped_in=0;
+ }
+ }
+ }
+}
+
+#main():
+
+#default settings /set accent_in && accent_out ON:
+Irssi::settings_add_bool('lookandfeel', 'accent_strip_in', 1);
+Irssi::settings_add_bool('lookandfeel', 'accent_strip_out', 1);
+
+#define the default tags for the filtered text:
+Irssi::settings_add_str('lookandfeel', 'accent_tag_in', '[Ai]');
+Irssi::settings_add_str('lookandfeel', 'accent_tag_out', '[Ao]');
+
+#define which chars will be changed:
+#iso 8859-2: A',a',E',e',I',i',O',o',O:,o:,O",o",U',u',U:,u:,U",u"
+Irssi::settings_add_str('lookandfeel', 'accent_latin', "\301\341\311\351\315\355\323\363\326\366\325\365\332\372\334\374\333\373");
+Irssi::settings_add_str('lookandfeel', 'accent_ascii', "AaEeIiOoOoOoUuUuUu");
+
+#define wheather debug or not (default OFF):
+Irssi::settings_add_bool('lookandfeel', 'accent_debug', 0);
+
+#filters:
+#incoming filters:
+Irssi::signal_add_first('server event', 'accent_in');
+
+#output filters:
+Irssi::signal_add_first('send command', 'accent_out');
+#Irssi::signal_add_first('message own_public', 'accent_out');
+#Irssi::signal_add_first('message own_private', 'accent_out');
+
+#startup info:
+Irssi::print("Hungarian accent stripper by toma * http://scripts.irssi.org/scripts/accent.pl");
+Irssi::print("Version: $VERSION");
+
diff --git a/scripts/act.pl b/scripts/act.pl
new file mode 100644
index 0000000..21cbbbb
--- /dev/null
+++ b/scripts/act.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+# resets window activity status
+# by c0ffee
+# - http://www.penguin-breeder.org/irssi/
+
+#<scriptinfo>
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi 20020120;
+$VERSION = "0.15";
+%IRSSI = (
+ authors => "c0ffee",
+ contact => "c0ffee\@penguin-breeder.org",
+ name => "Reset window activity status",
+ description => "Reset window activity status. defines command /act",
+ license => "Public Domain",
+ url => "http://www.penguin-breeder.org/irssi/",
+ changed => "Thu Apr 16 15:55:05 BST 2015",
+);
+#</scriptinfo>
+
+#
+# /ACT [PUBLIC|ALL]
+#
+# /ACT without parameters marks windows as non-active where no
+# public talk occured.
+#
+# /ACT PUBLIC also removes those where no nick hilight was triggered
+#
+# /ACT ALL sets all windows as non-active
+
+Irssi::command_bind 'act' => sub {
+ my ( $data, $server, $item ) = @_;
+ $data =~ s/\s+$//g;
+ if ($data) {
+ Irssi::command_runsub('act', $data, $server, $item);
+ }
+ else {
+ _act(1);
+ }
+};
+
+Irssi::command_bind('act public', sub { _act(2); });
+Irssi::command_bind('act all', sub { _act(3); });
+
+sub _act {
+ my($level) = @_;
+ for (Irssi::windows()) {
+ if ($_->{data_level} <= $level) {
+ Irssi::signal_emit("window dehilight", $_);
+ }
+ }
+}
diff --git a/scripts/active_notice.pl b/scripts/active_notice.pl
new file mode 100644
index 0000000..7a851a6
--- /dev/null
+++ b/scripts/active_notice.pl
@@ -0,0 +1,207 @@
+#!/usr/bin/perl -w
+
+## Bugreports and Licence disclaimer.
+#
+# For bugreports and other improvements contact Geert Hauwaerts <geert@hauwaerts.be>
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the Free
+# Software Foundation; either version 2 of the License, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+# more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this script; if not, write to the Free Software Foundation, Inc., 59 Temple
+# Place, Suite 330, Boston, MA 02111-1307 USA.
+##
+
+
+## Documentation.
+#
+# Versioning:
+#
+# This script uses the YEAR.FEATURE.REVISION versioning scheme and must abide
+# by the follwing rules:
+#
+# 1) when adding a new feature, you must increase the FEATURE
+# numeric by one;
+#
+# 2) when fixing a bug, you must increase the REVISION numeric
+# by one; and
+#
+# 3) the first feature or bug change in any given year must set the YEAR
+# numeric to the two digit representation of the current year, and
+# reset the FEATURE and REVISION numerics to 01.
+#
+# Settings:
+#
+# active_notice_show_in_status_window
+#
+# When enabled, notices will also be sent to the status window.
+##
+
+
+##
+# Load the required libraries.
+##
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+
+##
+# Declare the administrative information.
+##
+
+$VERSION = '18.01.01';
+
+%IRSSI = (
+ authors => 'Geert Hauwaerts',
+ contact => 'geert@hauwaerts.be',
+ name => 'active_notice.pl',
+ description => 'This script shows incoming notices into the active channel.',
+ license => 'GNU General Public License',
+ url => 'https://github.com/GeertHauwaerts/irssi-scripts/blob/master/src/active_notice.pl',
+ changed => '2018-07-27',
+);
+
+
+##
+# Register the custom theme formats.
+##
+
+Irssi::theme_register([
+ 'active_notice_loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.'
+]);
+
+
+## Function.
+#
+# Irssi::active_notice::notice_move() function.
+#
+# Function: notice_move()
+# Arguments: The destination.
+# The text.
+# The stripped text.
+#
+# Description: Print received notices into the active window.
+##
+
+sub notice_move {
+
+
+ ##
+ # Parse the parameters.
+ ##
+
+ my ($dest, $text, $stripped) = @_;
+ my $server = $dest->{'server'};
+
+
+ ##
+ # Check whether the message is irrelevant.
+ ##
+
+ if (!$server || !($dest->{level} & MSGLEVEL_NOTICES) || $server->ischannel($dest->{'target'})) {
+ return;
+ }
+
+
+ ##
+ # Fetch the source, destination and status windows.
+ ##
+
+ my $witem = $server->window_item_find($dest->{'target'});
+ my $status = Irssi::window_find_name("(status)");
+ my $awin = Irssi::active_win();
+
+
+ ##
+ # Check whether we have a window for the source of the notice.
+ ##
+
+ if (!$witem) {
+
+
+ ##
+ # Check whether the notice originated from the status window.
+ ##
+
+ if ($awin->{'name'} eq "(status)") {
+ return;
+ }
+
+ ##
+ # replace a single % with %%. (by Dwarf <dwarf@rizon.net>)
+ ##
+
+ $text =~ s/%/%%/g;
+
+ ##
+ # Print the notice in the active window.
+ ###
+
+ $awin->print($text, MSGLEVEL_NOTICES);
+
+
+ ##
+ # Check whether the notice needs to be printed in the status window.
+ ##
+
+ if (!Irssi::settings_get_bool('active_notice_show_in_status_window')) {
+ Irssi::signal_stop();
+ }
+ } else {
+
+
+ ##
+ # Check whether we need to print the notice in the status window.
+ ##
+
+ if (($awin->{'name'} ne "(status)") && (Irssi::settings_get_bool('active_notice_show_in_status_window'))) {
+ $status->print($text, MSGLEVEL_NOTICES);
+ }
+
+
+ ##
+ # Check whether the notice originated from the active window.
+ ##
+
+ if ($witem->{'_irssi'} == $awin->{'active'}->{'_irssi'}) {
+ return;
+ }
+
+
+ ##
+ # Print the notice in the active window.
+ ##
+
+ $awin->print($text, MSGLEVEL_NOTICES);
+ }
+}
+
+
+##
+# Register the signals to hook on.
+##
+
+Irssi::signal_add('print text', 'notice_move');
+
+
+##
+# Register the custom settings.
+##
+
+Irssi::settings_add_bool('active_notice', 'active_notice_show_in_status_window', 1);
+
+
+##
+# Display the script banner.
+##
+
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'active_notice_loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
diff --git a/scripts/active_notify.pl b/scripts/active_notify.pl
new file mode 100644
index 0000000..dce841a
--- /dev/null
+++ b/scripts/active_notify.pl
@@ -0,0 +1,157 @@
+#!/usr/bin/perl -w
+
+## Bugreports and Licence disclaimer.
+#
+# For bugreports and other improvements contact Geert Hauwaerts <geert@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+##
+
+## Comments and remarks.
+#
+# This script uses settings, by default the broadcast will be set off.
+# If you want the notify message to be shown in all the windows use
+# /SET or /TOGGLE to switch it on or off.
+#
+# Setting: notify_broadcast
+#
+##
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.07";
+
+%IRSSI = (
+ authors => 'Geert Hauwaerts',
+ contact => 'geert@irssi.org',
+ name => 'active_notify.pl',
+ description => 'This script will display notify messages into the active window or broadcast it so all the windows.',
+ license => 'GNU General Public License',
+ url => 'http://irssi.hauwaerts.be/active_notify.pl',
+ changed => 'Wed Sep 17 23:00:11 CEST 2003',
+);
+
+Irssi::theme_register([
+ 'notify_joined', '%_Notify%_: %R>>%n %_$0%_ [$1@$2] [$3] has joined /$4/.',
+ 'notify_left', '%_Notify%_: %R>>%n %_$0%_ [$1@$2] [$3] has parted /$4/.',
+ 'notify_new', '%_Notify%_: %R>>%n Added %_$0%_ to the notify list.',
+ 'notify_del', '%_Notify%_: %R>>%n Removed %_$0%_ from the notify list.',
+ 'active_notify_loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.'
+]);
+
+sub notify_joined {
+
+ my ($server, $nick, $user, $host, $realname, $awaymsg) = @_;
+ my $broadcast = Irssi::settings_get_bool('notify_broadcast');
+ my $window = Irssi::active_win();
+
+ if ($broadcast) {
+ foreach my $bwin (Irssi::windows) {
+ $bwin->printformat(MSGLEVEL_CLIENTCRAP, 'notify_joined', $nick, $user, $host, $realname, $server->{tag});
+ }
+ } else {
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'notify_joined', $nick, $user, $host, $realname, $server->{tag});
+ }
+
+ Irssi::signal_stop();
+}
+
+sub notify_left {
+
+ my ($server, $nick, $user, $host, $realname, $awaymsg) = @_;
+ my $broadcast = Irssi::settings_get_bool('notify_broadcast');
+ my $window = Irssi::active_win();
+
+ if ($broadcast) {
+ foreach my $bwin (Irssi::windows) {
+ $bwin->printformat(MSGLEVEL_CLIENTCRAP, 'notify_left', $nick, $user, $host, $realname, $server->{tag});
+ }
+ } else {
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'notify_left', $nick, $user, $host, $realname, $server->{tag});
+ }
+
+ Irssi::signal_stop();
+}
+
+sub notify_new {
+
+ my ($nick) = @_;
+ my $broadcast = Irssi::settings_get_bool('notify_broadcast');
+ my $window = Irssi::active_win();
+ my ($aw_ch, $ircnet, $mask, $ict);
+
+ if ($broadcast) {
+ foreach my $bwin (Irssi::windows) {
+ $bwin->printformat(MSGLEVEL_CLIENTCRAP, 'notify_new', $nick->{mask});
+ }
+ } else {
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'notify_new', $nick->{mask});
+ }
+
+ Irssi::signal_stop();
+}
+
+sub notify_del {
+
+ my ($nick) = @_;
+ my $broadcast = Irssi::settings_get_bool('notify_broadcast');
+ my $window = Irssi::active_win();
+
+ if ($broadcast) {
+ foreach my $bwin (Irssi::windows) {
+ $bwin->printformat(MSGLEVEL_CLIENTCRAP, 'notify_del', $nick->{mask});
+ }
+ } else {
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'notify_del', $nick->{mask});
+ }
+
+ Irssi::signal_stop();
+}
+
+Irssi::signal_add_first('notifylist joined', 'notify_joined');
+Irssi::signal_add_first('notifylist left', 'notify_left');
+
+## BUG, BUG, BUG! Warning!
+#
+# [16:02] [-] Irssi: Starting query in Freenode with cras
+# [16:04] :cras: it crashes every time it gets into 'notifylist remove' signal?
+# [16:04] :Geert: yes
+# [16:05] :Geert: the notifylist new too
+# [16:06] :cras: even if they didn't do anything?
+# [16:06] :Geert: indeed
+# [16:06] :Geert: Try for yourself :)
+# [16:06] :Geert: joined & remove signals are working great
+# [16:07] :cras: i guess it doesn't like the notifylist_rec ..
+# [16:08] :Geert: So, what should I do now? :)
+# [16:10] :cras: try cvs update?
+# [16:10] :cras: i fixed one possible cause for it
+# [16:10] :cras: and can't see another one :)
+# [16:11] :Geert: Well, It's a scriptrequest from someone. So I'll just comment that feature
+# [16:11] :Geert: Are you sure it works in the cvs?
+# [16:11] :cras: well, 70% sure :)
+# [16:12] :Geert: Let's hope so :P
+#
+# Uncomment the next two lines. ONLY if you have the CVS version.
+#
+#Irssi::signal_add_first('notifylist new', 'notify_new');
+#Irssi::signal_add_first('notifylist remove', 'notify_del');
+#
+##
+
+Irssi::settings_add_bool('notify', 'notify_broadcast' => 0);
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'active_notify_loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
diff --git a/scripts/adv_windowlist.pl b/scripts/adv_windowlist.pl
new file mode 100644
index 0000000..839814e
--- /dev/null
+++ b/scripts/adv_windowlist.pl
@@ -0,0 +1,2988 @@
+use strict;
+use warnings;
+
+our $VERSION = '1.11'; # 28b8dcf69e0355e
+our %IRSSI = (
+ authors => 'Nei',
+ contact => 'Nei @ anti@conference.jabber.teamidiot.de',
+ url => "http://anti.teamidiot.de/",
+ name => 'adv_windowlist',
+ description => 'Adds a permanent advanced window list on the right or in a status bar.',
+ sbitems => 'awl_shared',
+ license => 'GNU GPLv2 or later',
+ );
+
+# UPGRADE NOTE
+# ============
+# for users of 0.7 or earlier series, please note that appearance
+# settings have moved to /format, i.e. inside your theme!
+# the fifo (screen) has been replaced by an external viewer script
+
+# Usage
+# =====
+# copy the script to ~/.irssi/scripts/
+#
+# In irssi:
+#
+# /run adv_windowlist
+#
+# In your shell (for example a tmux split):
+#
+# perl ~/.irssi/scripts/adv_windowlist.pl
+#
+# To use sbar mode instead:
+#
+# /toggle awl_viewer
+#
+# Hint: to get rid of the old [Act:] display
+# /statusbar window remove act
+#
+# to get it back:
+# /statusbar window add -after lag -priority 10 act
+
+# Options
+# =======
+# formats can be cleared with /format -delete
+#
+# /format awl_display_(no)key(_active|_visible) <string>
+# * string : Format String for one window. The following $'s are expanded:
+# $C : Name
+# $N : Number of the Window
+# $Q : meta-Keymap
+# $H : Start hilighting
+# $S : Stop hilighting
+# /+++++++++++++++++++++++++++++++++,
+# | **** I M P O R T A N T : **** |
+# | |
+# | don't forget to use $S if you |
+# | used $H before! |
+# | |
+# '+++++++++++++++++++++++++++++++++/
+# key : a key binding that goes to this window could be detected in /bind
+# nokey : no such key binding was detected
+# active : window would receive the input you are currently typing
+# visible : window is also visible on screen but not active (a split window)
+#
+# /format awl_name_display <string>
+# * string : Format String for window names
+# $0 : name as formatted by the settings
+#
+# /format awl_display_header <string>
+# * string : Format String for this header line. The following $'s are expanded:
+# $C : network tag
+#
+# /format awl_separator(2) <string>
+# * string : Character to use between the channel entries
+# variant 2 can be used for alternating separators (only in status bar
+# without block display)
+#
+# /format awl_abbrev_chars <string>
+# * string : Character to use when shortening long names. The second character
+# will be used if two blocks need to be filled.
+#
+# /format awl_title <string>
+# * string : Text to display in the title string or title bar
+#
+# /format awl_viewer_item_bg <string>
+# * string : Format String specifying the viewer's item background colour
+#
+# /set awl_prefer_name <ON|OFF>
+# * this setting decides whether awl will use the active_name (OFF) or the
+# window name as the name/caption in awl_display_*.
+# That way you can rename windows using /window name myownname.
+#
+# /set awl_hide_empty <num>
+# * if visible windows without items should be hidden from the window list
+# set it to 0 to show all windows
+# 1 to hide visible windows without items (negative exempt
+# active window)
+#
+# /set awl_custom_key_re <regex>
+# * regex : which symbolic key names to show in $Q (for example F-keys)
+#
+# /set awl_detach <list>
+# * list of windows that should be hidden from the window list. you
+# can also use /awl detach and /awl attach to manage this
+# setting. an optional data_level can be specified with ",num"
+#
+# /set awl_detach_data <num>
+# * num : hide the detached window if its data_level is below num
+#
+# /set awl_detach_aht <ON|OFF>
+# * if enabled, also detach all windows listed in the
+# activity_hide_targets setting
+#
+# /set awl_hide_data <num>
+# * num : hide the window if its data_level is below num
+# set it to 0 to basically disable this feature,
+# 1 if you don't want windows without activity to be shown
+# 2 to show only those windows with channel text or hilight
+# 3 to show only windows with hilight (negative exempt active window)
+#
+# /set awl_hide_name_data <num>
+# * num : hide the name of the window if its data_level is below num
+# (only works in status bar without block display)
+# you will want to change your formats to add $H...$S around $Q or $N
+# if you plan to use this
+#
+# /set awl_maxlines <num>
+# * num : number of lines to use for the window list (0 to disable, negative
+# lock)
+#
+# /set awl_maxcolumns <num>
+# * num : number of columns to use for the window list when using the
+# tmux integration (0 to disable)
+#
+# /set awl_block <num>
+# * num : width of a column in viewer mode (negative values = block
+# display in status bar mode)
+# /+++++++++++++++++++++++++++++++++,
+# | ****** W A R N I N G ! ****** |
+# | |
+# | If your block display looks |
+# | DISTORTED, you need to add the |
+# | following line to your .theme |
+# | file under |
+# | abstracts = { : |
+# | |
+# | sb_act_none = "%K$*"; |
+# | |
+# '+++++++++++++++++++++++++++++++++/
+#
+# /set awl_sbar_maxlength <ON|OFF>
+# * if you enable the maxlength setting, the block width will be used as a
+# maximum length for the non-block status bar mode too.
+#
+# /set awl_height_adjust <num>
+# * num : how many lines to leave empty in viewer mode
+#
+# /set awl_sort <-data_level|-last_line|refnum>
+# * you can change the window sort order with this variable
+# -data_level : sort windows with hilight first
+# -last_line : sort windows in order of activity
+# refnum : sort windows by window number
+# active/server/tag : sort by server name
+# lru : sort windows with the last recently used last
+# "-" reverses the sort order
+# typechecks are supported via ::, e.g. active::Query or active::Irc::Query
+# undefinedness can be checked with ~, e.g. ~active
+# string comparison can be done with =, e.g. name=(status)
+# to make sort case insensitive, use #i, e.g. name#i
+# any key in the window hash can be tested, e.g. active/chat_type=XMPP
+# multiple criteria can be separated with , or +, e.g. -data_level+-last_line
+#
+# /set awl_placement <top|bottom>
+# /set awl_position <num>
+# * these settings correspond to /statusbar because awl will create
+# status bars for you
+# (see /help statusbar to learn more)
+#
+# /set awl_all_disable <ON|OFF>
+# * if you set awl_all_disable to ON, awl will also remove the
+# last status bar it created if it is empty.
+# As you might guess, this only makes sense with awl_hide_data > 0 ;)
+#
+# /set awl_viewer <ON|OFF>
+# * enable the external viewer script
+#
+# /set awl_viewer_launch <ON|OFF>
+# * try to auto-launch the viewer under tmux or with a shell command
+# /awl restart is required all auto-launch related settings to take
+# effect
+#
+# /set awl_viewer_tmux_position <left|top|right|bottom|custom>
+# * try to split in this direction when using tmux for the viewer
+# custom : use custom_command setting
+#
+# /set awl_viewer_xwin_command <shell command>
+# * custom command to run in order to start the viewer when irssi is
+# running under X
+# %A - gets replaced by the command to run the viewer
+# %qA - additionally quote the command
+#
+# /set awl_viewer_custom_command <shell command>
+# * custom command to run in order to start the viewer
+#
+# /set awl_viewer_launch_env <string>
+# * specific environment settings for use on viewer auto-launch,
+# without the AWL_ prefix
+#
+# /set awl_shared_sbar <left<right|OFF>
+# * share a status bar for the first awl item, you will need to manually
+# /statusbar window add -after lag -priority 10 awl_shared
+# left : space in cells occupied on the left of status bar
+# right : space occupied on the right
+# Note: you need to replace "left" AND "right" with the appropriate numbers!
+#
+# /set awl_path <path>
+# * path to the file which the viewer script reads
+#
+# /set fancy_abbrev <no|head|strict|fancy>
+# * how to shorten too long names
+# no : shorten in the middle
+# head : always cut off the ends
+# strict : shorten repeating substrings
+# fancy : combination of no+strict
+#
+# /set awl_custom_xform <perl code>
+# * specify a custom routine to transform window names
+# example: s/^#// remove the #-mark of IRC channels
+# the special flags $CHANNEL / $TAG / $QUERY / $NAME can be
+# tested in conditionals
+#
+# /set awl_last_line_shade <timeout>
+# * set timeout to shade activity base colours, to enable
+# you also need to add +-last_line to awl_sort
+# (requires 256 colour support)
+#
+# /set awl_no_mode_hint <ON|OFF>
+# * whether to show the hint of running the viewer script in the
+# status bar
+#
+# /set awl_mouse <ON|OFF>
+# * enable the terminal mouse in irssi
+# (use the awl-patched mouse.pl for gestures and commands if you need
+# them and disable mouse_escape)
+#
+# /set awl_mouse_offset <num>
+# * specifies where on the screen is the awl status bar
+# (0 = on top/bottom, 1 = one additional line in between,
+# e.g. prompt)
+# you MUST set this correctly otherwise the mouse coordinates will
+# be off
+#
+# /set mouse_scroll <num>
+# * how many lines the mouse wheel scrolls
+#
+# /set mouse_escape <num>
+# * seconds to disable the mouse, when not clicked on the windowlist
+#
+
+# Commands
+# ========
+# /awl detach <num>
+# * hide the current window from the window list. num specifies the
+# data_level (optional)
+#
+# /awl attach
+# * unhide the current window from the window list
+#
+# /awl ack
+# * change to the next window with activity, ignoring detached windows
+#
+# /awl redraw
+# * redraws the windowlist. There may be occasions where the
+# windowlist can get destroyed so you can use this command to
+# force a redraw.
+#
+# /awl restart
+# * restart the connection to the viewer script.
+
+# Viewer script
+# =============
+# When run from the command line, adv_windowlist acts as the viewer
+# script to be used together with the irssi script to display the
+# window list in a sidebar/terminal of its own.
+#
+# One optional parameter is accepted, the awl_path
+#
+# The viewer can be configured by three environment variables:
+#
+# AWL_HI9=1
+# * interpret %9 as high-intensity toggle instead of bold. This had
+# been the default prior to version 0.9b8
+#
+# AWL_AUTOFOCUS=0
+# * disable auto-focus behaviour when activating a window
+#
+# AWL_NOTITLE=1
+# * disable the title bar
+
+# Nei =^.^= ( anti@conference.jabber.teamidiot.de )
+
+no warnings 'redefine';
+use constant IN_IRSSI => __PACKAGE__ ne 'main' || $ENV{IRSSI_MOCK};
+use constant SCRIPT_FILE => __FILE__;
+no if !IN_IRSSI, strict => (qw(subs refs));
+use if IN_IRSSI, Irssi => ();
+use if IN_IRSSI, 'Irssi::TextUI' => ();
+use v5.10;
+use Encode;
+use Storable ();
+use IO::Socket::UNIX;
+use List::Util qw(min max reduce);
+use Hash::Util qw(lock_keys);
+use Text::ParseWords qw(shellwords);
+
+BEGIN {
+ if ($] < 5.012) {
+ *CORE::GLOBAL::length = *CORE::GLOBAL::length = sub (_) {
+ defined $_[0] ? CORE::length($_[0]) : undef
+ };
+ }
+ *Irssi::active_win = {}; # hide incorrect warning
+}
+
+unless (IN_IRSSI) {
+ local *_ = \@ARGV;
+ &AwlViewer::main;
+ exit;
+}
+
+
+use constant GLOB_QUEUE_TIMER => 100;
+
+our $BLOCK_ALL; # localized blocker
+my @actString; # status bar texts
+my @win_items;
+my $currentLines = 0;
+my %awins;
+my $globTime; # timer to limit remake calls
+
+my %CHANGED;
+my $VIEWER_MODE;
+my $MOUSE_ON;
+my %mouse_coords;
+my %statusbars;
+my %S; # settings
+my $settings_str = '1';
+my $window_sort_func;
+my $custom_xform;
+my $custom_key_re = qr/(?!)/;
+my ($sb_base_width, $sb_base_width_pre, $sb_base_width_post);
+my $print_text_activity;
+my $shade_line_timer;
+my ($screenHeight, $screenWidth);
+my %viewer;
+
+my (%keymap, %nummap, %wnmap, %specialmap, %wnmap_exp, %custom_key_map);
+my %banned_channels;
+my %detach_map;
+my %abbrev_cache;
+
+use constant setc => 'awl';
+
+sub set ($) {
+ setc . '_' . $_[0]
+}
+
+sub add_statusbar {
+ for (@_) {
+ # add subs
+ my $l = set $_;
+ {
+ my $close = $_;
+ no strict 'refs';
+ *{$l} = sub { awl($close, @_) };
+ }
+ Irssi::command("^statusbar $l reset");
+ Irssi::command("statusbar $l enable");
+ if (lc $S{placement} eq 'top') {
+ Irssi::command("statusbar $l placement top");
+ }
+ if (my $x = $S{position}) {
+ Irssi::command("statusbar $l position $x");
+ }
+ Irssi::command("statusbar $l add -priority 100 -alignment left barstart");
+ Irssi::command("statusbar $l add $l");
+ Irssi::command("statusbar $l add -priority 100 -alignment right barend");
+ Irssi::command("statusbar $l disable");
+ Irssi::statusbar_item_register($l, '$0', $l);
+ $statusbars{$_} = 1;
+ Irssi::command("statusbar $l enable");
+ }
+}
+
+sub remove_statusbar {
+ for (@_) {
+ my $l = set $_;
+ Irssi::command("statusbar $l disable");
+ Irssi::command("statusbar $l reset");
+ Irssi::statusbar_item_unregister($l);
+ {
+ no strict 'refs';
+ undef &{$l};
+ }
+ delete $statusbars{$_};
+ }
+}
+
+my $awl_shared_empty = sub {
+ return if $BLOCK_ALL;
+ my ($item, $get_size_only) = @_;
+ $item->default_handler($get_size_only, '', '', 0);
+};
+
+sub syncLines {
+ my $maxLines = $S{maxlines};
+ my $newLines = ($maxLines > 0 and @actString > $maxLines) ?
+ $maxLines :
+ ($maxLines < 0) ?
+ -$maxLines :
+ @actString;
+ $currentLines = 1 if !$currentLines && $S{shared_sbar};
+ if ($S{shared_sbar} && !$statusbars{shared}) {
+ my $l = set 'shared';
+ {
+ no strict 'refs';
+ *{$l} = sub {
+ return if $BLOCK_ALL;
+ my ($item, $get_size_only) = @_;
+
+ my $text = $actString[0];
+ my $title = _get_format(set 'title');
+ if (length $title) {
+ $title =~ s{\\(.)|(.)}{
+ defined $2 ? quotemeta $2
+ : $1 eq 'V' ? '\u'
+ : $1 eq ':' ? quotemeta ':%n'
+ : $1 =~ /^[uUFQE]$/ ? "\\$1"
+ : quotemeta "\\$1"
+ }sge;
+ $title = eval qq{"$title"};
+ $title .= ' ';
+ }
+ my $pat = defined $text ? "{sb $title\$*}" : '{sb }';
+ $text //= '';
+ $item->default_handler($get_size_only, $pat, $text, 0);
+ };
+ }
+ $statusbars{shared} = 1;
+ remove_statusbar (0) if $statusbars{0};
+ }
+ elsif ($statusbars{shared} && !$S{shared_sbar}) {
+ add_statusbar (0) if $currentLines && $newLines;
+ delete $statusbars{shared};
+ my $l = set 'shared';
+ {
+ no strict 'refs';
+ *{$l} = $awl_shared_empty;
+ }
+ }
+ if ($currentLines == $newLines) { return; }
+ elsif ($newLines > $currentLines) {
+ add_statusbar ($currentLines .. ($newLines - 1));
+ }
+ else {
+ remove_statusbar (reverse ($newLines .. ($currentLines - 1)));
+ }
+ $currentLines = $newLines;
+}
+
+sub awl {
+ return if $BLOCK_ALL;
+ my ($line, $item, $get_size_only) = @_;
+
+ my $text = $actString[$line];
+ my $pat = defined $text ? '{sb $*}' : '{sb }';
+ $text //= '';
+ $item->default_handler($get_size_only, $pat, $text, 0);
+}
+
+# remove old statusbars
+{ my %killBar;
+ sub get_old_status {
+ my ($textDest, $cont, $cont_stripped) = @_;
+ if ($textDest->{level} == MSGLEVEL_CLIENTCRAP and $textDest->{target} eq '' and !defined $textDest->{server}) {
+ my $name = quotemeta(set '');
+ if ($cont_stripped =~ m/^$name(\d+)\s/) { $killBar{$1} = 1; }
+ Irssi::signal_stop;
+ }
+ }
+ sub killOldStatus {
+ %killBar = ();
+ Irssi::signal_add_first('print text' => 'get_old_status');
+ Irssi::command('statusbar');
+ Irssi::signal_remove('print text' => 'get_old_status');
+ remove_statusbar(keys %killBar);
+ }
+}
+
+sub _add_map {
+ my ($type, $target, $map) = @_;
+ ($type->{$target}) = sort { length $a <=> length $b || $a cmp $b }
+ $map, exists $type->{$target} ? $type->{$target} : ();
+}
+
+sub get_keymap {
+ my ($textDest, undef, $cont_stripped) = @_;
+ if ($textDest->{level} == MSGLEVEL_CLIENTCRAP and $textDest->{target} eq '' and !defined $textDest->{server}) {
+ my $one_meta_or_ctrl_key = qr/((?:meta-)*?)(?:(meta-|\^)(\S)|(\w+))/;
+ $cont_stripped = as_uni($cont_stripped);
+ if ($cont_stripped =~ m/((?:$one_meta_or_ctrl_key-)*$one_meta_or_ctrl_key)\s+(.*)$/) {
+ my ($combo, $command) = ($1, $10);
+ my $map = '';
+ while ($combo =~ s/(?:-|^)$one_meta_or_ctrl_key$//) {
+ my ($level, $ctl, $key, $nkey) = ($1, $2, $3, $4);
+ my $numlevel = ($level =~ y/-//);
+ if (not defined $key and $nkey =~ /^($custom_key_re)$/) {
+ $key = $nkey;
+ }
+ $ctl = '' if !$ctl || $ctl ne '^';
+ $map = ('-' x ($numlevel%2)) . ('+' x ($numlevel/2)) .
+ $ctl . (defined $key ? $key : "\01$nkey\01") . $map;
+ }
+ for ($command) {
+ last unless length $map;
+ if (/^change_window (\d+)/i) {
+ _add_map(\%nummap, $1, $map);
+ }
+ elsif (/^(?:command window goto|change_window) (\S+)/i) {
+ my $window = $1;
+ if ($window !~ /\D/) {
+ _add_map(\%nummap, $window, $map);
+ }
+ elsif (lc $window eq 'active') {
+ _add_map(\%specialmap, '_active', $map);
+ }
+ else {
+ _add_map(\%wnmap, $window, $map);
+ }
+ }
+ elsif (/^(?:active_window|command ((awl )?ack))/i) {
+ _add_map(\%specialmap, '_active', $map);
+ $viewer{use_ack} = $1;
+ }
+ elsif (/^command window last/i) {
+ _add_map(\%specialmap, '_last', $map);
+ }
+ elsif (/^(?:upper_window|command window up)/i) {
+ _add_map(\%specialmap, '_up', $map);
+ }
+ elsif (/^(?:lower_window|command window down)/i) {
+ _add_map(\%specialmap, '_down', $map);
+ }
+ elsif (/^key\s+(\w+)/i) {
+ $custom_key_map{$1} = $map;
+ }
+ }
+ }
+ Irssi::signal_stop;
+ }
+}
+
+sub update_keymap {
+ %nummap = %wnmap = %specialmap = %custom_key_map = ();
+ Irssi::signal_remove('command bind' => 'watch_keymap');
+ Irssi::signal_add_first('print text' => 'get_keymap');
+ Irssi::command('bind');
+ Irssi::signal_remove('print text' => 'get_keymap');
+ for (keys %custom_key_map) {
+ if (exists $custom_key_map{$_} &&
+ $custom_key_map{$_} =~ s/\01(\w+)\01/exists $custom_key_map{$1} ? $custom_key_map{$1} : "\02"/ge) {
+ if ($custom_key_map{$_} =~ /\02/) {
+ delete $custom_key_map{$_};
+ }
+ else {
+ redo;
+ }
+ }
+ }
+ for my $keymap (\(%specialmap, %wnmap, %nummap)) {
+ for (keys %$keymap) {
+ if ($keymap->{$_} =~ s/\01(\w+)\01/exists $custom_key_map{$1} ? $custom_key_map{$1} : "\02"/ge) {
+ if ($keymap->{$_} =~ /\02/) {
+ delete $keymap->{$_};
+ }
+ }
+ }
+ }
+ Irssi::signal_add('command bind' => 'watch_keymap');
+ delete $viewer{client_keymap};
+ &wl_changed;
+}
+
+# watch keymap changes
+sub watch_keymap {
+ Irssi::timeout_add_once(1000, 'update_keymap', undef);
+}
+
+{ my %strip_table = (
+ # fe-common::core::formats.c:format_expand_styles
+ # delete format_backs format_fores bold_fores other stuff
+ (map { $_ => '' } (split //, '04261537' . 'kbgcrmyw' . 'KBGCRMYW' . 'U9_8I:|FnN>#[' . 'pP')),
+ # escape
+ (map { $_ => $_ } (split //, '{}%')),
+ );
+ sub ir_strip_codes { # strip %codes
+ my $o = shift;
+ $o =~ s/(%(%|Z.{6}|z.{6}|X..|x..|.))/exists $strip_table{$2} ? $strip_table{$2} :
+ $2 =~ m{x(?:0[a-f]|[1-6][0-9a-z]|7[a-x])|z[0-9a-f]{6}}i ? '' : $1/gex;
+ $o
+ }
+}
+## ir_parse_special -- wrapper around parse_special
+## $i - input format
+## $args - array ref of arguments to format
+## $win - different target window (default current window)
+## $flags - different kind of escape flags (default 4|8)
+## returns formatted str
+sub ir_parse_special {
+ my $o;
+ my $i = shift;
+ my $args = shift // [];
+ y/ /\177/ for @$args; # hack to escape spaces
+ my $win = shift || Irssi::active_win;
+ my $flags = shift // 0x4|0x8;
+ my @cmd_args = ($i, (join ' ', @$args), $flags);
+ my $server = Irssi::active_server();
+ if (ref $win and ref $win->{active}) {
+ $o = $win->{active}->parse_special(@cmd_args);
+ }
+ elsif (ref $win and ref $win->{active_server}) {
+ $o = $win->{active_server}->parse_special(@cmd_args);
+ }
+ elsif (ref $server) {
+ $o = $server->parse_special(@cmd_args);
+ }
+ else {
+ $o = &Irssi::parse_special(@cmd_args);
+ }
+ $o =~ y/\177/ /;
+ $o
+}
+
+sub sb_format_expand { # Irssi::current_theme->format_expand wrapper
+ Irssi::current_theme->format_expand(
+ $_[0],
+ (
+ Irssi::EXPAND_FLAG_IGNORE_REPLACES
+ |
+ ($_[1] ? 0 : Irssi::EXPAND_FLAG_IGNORE_EMPTY)
+ )
+ )
+}
+
+{ my $term_type = Irssi::version > 20040819 ? 'term_charset' : 'term_type';
+ if (Irssi->can('string_width')) {
+ *screen_length = sub { Irssi::string_width($_[0]) };
+ }
+ else {
+ local $@;
+ eval { require Text::CharWidth; };
+ unless ($@) {
+ *screen_length = sub { Text::CharWidth::mbswidth($_[0]) };
+ }
+ else {
+ my $err = $@; chomp $err; $err =~ s/\sat .* line \d+\.$//;
+ #Irssi::print("%_$IRSSI{name}: warning:%_ Text::CharWidth module failed to load. Length calculation may be off! Error was:");
+ print "%_$IRSSI{name}:%_ $err";
+ *screen_length = sub {
+ my $temp = shift;
+ if (lc Irssi::settings_get_str($term_type) eq 'utf-8') {
+ Encode::_utf8_on($temp);
+ }
+ length($temp)
+ };
+ }
+ }
+ sub as_uni {
+ no warnings 'utf8';
+ Encode::decode(Irssi::settings_get_str($term_type), $_[0], 0)
+ }
+ sub as_tc {
+ Encode::encode(Irssi::settings_get_str($term_type), $_[0], 0)
+ }
+}
+
+sub sb_length {
+ screen_length(ir_strip_codes($_[0]))
+}
+
+sub run_custom_xform {
+ local $@;
+ eval {
+ $custom_xform->()
+ };
+ if ($@) {
+ $@ =~ /^(.*)/;
+ print '%_'.(set 'custom_xform').'%_ died (disabling): '.$1;
+ $custom_xform = undef;
+ }
+}
+
+sub remove_uniform {
+ my $o = shift;
+ $o =~ s/^xmpp:(.*?[%@]).+\.[^.]+$/$1/ or
+ $o =~ s#^psyc://.+\.[^.]+/([@~].*)$#$1#;
+ if ($custom_xform) {
+ run_custom_xform() for $o;
+ }
+ $o
+}
+
+sub remove_uniform_vars {
+ my $win = shift;
+ my $name = __PACKAGE__ . '::custom_xform::' . $win->{active}{type}
+ if ref $win->{active} && $win->{active}{type};
+ no strict 'refs';
+ local ${$name} = 1 if $name;
+ remove_uniform(+shift);
+}
+
+sub lc1459 {
+ my $x = shift;
+ $x =~ y/][\\^/}{|~/;
+ lc $x
+}
+
+sub window_list {
+ my $i = 0;
+ map { $_->[1] } sort $window_sort_func map { [ $i++, $_ ] } Irssi::windows;
+}
+
+sub _calculate_abbrev {
+ my ($wins, $abbrevList) = @_;
+ if ($S{fancy_abbrev} !~ /^(no|off|head)/i) {
+ my @nameList = map { ref $_ ? remove_uniform_vars($_, as_uni($_->get_active_name) // '') : '' } @$wins;
+ for (my $i = 0; $i < @nameList - 1; ++$i) {
+ my ($x, $y) = ($nameList[$i], $nameList[$i + 1]);
+ s/^[+#!=]// for $x, $y;
+ my $res = exists $abbrev_cache{$x}{$y} ? $abbrev_cache{$x}{$y}
+ : $abbrev_cache{$x}{$y} = string_LCSS($x, $y);
+ if (defined $res) {
+ for ($nameList[$i], $nameList[$i + 1]) {
+ $abbrevList->{$_} //= int((index $_, $res) + (length $res) / 2);
+ }
+ }
+ }
+ }
+}
+
+my %act_last_line_shades = (
+ r => [qw[ 50 40 30 20 ]],
+ g => [qw[ 1O 1I 1C 16 ]],
+ y => [qw[ 5O 4I 3C 26 ]],
+ b => [qw[ 15 14 13 12 ]],
+ m => [qw[ 54 43 32 21 ]],
+ c => [qw[ 1S 1L 1E 17 ]],
+ w => [qw[ 7W 7T 7Q 3E ]],
+ K => [qw[ 7M 7K 27 7H ]],
+ R => [qw[ 60 50 40 30 ]],
+ G => [qw[ 1U 1O 1I 1C ]],
+ Y => [qw[ 6U 5O 4I 3C ]],
+ B => [qw[ 2B 2A 29 28 ]],
+ M => [qw[ 65 54 43 32 ]],
+ C => [qw[ 1Z 1S 1L 1E ]],
+ W => [qw[ 6Z 5S 7R 7O ]],
+ );
+
+sub _format_display {
+ my (undef, $format, $cformat, $hilight, $name, $number, $key, $win) = @_;
+ if ($print_text_activity && $S{line_shade}) {
+ my @hilight_code = split /\177/, sb_format_expand("{$hilight \177}"), 2;
+ my $max_time = max(1, log($S{line_shade}) - log(1000));
+ my $time_delta = min(3, min($max_time, log(max(1, time - $win->{last_line}))) / $max_time * 3);
+ if ($hilight_code[0] =~ /%(.)/ && exists $act_last_line_shades{$1}) {
+ $hilight = 'sb_act_hilight_color %X'.$act_last_line_shades{$1}[$time_delta];
+ }
+ }
+ $cformat = '$0' unless length $cformat;
+ my %map = ('$C' => $cformat, '$N' => '$1', '$Q' => '$2');
+ $format =~ s<(\$.)><$map{$1}//$1>ge;
+ $format =~ s<\$H((?:\$.|[^\$])*?)\$S><{$hilight $1%n}>g;
+ my @ret = ir_parse_special(sb_format_expand($format), [$name, $number, $key], $win);
+ @ret
+}
+
+sub _get_format {
+ Irssi::current_theme->get_format(__PACKAGE__, @_)
+}
+
+sub _is_detached {
+ my ($win, $active_number) = @_;
+ my $level = $win->{data_level} // 0;
+ my $number = $win->{refnum};
+ my $name = lc1459( as_uni($win->{name}) );
+ my $active = lc1459( as_uni($win->get_active_name) // '' );
+ my $tag = $win->{active} && $win->{active}{server} ? lc1459( as_uni($win->{active}{server}{tag}) // '' ) : '';
+ my @cond = ($number);
+ push @cond, "$name" if length $name;
+ push @cond, "$tag/$active" if length $tag && length $active;
+ push @cond, "$active" if length $active;
+ push @cond, "$tag/*", "$tag/::all" if length $tag;
+ push @cond, "*", "::all";
+ for my $cond (@cond) {
+ if (exists $detach_map{ $cond }) {
+ my $dd = $detach_map{ $cond } // $S{detach_data};
+ return $win->{data_level} < abs $dd
+ && ($number != $active_number || 0 <= $dd);
+ }
+ }
+ return;
+}
+
+sub _calculate_items {
+ my ($wins, $abbrevList) = @_;
+
+ my $display_header = _get_format(set 'display_header');
+ my $name_format = _get_format(set 'name_display');
+ my $abbrev_chars = as_uni(_get_format(set 'abbrev_chars'));
+
+ my %displays;
+
+ my $active = Irssi::active_win;
+ @win_items = ();
+ %keymap = (%nummap, %wnmap_exp);
+
+ my ($numPad, $keyPad) = (0, 0);
+ if ($VIEWER_MODE or $S{block} < 0) {
+ $numPad = length((sort { length $b <=> length $a } keys %keymap)[0]) // 0;
+ $keyPad = length((sort { length $b <=> length $a } values %keymap)[0]) // 0;
+ }
+ my $last_net;
+ my ($abbrev1, $abbrev2) = $abbrev_chars =~ /(\X)(.*)/;
+ my @abbrev_chars = ('~', "\x{301c}");
+ unless (defined $abbrev1 && screen_length(as_tc($abbrev1)) == 1) { $abbrev1 = $abbrev_chars[0] }
+ unless (length $abbrev2) {
+ $abbrev2 = $abbrev1;
+ if ($abbrev1 eq $abbrev_chars[0]) {
+ $abbrev2 = $abbrev_chars[1];
+ }
+ else {
+ $abbrev2 = $abbrev1;
+ }
+ }
+ if (screen_length(as_tc($abbrev2)) == 1) {
+ $abbrev2 x= 2;
+ }
+ while (screen_length(as_tc($abbrev2)) > 2) {
+ chop $abbrev2;
+ }
+ unless (screen_length(as_tc($abbrev2)) == 2) {
+ $abbrev2 = $abbrev_chars[1];
+ }
+ for my $win (@$wins) {
+ my $global_tag_header_mode;
+
+ next unless ref $win;
+
+ my $backup_win = Storable::dclone($win);
+ delete $backup_win->{active} unless ref $backup_win->{active};
+
+ $global_tag_header_mode =
+ $display_header && ($last_net // '') ne ($backup_win->{active}{server}{tag} // '');
+
+ if ($win->{data_level} < abs $S{hide_data}
+ && ($win->{refnum} != $active->{refnum} || 0 <= $S{hide_data})) {
+ next; }
+ elsif (exists $awins{$win->{refnum}} && $S{hide_empty} && !$win->items
+ && ($win->{refnum} != $active->{refnum} || 0 <= $S{hide_empty})) {
+ next; }
+ elsif (_is_detached($win, $active->{refnum})) {
+ next; }
+
+ my $colour = $win->{hilight_color} // '';
+ my $hilight = do {
+ if ($win->{data_level} == 0) { 'sb_act_none'; }
+ elsif ($win->{data_level} == 1) { 'sb_act_text'; }
+ elsif ($win->{data_level} == 2) { 'sb_act_msg'; }
+ elsif ($colour ne '') { "sb_act_hilight_color $colour"; }
+ elsif ($win->{data_level} == 3) { 'sb_act_hilight'; }
+ else { 'sb_act_special'; }
+ };
+ my $number = $win->{refnum};
+
+ my ($name, $display, $cdisplay);
+ if ($global_tag_header_mode) {
+ $display = $display_header;
+ $name = as_uni($backup_win->{active}{server}{tag}) // '';
+ if ($custom_xform) {
+ no strict 'refs';
+ local ${ __PACKAGE__ . '::custom_xform::TAG' } = 1;
+ run_custom_xform() for $name;
+ }
+ }
+ else {
+ my @display = ('display_nokey');
+ if (defined $keymap{$number} and $keymap{$number} ne '') {
+ unshift @display, map { (my $cpy = $_) =~ s/_no/_/; $cpy } @display;
+ }
+ if (exists $awins{$number}) {
+ unshift @display, map { my $cpy = $_; $cpy .= '_visible'; $cpy } @display;
+ }
+ if ($active->{refnum} == $number) {
+ unshift @display, map { my $cpy = $_; $cpy .= '_active'; $cpy }
+ grep { !/_visible$/ } @display;
+ }
+ $display = (grep { length $_ }
+ map { $displays{$_} //= _get_format(set $_) }
+ @display)[0];
+ $cdisplay = $name_format;
+ $name = as_uni($win->get_active_name) // '';
+ $name = '*' if $S{banned_on} and exists $banned_channels{lc1459($name)};
+ $name = remove_uniform_vars($win, $name) if $name ne '*';
+ if ($name ne '*' and $win->{name} ne '' and $S{prefer_name}) {
+ $name = as_uni($win->{name});
+ if ($custom_xform) {
+ no strict 'refs';
+ local ${ __PACKAGE__ . '::custom_xform::NAME' } = 1;
+ run_custom_xform() for $name;
+ }
+ }
+
+ if (!$VIEWER_MODE && $S{block} >= 0 && $S{hide_name}
+ && $win->{data_level} < abs $S{hide_name}
+ && ($win->{refnum} != $active->{refnum} || 0 <= $S{hide_name})) {
+ $name = '';
+ $cdisplay = '';
+ }
+ }
+
+ $display = "$display%n";
+ my $num_ent = (' 'x max(0,$numPad - length $number)) . $number;
+ my $key_ent = exists $keymap{$number} ? ((' 'x max(0,$keyPad - length $keymap{$number})) . $keymap{$number}) : ' 'x$keyPad;
+ if ($VIEWER_MODE or $S{sbar_maxlen} or $S{block} < 0) {
+ my $baseLength = sb_length(_format_display(
+ '', $display, $cdisplay, $hilight,
+ 'x', # placeholder
+ $num_ent,
+ $key_ent,
+ $win)) - 1;
+ my $diff = (abs $S{block}) - (screen_length(as_tc($name)) + $baseLength);
+ if ($diff < 0) { # too long
+ my $screen_length = screen_length(as_tc($name));
+ if ((abs $diff) >= $screen_length) { $name = '' } # forget it
+ elsif ((abs $diff) + screen_length(as_tc(substr($name, 0, 1))) >= $screen_length) { $name = substr($name, 0, 1); }
+ else {
+ my $ulen = length $name;
+ my $middle2 = exists $abbrevList->{$name} ?
+ ($S{fancy_strict}) ?
+ 2* $abbrevList->{$name} :
+ (2*($abbrevList->{$name} + $ulen) / 3) :
+ ($S{fancy_head}) ?
+ 2*$ulen :
+ $ulen;
+ my $first = 1;
+ while (length $name > 1) {
+ my $cp = $middle2 >= 0 ? $middle2/2 : -1; # clearing position
+ my $rm = 2;
+ # if character at end is wider than 1 cell -> replace it with ~
+ if (screen_length(as_tc(substr $name, $cp, 1)) > 1) {
+ if ($first || $cp < 0) {
+ $rm = 1;
+ $first = undef;
+ }
+ }
+ elsif ($cp < 0) { # elsif at end -> replace last 2 characters
+ --$cp;
+ }
+ (substr $name, $cp, $rm) = $abbrev1;
+ if ($cp > -1 && $rm > 1) {
+ --$middle2;
+ }
+ my $sl = screen_length(as_tc($name));
+ if ($sl + $baseLength < abs $S{block}) {
+ (substr $name, ($middle2+1)/2, 1) = $abbrev2;
+ last;
+ }
+ elsif ($sl + $baseLength == abs $S{block}) {
+ last;
+ }
+ }
+ }
+ }
+ elsif ($VIEWER_MODE or $S{block} < 0) {
+ $name .= (' ' x $diff);
+ }
+ }
+
+ push @win_items, _format_display(
+ '', $display, $cdisplay, $hilight,
+ as_tc($name),
+ $num_ent,
+ as_tc($key_ent),
+ $win);
+
+ if ($global_tag_header_mode) {
+ $last_net = $backup_win->{active}{server}{tag};
+ redo;
+ }
+
+ $mouse_coords{refnum}{$#win_items} = $number;
+ }
+}
+
+sub _spread_items {
+ my $width = $screenWidth - $sb_base_width - 1;
+ my @separator = _get_format(set 'separator');
+ if ($S{block} >= 0) {
+ my $sep2 = _get_format(set 'separator2');
+ push @separator, $sep2 if length $sep2 && $sep2 ne $separator[0];
+ }
+ $separator[0] .= '%n';
+ my @sepLen = map { sb_length($_) } @separator;
+
+ @actString = ();
+ my $curLine;
+ my $curLen = 0;
+ if ($S{shared_sbar}) {
+ $curLen += $S{shared_sbar}[0] + 2;
+ $width -= $S{shared_sbar}[2];
+ }
+ my $mouse_header_check = 0;
+ for my $it (@win_items) {
+ my $itemLen = sb_length($it);
+ if ($curLen) {
+ if ($curLen + $itemLen + $sepLen[$mouse_header_check % @sepLen] > $width) {
+ $width += $S{shared_sbar}[2]
+ if !@actString && $S{shared_sbar};
+ push @actString, $curLine;
+ $curLine = undef;
+ $curLen = 0;
+ }
+ elsif (defined $curLine) {
+ $curLine .= $separator[$mouse_header_check % @separator];
+ $curLen += $sepLen[$mouse_header_check % @sepLen];
+ }
+ }
+ $curLine .= $it;
+ if (exists $mouse_coords{refnum}{$mouse_header_check}) {
+ $mouse_coords{scalar @actString}{ $_ } = $mouse_coords{refnum}{$mouse_header_check}
+ for $curLen .. $curLen + $itemLen - 1;
+ }
+ $curLen += $itemLen;
+ }
+ continue {
+ ++$mouse_header_check;
+ }
+ $curLen -= $S{shared_sbar}[0]
+ if !@actString && $S{shared_sbar};
+ push @actString, $curLine if $curLen;
+}
+
+sub remake {
+ my %abbrevList;
+ my @wins = window_list();
+ if ($VIEWER_MODE or $S{sbar_maxlen} or $S{block} < 0) {
+ _calculate_abbrev(\@wins, \%abbrevList);
+ }
+
+ %mouse_coords = ( refnum => +{} );
+ _calculate_items(\@wins, \%abbrevList);
+
+ unless ($VIEWER_MODE) {
+ _spread_items();
+
+ push @actString, undef unless @actString || $S{all_disable};
+ }
+}
+
+sub update_wl {
+ return if $BLOCK_ALL;
+ remake();
+
+ Irssi::statusbar_items_redraw(set $_) for keys %statusbars;
+
+ unless ($VIEWER_MODE) {
+ Irssi::timeout_add_once(100, 'syncLines', undef);
+ }
+ else {
+ syncViewer();
+ }
+}
+
+sub screenFullRedraw {
+ my ($window) = @_;
+ if (!ref $window or $window->{refnum} == Irssi::active_win->{refnum}) {
+ $viewer{fullRedraw} = 1 if $viewer{client};
+ $settings_str = '';
+ &setup_changed;
+ }
+}
+
+sub restartViewerServer {
+ if ($VIEWER_MODE) {
+ stop_viewer();
+ start_viewer();
+ }
+}
+
+sub _simple_quote {
+ my @r = map {
+ my $x = $_;
+ $x =~ s/'/'"'"'/g;
+ $x = "'$x'";
+ } @_;
+ wantarray ? @r : shift @r
+}
+
+sub _viewer_command_replace_format {
+ my ($ecmd, @args) = @_;
+ my $file = _simple_quote(SCRIPT_FILE());
+ my $path = _simple_quote($viewer{path});
+ my @env;
+ for my $env (shellwords($S{viewer_launch_env})) {
+ if ($env =~ /^(\w+)(?:=(.*))$/) {
+ push @env, "AWL_$1=$2"
+ }
+ }
+ my $cmd = join ' ',
+ (@env ? ('env', _simple_quote(@env)) : ()),
+ 'perl', $file, '-1', _simple_quote(@args), $path;
+ $ecmd =~ s{%(%|\w+)}{
+ my $sub = $1;
+ if ($sub eq '%') {
+ '%'
+ }
+ elsif ($sub =~ /^(q*)A(.*)/) {
+ my $ret = $cmd;
+ for (1..length $1) {
+ $ret = _simple_quote($ret);
+ }
+ "$ret$2"
+ }
+ else {
+ "%$sub"
+ }
+ }gex;
+ $ecmd
+}
+
+sub start_viewer {
+ unlink $viewer{path} if -S $viewer{path} || -p _;
+
+ $viewer{server} = IO::Socket::UNIX->new(
+ Type => SOCK_STREAM,
+ Local => $viewer{path},
+ Listen => 1
+ );
+ unless ($viewer{server}) {
+ $viewer{msg} = "Viewer: $!";
+ $viewer{retry} = Irssi::timeout_add_once(5000, 'retry_viewer', 1);
+ return;
+ }
+ $viewer{server}->blocking(0);
+ set_viewer_mode_hint();
+ $viewer{server_tag} = Irssi::input_add($viewer{server}->fileno, INPUT_READ, 'vi_connected', undef);
+
+ if ($S{viewer_launch}) {
+ if (length $ENV{TMUX_PANE} && length $ENV{TMUX} && lc $S{viewer_tmux_position} ne 'custom') {
+ my $cmd = _viewer_command_replace_format('%qA', '-p', lc $S{viewer_tmux_position});
+ Irssi::command("exec - tmux neww -d $cmd 2>&1 &");
+ }
+ elsif (length $ENV{WINDOWID} && length $ENV{DISPLAY} && length $S{viewer_xwin_command} && $S{viewer_xwin_command} =~ /\S/) {
+ my $cmd = _viewer_command_replace_format($S{viewer_xwin_command});
+ Irssi::command("exec - $cmd 2>&1 &");
+ }
+ elsif (length $S{viewer_custom_command} && $S{viewer_custom_command} =~ /\S/) {
+ my $cmd = _viewer_command_replace_format($S{viewer_custom_command});
+ Irssi::command("exec - $cmd 2>&1 &");
+ }
+ }
+}
+
+sub set_viewer_mode_hint {
+ return unless $viewer{server};
+ if ($S{no_mode_hint}) {
+ $viewer{msg} = undef;
+ }
+ else {
+ my ($name) = __PACKAGE__ =~ /::([^:]+)$/;
+ $viewer{msg} = "Run $name from the shell or switch to sbar mode";
+ }
+}
+
+sub retry_viewer {
+ start_viewer();
+}
+
+sub vi_close_client {
+ Irssi::input_remove(delete $viewer{client_tag}) if exists $viewer{client_tag};
+ $viewer{client}->close if $viewer{client};
+ delete $viewer{client};
+ delete $viewer{client_keymap};
+ delete $viewer{client_settings};
+ delete $viewer{client_env};
+ delete $viewer{fullRedraw};
+}
+
+sub vi_connected {
+ vi_close_client();
+ $viewer{client} = $viewer{server}->accept or return;
+ $viewer{client}->blocking(0);
+ $viewer{client_tag} = Irssi::input_add($viewer{client}->fileno, INPUT_READ, 'vi_clientinput', undef);
+ syncViewer();
+}
+
+use constant VIEWER_BLOCK_SIZE => 1024;
+sub vi_clientinput {
+ if ($viewer{client}->read(my $buf, VIEWER_BLOCK_SIZE)) {
+ $viewer{rcvbuf} .= $buf;
+ if ($viewer{rcvbuf} =~ s/^(?:(active|\d+)|(last|up|down))\n//igm) {
+ if (defined $2) {
+ Irssi::command("window $2");
+ }
+ elsif (lc $1 eq 'active' && $viewer{use_ack}) {
+ Irssi::command($viewer{use_ack});
+ }
+ else {
+ Irssi::command("window goto $1");
+ }
+ }
+ }
+ else {
+ vi_close_client();
+ Irssi::timeout_add_once(100, 'syncViewer', undef);
+ }
+}
+
+sub stop_viewer {
+ Irssi::timeout_remove(delete $viewer{retry}) if exists $viewer{retry};
+ vi_close_client();
+ Irssi::input_remove(delete $viewer{server_tag}) if exists $viewer{server_tag};
+ return unless $viewer{server};
+ $viewer{server}->close;
+ delete $viewer{server};
+}
+sub _encode_var {
+ my $str;
+ while (@_) {
+ my ($name, $var) = splice @_, 0, 2;
+ my $type = ref $var ? $var =~ /HASH/ ? 'map' : $var =~ /ARRAY/ ? 'list' : '' : '';
+ $str .= "\n\U$name$type\_begin\n";
+ if ($type eq 'map') {
+ no warnings 'numeric';
+ $str .= " $_\n ${$var}{$_}\n" for sort { $a <=> $b || $a cmp $b } keys %$var;
+ }
+ elsif ($type eq 'list') {
+ $str .= " $_\n" for @$var;
+ }
+ else {
+ $str .= " $var\n";
+ }
+ $str .= "\U$name$type\_end\n";
+ }
+ $str
+}
+sub syncViewer {
+ if ($viewer{client}) {
+ @actString = ();
+ if ($currentLines) {
+ killOldStatus();
+ $currentLines = 0;
+ }
+ my $str;
+ unless ($viewer{client_keymap}) {
+ $str .= _encode_var('key', +{ %nummap, %specialmap });
+ $viewer{client_keymap} = 1;
+ }
+ unless ($viewer{client_settings}) {
+ $str .= _encode_var(
+ block => $S{block},
+ ha => $S{height_adjust},
+ mc => $S{maxcolumns},
+ ml => $S{maxlines},
+ tc => $S{true_colour},
+ );
+ $viewer{client_settings} = 1;
+ }
+ unless ($viewer{client_env}) {
+ $str .= _encode_var(irssienv => +{
+ length $ENV{TMUX_PANE} && length $ENV{TMUX} ?
+ (tmux_pane => $ENV{TMUX_PANE},
+ tmux_srv => $ENV{TMUX}) : (),
+ length $ENV{WINDOWID} ?
+ (xwinid => $ENV{WINDOWID}) : (),
+ });
+ $viewer{client_env} = 1;
+ }
+ my $separator = _get_format(set 'separator');
+ my $sepLen = sb_length($separator);
+ my $item_bg = _get_format(set 'viewer_item_bg');
+ my $title = _get_format(set 'title');
+ if (length $title) {
+ $title =~ s{\\(.)|(.)}{
+ defined $2 ? quotemeta $2
+ : $1 eq 'V' ? '\U'
+ : $1 eq ':' ? quotemeta '%N'
+ : $1 =~ /^[uUFQE]$/ ? "\\$1"
+ : quotemeta "\\$1"
+ }sge;
+ $title = eval qq{"$title"};
+ }
+ $str .= _encode_var(redraw => 1) if delete $viewer{fullRedraw};
+ $str .= _encode_var(separator => $separator,
+ seplen => $sepLen,
+ itembg => $item_bg,
+ title => $title,
+ mouse => $mouse_coords{refnum},
+ key2 => \%wnmap_exp,
+ win => \@win_items);
+
+ my $was = $viewer{client}->blocking(1);
+ $viewer{client}->print($str);
+ $viewer{client}->blocking($was);
+ }
+ elsif ($viewer{server}) {
+ if (defined $viewer{msg}) {
+ @actString = ((uc setc()).": $viewer{msg}");
+ }
+ else {
+ @actString = ();
+ }
+ }
+ elsif (defined $viewer{msg}) {
+ @actString = ((uc setc()).": $viewer{msg}");
+ }
+ if (@actString) {
+ Irssi::timeout_add_once(100, 'syncLines', undef);
+ }
+ elsif ($currentLines) {
+ killOldStatus();
+ $currentLines = 0;
+ }
+}
+
+sub reset_awl {
+ Irssi::timeout_remove($shade_line_timer) if $shade_line_timer; $shade_line_timer = undef;
+ my $was_sort = $S{sort} // '';
+ my $was_xform = $S{xform} // '';
+ my $was_shared = $S{shared_sbar};
+ my $was_no_hint = $S{no_mode_hint};
+ my $was_custom_key = $S{custom_key_re} // '';
+ %S = (
+ sort => Irssi::settings_get_str( set 'sort'),
+ fancy_abbrev => Irssi::settings_get_str('fancy_abbrev'),
+ xform => Irssi::settings_get_str( set 'custom_xform'),
+ block => Irssi::settings_get_int( set 'block'),
+ banned_on => Irssi::settings_get_bool('banned_channels_on'),
+ prefer_name => Irssi::settings_get_bool(set 'prefer_name'),
+ hide_data => Irssi::settings_get_int( set 'hide_data'),
+ hide_name => Irssi::settings_get_int( set 'hide_name_data'),
+ hide_empty => Irssi::settings_get_int( set 'hide_empty'),
+ custom_key_re => Irssi::settings_get_str( set 'custom_key_re'),
+ detach => Irssi::settings_get_str( set 'detach'),
+ detach_data => Irssi::settings_get_int( set 'detach_data'),
+ detach_aht => Irssi::settings_get_bool(set 'detach_aht'),
+ sbar_maxlen => Irssi::settings_get_bool(set 'sbar_maxlength'),
+ placement => Irssi::settings_get_str( set 'placement'),
+ position => Irssi::settings_get_int( set 'position'),
+ maxlines => Irssi::settings_get_int( set 'maxlines'),
+ maxcolumns => Irssi::settings_get_int( set 'maxcolumns'),
+ all_disable => Irssi::settings_get_bool(set 'all_disable'),
+ height_adjust => Irssi::settings_get_int( set 'height_adjust'),
+ mouse_offset => Irssi::settings_get_int( set 'mouse_offset'),
+ mouse_scroll => Irssi::settings_get_int( 'mouse_scroll'),
+ mouse_escape => Irssi::settings_get_int( 'mouse_escape'),
+ line_shade => Irssi::settings_get_time(set 'last_line_shade'),
+ no_mode_hint => Irssi::settings_get_bool(set 'no_mode_hint'),
+ true_colour => Irssi::parse_special('$colors_ansi_24bit'),
+ viewer_launch => Irssi::settings_get_bool(set 'viewer_launch'),
+ viewer_launch_env => Irssi::settings_get_str(set 'viewer_launch_env'),
+ viewer_xwin_command => Irssi::settings_get_str(set 'viewer_xwin_command'),
+ viewer_custom_command => Irssi::settings_get_str(set 'viewer_custom_command'),
+ viewer_tmux_position => Irssi::settings_get_str(set 'viewer_tmux_position'),
+ );
+ $S{fancy_strict} = $S{fancy_abbrev} =~ /^strict/i;
+ $S{fancy_head} = $S{fancy_abbrev} =~ /^head/i;
+ my $shared = Irssi::settings_get_str(set 'shared_sbar');
+ if ($shared =~ /^(\d+)([<])(\d+)$/) {
+ $S{shared_sbar} = [$1, $2, $3];
+ }
+ else {
+ Irssi::settings_set_str(set 'shared_sbar', 'OFF');
+ $S{shared_sbar} = undef;
+ }
+ lock_keys(%S);
+ if ($was_sort ne $S{sort}) {
+ $print_text_activity = undef;
+ my @sort_order = grep { @$_ > 4 } map {
+ s/^\s*//;
+ my $reverse = s/^\W*\K[-!]//;
+ my $undef_check = s/^\W*\K~// ? 1 : undef;
+ my $equal_check = s/=(.*)\s?$// ? $1 : undef;
+ s/\s*$//;
+ my $ignore_case = s/#i$// ? 1 : undef;
+
+ $print_text_activity = 1 if $_ eq 'last_line';
+
+ my @path = split '/';
+ my $class_check = @path && $path[-1] =~ s/(::.*)$// ? $1 : undef;
+ my $lru = "@path" eq 'lru';
+
+ [ $reverse ? -1 : 1, $undef_check, $equal_check, $class_check, $ignore_case, $lru, @path ]
+ } "$S{sort}," =~ /([^+,]*|[^+,]*=[^,]*?\s(?=\+)|[^+,]*=[^,]*)[+,]/g;
+ $window_sort_func = sub {
+ no warnings qw(numeric uninitialized);
+ for my $so (@sort_order) {
+ my @x = map {
+ my $ret = 0;
+ $_ = lc1459($_) if defined $_ && !ref $_ && $so->[4];
+ $ret = $_ eq ($so->[4] ? lc1459($so->[2]) : $so->[2]) ? 1 : -1 if defined $so->[2];
+ $ret = defined $_ ? ($ret || -3) : 3 if $so->[1];
+ $ret = ref $_ && $_->isa('Irssi'.$so->[3]) ? 2 : ($ret || -2) if $so->[3];
+ -$ret || $_
+ }
+ map {
+ $so->[5] ? $_->[0] : reduce { return unless ref $a; $a->{$b} } $_->[1], @{$so}[6..$#$so]
+ } $a, $b;
+ return ((($x[0] <=> $x[1] || $x[0] cmp $x[1]) * $so->[0]) || next);
+ }
+ return ($a->[1]{refnum} <=> $b->[1]{refnum});
+ };
+ }
+ if ($was_xform ne $S{xform}) {
+ if ($S{xform} !~ /\S/) {
+ $custom_xform = undef;
+ }
+ else {
+ my $script_pkg = __PACKAGE__ . '::custom_xform';
+ local $@;
+ $custom_xform = eval qq{
+package $script_pkg;
+use strict;
+no warnings;
+our (\$QUERY, \$CHANNEL, \$TAG, \$NAME);
+return sub {
+# line 1 @{[ set 'custom_xform' ]}\n$S{xform}\n}};
+ if ($@) {
+ $@ =~ /^(.*)/;
+ print '%_'.(set 'custom_xform').'%_ did not compile: '.$1;
+ }
+ }
+ }
+ if ($was_custom_key ne $S{custom_key_re}) {
+ my $custom_key = $S{custom_key_re};
+ my $was_custom_key_re = $custom_key_re;
+ local $@;
+ eval { $custom_key_re = qr/(?i)$custom_key/; 1 }
+ or do {
+ print '%_'.(set 'custom_key_re').'%_ did not compile: '
+ . do { $@ =~ /(.*) at / && $1 };
+ $custom_key_re = qr/(?!)/;
+ };
+ if ($was_custom_key_re ne $custom_key_re) {
+ update_keymap();
+ }
+ }
+
+ my $new_settings = join "\n", $VIEWER_MODE
+ ? ("\\", $S{block}, $S{height_adjust}, $S{maxlines}, $S{maxcolumns}, $S{true_colour})
+ : ("!", $S{placement}, $S{position});
+
+ my $first_viewer = $settings_str eq '1';
+ if ($settings_str ne $new_settings) {
+ @actString = ();
+ %abbrev_cache = ();
+ $currentLines = 0;
+ killOldStatus();
+ delete $viewer{client_settings};
+ $settings_str = $new_settings;
+ }
+
+ my $was_mouse_mode = $MOUSE_ON;
+ if ($MOUSE_ON = Irssi::settings_get_bool(set 'mouse') and !$was_mouse_mode) {
+ install_mouse();
+ }
+ elsif ($was_mouse_mode and !$MOUSE_ON) {
+ uninstall_mouse();
+ }
+
+ unless ($first_viewer) {
+ my $path = Irssi::settings_get_str(set 'path');
+ my $was_viewer_mode = $VIEWER_MODE;
+ if ($was_viewer_mode &&
+ defined $viewer{path} && $viewer{path} ne $path) {
+ stop_viewer();
+ $was_viewer_mode = 0;
+ }
+ elsif ($was_viewer_mode && $S{no_mode_hint} != $was_no_hint + 0) {
+ set_viewer_mode_hint();
+ }
+ $viewer{path} = $path;
+ if ($VIEWER_MODE = Irssi::settings_get_bool(set 'viewer') and !$was_viewer_mode) {
+ start_viewer();
+ }
+ elsif ($was_viewer_mode and !$VIEWER_MODE) {
+ stop_viewer();
+ }
+ }
+
+ %banned_channels = map { lc1459(as_uni($_)) => undef }
+ split ' ', Irssi::settings_get_str('banned_channels');
+
+ %detach_map = ($S{detach_aht}
+ ? (map { ( lc1459(as_uni($_)) => undef ) }
+ split ' ', Irssi::settings_get_str('activity_hide_targets')) : (),
+ (map { my ($k, $v) = (split /(?:,(-?\d+))$/, $_)[0, 1];
+ ( lc1459(as_uni($k)) => $v ) }
+ split ' ', $S{detach}));
+
+ my @sb_base = split /\177/, sb_format_expand("{sbstart}{sb \177}{sbend}"), 2;
+ $sb_base_width_pre = sb_length($sb_base[0]);
+ $sb_base_width_post = max 0, sb_length($sb_base[1])-1;
+ $sb_base_width = $sb_base_width_pre + $sb_base_width_post;
+
+ if ($print_text_activity && $S{line_shade}) {
+ $shade_line_timer = Irssi::timeout_add(max(10 * GLOB_QUEUE_TIMER, 100*$S{line_shade}**(1/3)), 'wl_changed', undef);
+ }
+
+ $CHANGED{AWINS} = 1;
+}
+
+sub hide_window {
+ my ($data) = @_;
+ my $ent;
+
+ $data =~ s/\s*$//;
+ my $win = Irssi::active_win;
+ my $number = $win->{refnum};
+ my $name = as_uni($win->{name});
+ my $active = as_uni($win->get_active_name) // '';
+ my $tag = $win->{active} && $win->{active}{server} ? as_uni($win->{active}{server}{tag}) // '' : '';
+ if (length $name) {
+ $ent = "$name";
+ }
+ elsif (length $tag && length $active) {
+ $ent = "$tag/$active";
+ }
+ else {
+ $ent = "$number";
+ }
+
+ my $found = 0;
+ my @setting;
+ for my $s (split ' ', $S{detach}) {
+ my ($k, $v) = (split /(?:,(-?\d+))$/, $s)[0, 1];
+ if (lc1459(as_uni($k)) eq lc1459($ent)) {
+ unless ($found) {
+ if ($data =~ /^(-?\d+)$/) {
+ $ent .= ",$1";
+ }
+ if (defined $v && 0 == abs $v) {
+ $win->print("Hiding window $ent");
+ }
+ push @setting, as_tc($ent);
+ $found = 1;
+ }
+ }
+ else {
+ push @setting, defined $v ? "$k,$v" : $k;
+ }
+ }
+ unless ($found) {
+ $win->print("Hiding window $ent");
+ if ($data =~ /^(-?\d+)$/) {
+ $ent .= ",$1";
+ }
+ push @setting, as_tc($ent);
+ }
+
+ if (@setting) {
+ Irssi::command("^set ".(set 'detach')." @setting");
+ } else {
+ Irssi::command("^set -clear ".(set 'detach'));
+ }
+}
+
+sub unhide_window {
+ my ($data, $server, $witem) = @_;
+ my $win = Irssi::active_win;
+ my $number = $win->{refnum};
+ my $name = as_uni($win->{name});
+ my $active = as_uni($win->get_active_name) // '';
+ my $tag = $win->{active} && $win->{active}{server} ? as_uni($win->{active}{server}{tag}) // '' : '';
+
+ my %detach_aht;
+ if ($S{detach_aht}) {
+ %detach_aht = (map { ( lc1459(as_uni($_)) => undef ) }
+ split ' ', Irssi::settings_get_str('activity_hide_targets'));
+ }
+ my @setting;
+ my @kills = (length $name ? $name : undef,
+ length $tag && length $active ? "$tag/$active" : undef,
+ length $active ? $active : undef,
+ $number);
+ my @was_unhidden = (0) x @kills;
+ for my $s (split ' ', $S{detach}) {
+ my ($k, $v) = (split /(?:,(-?\d+))$/, $s)[0, 1];
+ my $k2 = lc1459(as_uni($k));
+ my $kill;
+ for my $ki (0..$#kills) {
+ if (defined $kills[$ki] && $k2 eq lc1459($kills[$ki])) {
+ $kill = $ki;
+ }
+ }
+
+ if (defined $kill) {
+ if (defined $v && 0 == abs $v) {
+ $was_unhidden[$kill] = 1;
+ push @setting, defined $v ? "$k,$v" : $k;
+ } else {
+ $win->print("Unhiding window $kills[$kill]");
+ }
+ }
+ else {
+ push @setting, defined $v ? "$k,$v" : $k;
+ }
+ }
+ my @is_hidden = (defined $kills[0] && (exists $detach_map{"*"} || exists $detach_map{"::all"}),
+ defined $kills[1] && (exists $detach_map{lc1459("$tag/*")} || exists $detach_map{lc1459("$tag/::all")}
+ || exists $detach_map{"*"} || exists $detach_map{"::all"}),
+ defined $kills[2] && (exists $detach_map{"*"} || exists $detach_map{"::all"}),
+ (exists $detach_map{"*"} || exists $detach_map{"::all"})
+ );
+ for my $ki (1, 2, 0, 3) {
+ if ($is_hidden[$ki]) {
+ unless ($was_unhidden[$ki]) {
+ $win->print("Unhiding window $kills[$ki]");
+ push @setting, "$kills[$ki],0";
+ $was_unhidden[$ki] = 1;
+ }
+ last;
+ }
+ }
+ my @is_hidden_aht = (defined $kills[0] && (exists $detach_aht{lc1459($name)}
+ || exists $detach_aht{"*"} || exists $detach_aht{"::all"}),
+ defined $kills[1] && (exists $detach_aht{lc1459("$tag/$active")}
+ || exists $detach_aht{lc1459($active)}
+ || exists $detach_aht{lc1459("$tag/*")} || exists $detach_aht{lc1459("$tag/::all")}
+ || exists $detach_aht{"*"} || exists $detach_aht{"::all"}),
+ defined $kills[2] && (exists $detach_aht{lc1459($active)}
+ || exists $detach_aht{"*"} || exists $detach_aht{"::all"}),
+ (exists $detach_aht{$number} || exists $detach_aht{"*"} || exists $detach_aht{"::all"})
+ );
+ for my $ki (1, 2, 0, 3) {
+ if ($is_hidden_aht[$ki]) {
+ unless ($was_unhidden[$ki]) {
+ $win->print("Unhiding window $kills[$ki], it is hidden because ".(set 'detach_aht')." is ON");
+ push @setting, "$kills[$ki],0";
+ $was_unhidden[$ki] = 1;
+ }
+ last;
+ }
+ }
+
+ if (@setting) {
+ Irssi::command("^set ".(set 'detach')." @setting");
+ } else {
+ Irssi::command("^set -clear ".(set 'detach'));
+ }
+}
+
+sub ack_window {
+ my ($data, $server, $witem) = @_;
+ my $win = Irssi::active_win;
+ my $number = $win->{refnum};
+ if (grep { $_->{cmd} eq 'ack' } Irssi::commands) {
+ my $Orig_Irssi_windows = \&Irssi::windows;
+ local *Irssi::windows = sub () { grep { !_is_detached($_, $number) } $Orig_Irssi_windows->() };
+ Irssi::command("ack" . (length $data ? " $data" : ""));
+ } else {
+ my $ignore_refnum = Irssi::settings_get_bool('active_window_ignore_refnum');
+ my $max_win;
+ my $max_act = 0;
+ my $max_ref = 0;
+ for my $rec (Irssi::windows) {
+ next if _is_detached($rec, $number);
+
+ # ignore refnum
+ if ($ignore_refnum &&
+ $rec->{data_level} > 0 && $max_act < $rec->{data_level}) {
+ $max_act = $rec->{data_level};
+ $max_win = $rec;
+ }
+
+ # windows with lower refnums break ties
+ elsif (!$ignore_refnum &&
+ $rec->{data_level} > 0 &&
+ ($rec->{data_level} > $max_act ||
+ ($rec->{data_level} == $max_act && $rec->{refnum} < $max_ref))) {
+ $max_act = $rec->{data_level};
+ $max_win = $rec;
+ $max_ref = $rec->{refnum};
+ }
+ }
+ $max_win->set_active if defined $max_win;
+ }
+}
+
+sub refnum_changed {
+ my ($win, $old_refnum) = @_;
+ my @old_setting = split ' ', $S{detach};
+ my @setting = map {
+ my ($k, $v) = (split /(?:,(-?\d+))$/, $_)[0, 1];
+ if ($k eq $old_refnum) {
+ $win->{refnum} . (defined $v ? ",$v" : "")
+ }
+ else {
+ $_
+ }
+ } @old_setting;
+ if ("@old_setting" ne "@setting") {
+ $S{detach} = "@setting";
+ Irssi::settings_set_str(set 'detach', "@setting");
+ &setup_changed;
+ }
+ else {
+ &wl_changed;
+ }
+}
+
+sub window_destroyed {
+ my ($win) = @_;
+ my @old_setting = split ' ', $S{detach};
+ my @setting = grep {
+ my ($k, $v) = (split /(?:,(-?\d+))$/, $_)[0, 1];
+ if ($k eq $win->{refnum}) {
+ 0;
+ }
+ else {
+ 1;
+ }
+ } @old_setting;
+ if ("@old_setting" ne "@setting") {
+ $S{detach} = "@setting";
+ Irssi::settings_set_str(set 'detach', "@setting");
+ &setup_changed;
+ }
+ else {
+ &awins_changed;
+ }
+}
+
+sub stop_mouse_tracking {
+ print STDERR "\e[?1005l\e[?1000l";
+}
+sub start_mouse_tracking {
+ print STDERR "\e[?1000h\e[?1005h";
+}
+sub install_mouse {
+ Irssi::command_bind('mouse_xterm' => 'mouse_xterm');
+ Irssi::command('^bind meta-[M command mouse_xterm');
+ Irssi::signal_add_first('gui key pressed' => 'mouse_key_hook');
+ start_mouse_tracking();
+}
+sub uninstall_mouse {
+ stop_mouse_tracking();
+ Irssi::signal_remove('gui key pressed' => 'mouse_key_hook');
+ Irssi::command('^bind -delete meta-[M');
+ Irssi::command_unbind('mouse_xterm' => 'mouse_xterm');
+}
+
+sub awl_mouse_event {
+ return if $VIEWER_MODE;
+ if ((($_[0] == 3 and $_[3] == 0)
+ || $_[0] == 64 || $_[0] == 65) and
+ $_[1] == $_[4] and $_[2] == $_[5]) {
+ my $top = lc $S{placement} eq 'top';
+ my ($pos, $line) = @_[1 .. 2];
+ unless ($top) {
+ $line -= $screenHeight;
+ $line += $currentLines;
+ $line += $S{mouse_offset};
+ }
+ else {
+ $line -= $S{mouse_offset};
+ }
+ $pos -= $sb_base_width_pre;
+ return if $line < 0 || $line >= $currentLines;
+ if ($_[0] == 64) {
+ Irssi::command('window up');
+ }
+ elsif ($_[0] == 65) {
+ Irssi::command('window down');
+ }
+ elsif (exists $mouse_coords{$line}{$pos}) {
+ my $win = $mouse_coords{$line}{$pos};
+ Irssi::command('window ' . $win);
+ }
+ Irssi::signal_stop;
+ }
+}
+
+sub mouse_scroll_event {
+ return unless $S{mouse_scroll};
+ if (($_[3] == 64 or $_[3] == 65) and
+ $_[0] == $_[3] and $_[1] == $_[4] and $_[2] == $_[5]) {
+ my $cmd = 'scrollback goto ' . ($_[3] == 64 ? '-' : '+') . $S{mouse_scroll};
+ Irssi::active_win->command($cmd);
+ Irssi::signal_stop;
+ }
+ elsif ($_[0] == 64 or $_[0] == 65) {
+ Irssi::signal_stop;
+ }
+}
+
+sub mouse_escape {
+ return unless $S{mouse_escape} > 0;
+ if ($_[0] == 3) {
+ my $tm = $S{mouse_escape};
+ $tm *= 1000 if $tm < 1000;
+ stop_mouse_tracking();
+ Irssi::timeout_add_once($tm, 'start_mouse_tracking', undef);
+ Irssi::signal_stop;
+ }
+}
+
+sub UNLOAD {
+ @actString = ();
+ killOldStatus();
+ stop_viewer() if $VIEWER_MODE;
+ uninstall_mouse() if $MOUSE_ON;
+}
+
+sub addPrintTextHook { # update on print text
+ return unless defined $^S;
+ return if $BLOCK_ALL;
+ return unless $print_text_activity;
+ return if $_[0]->{level} == MSGLEVEL_CLIENTNOTICE and $_[0]->{target} eq ''
+ and !defined($_[0]->{server});
+ &wl_changed;
+}
+
+sub block_event_window_change {
+ Irssi::signal_stop;
+}
+
+sub update_awins {
+ my @wins = Irssi::windows;
+ local $BLOCK_ALL = 1;
+ Irssi::signal_add_first('window changed' => 'block_event_window_change');
+ my $bwin =
+ my $awin = Irssi::active_win;
+ my $lwin;
+ my $defer_irssi_broken_last;
+ unless ($wins[0]{refnum} == $awin->{refnum}) {
+ # special case: more than 1 last win, so /win last;
+ # /win last doesn't come back to the current window. eg. after
+ # connect & autojoin; we can't handle this situation, bail out
+ $defer_irssi_broken_last = 1;
+ }
+ else {
+ $awin->command('window last');
+ $lwin = Irssi::active_win;
+ $lwin->command('window last');
+ $defer_irssi_broken_last = $lwin->{refnum} == $bwin->{refnum};
+ }
+ my $awin_counter = 0;
+ Irssi::signal_remove('window changed' => 'block_event_window_change');
+ unless ($defer_irssi_broken_last) {
+ # we need to keep the fe-windows code running here
+ Irssi::signal_add_priority('window changed' => 'block_event_window_change', -99);
+ %awins = %wnmap_exp = ();
+ do {
+ Irssi::active_win->command('window up');
+ $awin = Irssi::active_win;
+ $awins{$awin->{refnum}} = undef;
+ ++$awin_counter;
+ } until ($awin->{refnum} == $bwin->{refnum} || $awin_counter >= @wins);
+ Irssi::signal_remove('window changed' => 'block_event_window_change');
+
+ Irssi::signal_add_first('window changed' => 'block_event_window_change');
+ for my $key (keys %wnmap) {
+ next unless Irssi::window_find_name($key) || Irssi::window_find_item($key);
+ $awin->command("window goto $key");
+ my $cwin = Irssi::active_win;
+ $wnmap_exp{ $cwin->{refnum} } = $wnmap{$key};
+ $cwin->command('window last')
+ if $cwin->{refnum} != $awin->{refnum};
+ }
+ for my $win (reverse @wins) { # restore original window order
+ Irssi::active_win->command('window '.$win->{refnum});
+ }
+ $awin->command('window '.$lwin->{refnum}); # restore last win
+ Irssi::active_win->command('window last');
+ Irssi::signal_remove('window changed' => 'block_event_window_change');
+ }
+ $CHANGED{WL} = 1;
+}
+
+sub resizeTerm {
+ if (defined (my $r = `stty size 2>/dev/null`)) {
+ ($screenHeight, $screenWidth) = split ' ', $r;
+ $CHANGED{SETUP} = 1;
+ }
+ else {
+ $CHANGED{SIZE} = 1;
+ }
+}
+
+sub awl_refresh {
+ $globTime = undef;
+ resizeTerm() if delete $CHANGED{SIZE};
+ reset_awl() if delete $CHANGED{SETUP};
+ update_awins() if delete $CHANGED{AWINS};
+ update_wl() if delete $CHANGED{WL};
+}
+
+sub termsize_changed { $CHANGED{SIZE} = 1; &queue_refresh; }
+sub setup_changed { $CHANGED{SETUP} = 1; &queue_refresh; }
+sub awins_changed { $CHANGED{AWINS} = 1; &queue_refresh; }
+sub wl_changed { $CHANGED{WL} = 1; &queue_refresh; }
+
+sub window_changed {
+ &awins_changed if $_[1];
+}
+
+sub queue_refresh {
+ return if $BLOCK_ALL;
+ Irssi::timeout_remove($globTime)
+ if defined $globTime; # delay the update further
+ $globTime = Irssi::timeout_add_once(GLOB_QUEUE_TIMER, 'awl_refresh', undef);
+}
+
+sub awl_init {
+ termsize_changed();
+ setup_changed();
+ update_keymap();
+ Irssi::timeout_remove($globTime)
+ if defined $globTime;
+ awl_refresh();
+ termsize_changed();
+}
+
+sub runsub {
+ my $cmd = shift;
+ sub {
+ my ($data, $server, $item) = @_;
+ Irssi::command_runsub($cmd, $data, $server, $item);
+ };
+}
+
+Irssi::signal_register({
+ 'gui mouse' => [qw/int int int int int int/],
+ });
+{ my $broken_expandos = (Irssi::version >= 20081128 && Irssi::version < 20110210)
+ ? sub { my $x = shift; $x =~ s/\$\{cumode_space\}/ /; $x } : undef;
+ Irssi::theme_register([
+ map { $broken_expandos ? $broken_expandos->($_) : $_ }
+ set 'display_nokey' => '$N${cumode_space}$H$C$S',
+ set 'display_key' => '$Q${cumode_space}$H$C$S',
+ set 'display_nokey_visible' => '%2$N${cumode_space}$H$C$S',
+ set 'display_key_visible' => '%2$Q${cumode_space}$H$C$S',
+ set 'display_nokey_active' => '%1$N${cumode_space}$H$C$S',
+ set 'display_key_active' => '%1$Q${cumode_space}$H$C$S',
+ set 'display_header' => '%8$C|${N}',
+ set 'name_display' => '$0',
+ set 'separator' => ' ',
+ set 'separator2' => '',
+ set 'abbrev_chars' => "~\x{301c}",
+ set 'viewer_item_bg' => sb_format_expand('{sb_background}'),
+ set 'title' => '\V'.setc().'\:',
+ ]);
+}
+Irssi::settings_add_bool(setc, set 'prefer_name', 0); #
+Irssi::settings_add_int( setc, set 'hide_empty', 0); #
+Irssi::settings_add_int( setc, set 'hide_data', 0); #
+Irssi::settings_add_str( setc, set 'detach', ''); #
+Irssi::settings_add_int( setc, set 'detach_data', -3); #
+Irssi::settings_add_bool(setc, set 'detach_aht', 0); #
+Irssi::settings_add_int( setc, set 'hide_name_data', 0); #
+Irssi::settings_add_int( setc, set 'maxlines', 9); #
+Irssi::settings_add_int( setc, set 'maxcolumns', 4); #
+Irssi::settings_add_int( setc, set 'block', 15); #
+Irssi::settings_add_bool(setc, set 'sbar_maxlength', 1); #
+Irssi::settings_add_int( setc, set 'height_adjust', 2); #
+Irssi::settings_add_str( setc, set 'sort', 'refnum'); #
+Irssi::settings_add_str( setc, set 'placement', 'bottom'); #
+Irssi::settings_add_int( setc, set 'position', 0); #
+Irssi::settings_add_bool(setc, set 'all_disable', 1); #
+Irssi::settings_add_bool(setc, set 'viewer', 1); #
+Irssi::settings_add_str( setc, set 'shared_sbar', 'OFF'); #
+Irssi::settings_add_bool(setc, set 'mouse', 0); #
+Irssi::settings_add_str( setc, set 'path', Irssi::get_irssi_dir . '/_windowlist'); #
+Irssi::settings_add_str( setc, set 'custom_xform', ''); #
+Irssi::settings_add_str( setc, set 'custom_key_re', 'f\d+'); #
+Irssi::settings_add_time(setc, set 'last_line_shade', '0'); #
+Irssi::settings_add_int( setc, set 'mouse_offset', 1); #
+Irssi::settings_add_int( setc, 'mouse_scroll', 3); #
+Irssi::settings_add_int( setc, 'mouse_escape', 1); #
+Irssi::settings_add_str( setc, 'banned_channels', '');
+Irssi::settings_add_bool(setc, 'banned_channels_on', 1);
+Irssi::settings_add_str( setc, 'fancy_abbrev', 'fancy'); #
+Irssi::settings_add_bool(setc, set 'no_mode_hint', 0); #
+Irssi::settings_add_bool(setc, set 'viewer_launch', 1); #
+Irssi::settings_add_str( setc, set 'viewer_launch_env', ''); #
+Irssi::settings_add_str( setc, set 'viewer_tmux_position', 'left'); #
+Irssi::settings_add_str( setc, set 'viewer_xwin_command', 'xterm +sb -e %A'); #
+Irssi::settings_add_str( setc, set 'viewer_custom_command', ''); #
+
+Irssi::signal_add_last({
+ 'setup changed' => 'setup_changed',
+ 'print text' => 'addPrintTextHook',
+ 'terminal resized' => 'termsize_changed',
+ 'setup reread' => 'screenFullRedraw',
+ 'window hilight' => 'wl_changed',
+ 'command format' => 'wl_changed',
+});
+Irssi::signal_add({
+ 'window changed' => 'window_changed',
+ 'window item changed' => 'wl_changed',
+ 'window changed automatic' => 'window_changed',
+ 'window created' => 'awins_changed',
+ 'window destroyed' => 'window_destroyed',
+ 'window name changed' => 'wl_changed',
+ 'window refnum changed' => 'refnum_changed',
+});
+Irssi::signal_add_last('gui mouse' => 'mouse_escape');
+Irssi::signal_add_last('gui mouse' => 'mouse_scroll_event');
+Irssi::signal_add_last('gui mouse' => 'awl_mouse_event');
+Irssi::command_bind( setc() => runsub(setc()) );
+Irssi::command_bind( setc() . ' redraw' => 'screenFullRedraw' );
+Irssi::command_bind( setc() . ' restart' => 'restartViewerServer' );
+Irssi::command_bind( setc() . ' attach' => 'unhide_window' );
+Irssi::command_bind( setc() . ' detach' => 'hide_window' );
+Irssi::command_bind( setc() . ' ack' => 'ack_window' );
+
+{
+ my $l = set 'shared';
+ {
+ no strict 'refs';
+ *{$l} = $awl_shared_empty;
+ }
+ Irssi::statusbar_item_register($l, '$0', $l);
+}
+
+awl_init();
+
+# Mouse script based on irssi mouse patch by mirage
+{ my $mouse_status = -1; # -1:off 0,1,2:filling mouse_combo
+ my @mouse_combo = (-1, -1, -1); # 0:button 1:x 2:y
+ my @mouse_previous = (-1, -1, -1); # previous contents of mouse_combo
+
+ sub mouse_xterm_off {
+ $mouse_status = -1;
+ }
+ sub mouse_xterm {
+ $mouse_status = 0;
+ Irssi::timeout_add_once(10, 'mouse_xterm_off', undef);
+ }
+
+ sub mouse_key_hook {
+ my ($key) = @_;
+ if ($mouse_status != -1) {
+ if ($mouse_status == 0) {
+ @mouse_previous = @mouse_combo;
+ #if @mouse_combo && $mouse_combo[0] < 64;
+ }
+ $mouse_combo[$mouse_status] = $key - 32;
+ $mouse_status++;
+ if ($mouse_status == 3) {
+ $mouse_status = -1;
+ # match screen coordinates
+ $mouse_combo[1]--;
+ $mouse_combo[2]--;
+ Irssi::signal_emit('gui mouse', @mouse_combo[0 .. 2], @mouse_previous[0 .. 2]);
+ }
+ Irssi::signal_stop;
+ }
+ }
+}
+
+sub string_LCSS {
+ my $str = join "\0", @_;
+ (sort { length $b <=> length $a } $str =~ /(?=(.+).*\0.*\1)/g)[0]
+}
+
+# workaround for issue #271
+{ package Irssi::Nick }
+
+# workaround for issue #572
+@Irssi::UI::Exec::ISA = 'Irssi::Windowitem'
+ if Irssi::version >= 20140822 && Irssi::version <= 20161101 && !@Irssi::UI::Exec::ISA;
+
+UNITCHECK
+{ package AwlViewer;
+ use strict;
+ use warnings;
+ no warnings 'redefine';
+ use Encode;
+ use IO::Socket::UNIX;
+ use IO::Select;
+ use List::Util qw(max);
+ use constant BLOCK_SIZE => 1024;
+ use constant RECONNECT_TIME => 5;
+
+ my $sockpath;
+
+ our $VERSION = '0.8';
+
+ our ($got_int, $resized, $timeout);
+
+ my %vars;
+ my (%c2w, @seqlist);
+ my %mouse_coords;
+ my (@mouse, @last_mouse);
+ my ($err, $sock, $loop);
+ my ($keybuf, $rcvbuf);
+ my @screen;
+ my ($screenHeight, $screenWidth);
+ my ($disp_update, $fs_open, $one_shot_integration, $one_shot_resize);
+ my $integration_position;
+ my $show_title_bar;
+
+ sub connect_it {
+ $sock = IO::Socket::UNIX->new(
+ Type => SOCK_STREAM,
+ Peer => $sockpath,
+ );
+ unless ($sock) {
+ $err = $!;
+ return;
+ }
+ $sock->blocking(0);
+ $loop->add($sock);
+ }
+
+ sub remove_conn {
+ my $fh = shift;
+ $loop->remove($fh);
+ $fh->close;
+ $sock = undef;
+ %vars = ();
+ @screen = ();
+ }
+
+ { package Terminfo; # xterm
+ sub civis { "\e[?25l" }
+ sub sc { "\e7" }
+ sub cup { "\e[" . ($_[0] + 1) . ';' . ($_[1] + 1) . 'H' }
+ sub el { "\e[K" }
+ sub rc { "\e8" }
+ sub cnorm { "\e[?25h" }
+ sub setab { "\e[4" . $_[0] . 'm' }
+ sub setaf { "\e[3" . $_[0] . 'm' }
+ sub setaf16 { "\e[9" . $_[0] . 'm' }
+ sub setab16 { "\e[10" . $_[0] . 'm' }
+ sub setaf256 { "\e[38;5;" . $_[0] . 'm' }
+ sub setab256 { "\e[48;5;" . $_[0] . 'm' }
+ sub setafrgb { "\e[38;2;" . $_[0] . ';' . $_[1] . ';' . $_[2] . 'm' }
+ sub setabrgb { "\e[48;2;" . $_[0] . ';' . $_[1] . ';' . $_[2] . 'm' }
+ sub sgr0 { "\e[0m" }
+ sub bold { "\e[1m" }
+ sub it { "\e[3m" }
+ sub ul { "\e[4m" }
+ sub blink { "\e[5m" }
+ sub rev { "\e[7m" }
+ sub op { "\e[39;49m" }
+ sub exit_bold { "\e[22m" }
+ sub exit_it { "\e[23m" }
+ sub exit_ul { "\e[24m" }
+ sub exit_blink { "\e[25m" }
+ sub exit_rev { "\e[27m" }
+ sub smcup { "\e[?1049h" }
+ sub rmcup { "\e[?1049l" }
+ sub smmouse { "\e[?1000h\e[?1005h" }
+ sub rmmouse { "\e[?1005l\e[?1000l" }
+ }
+
+ sub init {
+ $sockpath = shift // "$ENV{HOME}/.irssi/_windowlist";
+ STDOUT->autoflush(1);
+ printf "\r%swaiting for %s...", Terminfo::sc, $::IRSSI{name};
+
+ `stty -icanon -echo`;
+
+ $loop = IO::Select->new;
+ STDIN->blocking(0);
+ $loop->add(\*STDIN);
+
+ $SIG{INT} = sub {
+ $got_int = 1
+ };
+ $SIG{WINCH} = sub {
+ $resized = 1
+ };
+
+ $resized = 3;
+
+ $disp_update = 2;
+
+ $show_title_bar = 1;
+ }
+
+ sub enter_fs {
+ return if $fs_open;
+ safe_print(Terminfo::rc, Terminfo::smcup, Terminfo::civis, Terminfo::smmouse);
+ $fs_open = 1;
+ }
+
+ sub leave_fs {
+ return unless $fs_open;
+ safe_print(Terminfo::rmmouse, Terminfo::cnorm, Terminfo::rmcup);
+ safe_print(sprintf "\r%swaiting for %s...", Terminfo::sc, $::IRSSI{name}) if $_[0];
+
+ $fs_open = 0;
+ }
+
+ sub end_prog {
+ leave_fs();
+ STDIN->blocking(1);
+ `stty sane`;
+ printf "\r%s%sthanks for using %s\n", Terminfo::rc, Terminfo::el, $::IRSSI{name};
+ }
+
+ sub safe_print {
+ my $st = STDIN->blocking(1);
+ print @_;
+ STDIN->blocking($st);
+ }
+
+ sub safe_qx {
+ my $st = STDIN->blocking(1);
+ my $ret = `$_[0]`;
+ STDIN->blocking($st);
+ $ret
+ }
+
+ sub safe_print_sock {
+ return unless $sock;
+ my $was = $sock->blocking(1);
+ $sock->print(@_);
+ $sock->blocking($was);
+ }
+
+ sub process_recv {
+ my $need = 0;
+ while ($rcvbuf =~ s/\n(.+)_BEGIN\n((?: .*\n)*)\1_END\n//) {
+ my $var = lc $1;
+ my $data = $2;
+ my @data = split "\n ", "\n$data ", -1;
+ shift @data; pop @data;
+ my $itembg = $vars{itembg};
+ if ($var =~ s/list$//) {
+ $vars{$var} = \@data;
+ }
+ elsif ($var =~ s/map$//) {
+ $vars{$var} = +{ @data };
+ }
+ else {
+ $vars{$var} = join "\n", @data;
+ }
+ $need = 1 if $var eq 'win';
+ $need = 1 if $var eq 'redraw' && $vars{$var};
+ if (($itembg//'') ne ($vars{itembg}//'')) {
+ $need = $vars{redraw} = 1;
+ }
+ _build_keymap() if $var eq 'key2';
+ }
+ $need
+ }
+
+ { my %ansi_table;
+ my ($i, $j, $k) = (0, 0, 0);
+ my %term_state;
+ sub reset_term_state { my %old_term = %term_state; %term_state = (); %old_term }
+ sub set_term_state { my %old_term = %term_state; %term_state = @_; %old_term }
+ %ansi_table = (
+ # fe-common::core::formats.c:format_expand_styles
+ (map { my $t = $i++; ($_ => sub { my $n = $term_state{hicolor} ? \&Terminfo::setab16 : \&Terminfo::setab;
+ $n->($t) }) } (split //, '01234567' )),
+ (map { my $t = $j++; ($_ => sub { my $n = $term_state{hicolor} ? \&Terminfo::setaf16 : \&Terminfo::setaf;
+ $n->($t) }) } (split //, 'krgybmcw' )),
+ (map { my $t = $k++; ($_ => sub { my $n = $term_state{hicolor} ? \&Terminfo::setaf : \&Terminfo::setaf16;
+ $n->($t) }) } (split //, 'KRGYBMCW')),
+ # reset
+ n => sub { $term_state{hicolor} = 0; my $r = Terminfo::op;
+ for (qw(blink rev bold)) {
+ $r .= Terminfo->can("exit_$_")->() if delete $term_state{$_};
+ }
+ {
+ local $ansi_table{n} = $ansi_table{N};
+ $r .= formats_to_ansi_basic($vars{itembg});
+ }
+ $r
+ },
+ N => sub { reset_term_state(); Terminfo::sgr0 },
+ # flash/bright
+ F => sub { my $n = 'blink'; my $e = ($term_state{$n} ^= 1) ? $n : "exit_$n"; Terminfo->can($e)->() },
+ # reverse
+ 8 => sub { my $n = 'rev'; my $e = ($term_state{$n} ^= 1) ? $n : "exit_$n"; Terminfo->can($e)->() },
+ # bold
+ "_" => sub { my $n = 'bold'; my $e = ($term_state{$n} ^= 1) ? $n : "exit_$n"; Terminfo->can($e)->() },
+ # underline
+ U => sub { my $n = 'ul'; my $e = ($term_state{$n} ^= 1) ? $n : "exit_$n"; Terminfo->can($e)->() },
+ # italic
+ I => sub { my $n = 'it'; my $e = ($term_state{$n} ^= 1) ? $n : "exit_$n"; Terminfo->can($e)->() },
+ # bold, used as colour modifier if AWL_HI9 is set
+ 9 => $ENV{AWL_HI9} ? sub { $term_state{hicolor} ^= 1; '' }
+ : sub { my $n = 'bold'; my $e = ($term_state{$n} ^= 1) ? $n : "exit_$n"; Terminfo->can($e)->() },
+ # delete other stuff
+ (map { $_ => sub { '' } } (split //, ':|>#[')),
+ # escape
+ (map { my $close = $_; $_ => sub { $close } } (split //, '{}%')),
+ );
+ for my $base (0 .. 15) {
+ my $close = $base;
+ my $idx = ($close&8) | ($close&4)>>2 | ($close&2) | ($close&1)<<2;
+ $ansi_table{ (sprintf "x0%x", $close) } =
+ $ansi_table{ (sprintf "x0%X", $close) } =
+ sub { Terminfo::setab256($idx) };
+ $ansi_table{ (sprintf "X0%x", $close) } =
+ $ansi_table{ (sprintf "X0%X", $close) } =
+ sub { Terminfo::setaf256($idx) };
+ }
+ for my $plane (1 .. 6) {
+ for my $coord (0 .. 35) {
+ my $close = 16 + ($plane-1) * 36 + $coord;
+ my $ch = $coord < 10 ? $coord : chr( $coord - 10 + ord 'a' );
+ $ansi_table{ "x$plane$ch" } =
+ $ansi_table{ "x$plane\U$ch" } =
+ sub { Terminfo::setab256($close) };
+ $ansi_table{ "X$plane$ch" } =
+ $ansi_table{ "X$plane\U$ch" } =
+ sub { Terminfo::setaf256($close) };
+ }
+ }
+ for my $gray (0 .. 23) {
+ my $close = 232 + $gray;
+ my $ch = chr( $gray + ord 'a' );
+ $ansi_table{ "x7$ch" } =
+ $ansi_table{ "x7\U$ch" } =
+ sub { Terminfo::setab256($close) };
+ $ansi_table{ "X7$ch" } =
+ $ansi_table{ "X7\U$ch" } =
+ sub { Terminfo::setaf256($close) };
+ }
+ # fe-windows.c:color_24bit_256
+ my $cc = sub {
+ use integer;
+
+ my $cstep_size = 40;
+ my $cstep_start = 0x5f;
+
+ my $gstep_size = 10;
+ my $gstep_start = 0x08;
+
+ my @dist = (0) x 3;
+ my @r; my @gr;
+
+ for (my $i = 0; $i < 3; ++$i) {
+ my $n = $_[$i];
+ $gr[$i] = -1;
+ if ($n < $cstep_start /2) {
+ $r[$i] = 0;
+ $dist[$i] = -$cstep_size/2;
+ }
+ else {
+ $r[$i] = 1+(($n-$cstep_start + $cstep_size /2)/$cstep_size);
+ $dist[$i] = (($n-$cstep_start + $cstep_size /2)% $cstep_size - $cstep_size/2);
+ }
+ if ($n < $gstep_start /2) {
+ $gr[$i] = -1;
+ }
+ else {
+ $gr[$i] = (($n-$gstep_start + $gstep_size /2)/$gstep_size);
+ }
+ }
+ if ($r[0] == $r[1] && $r[1] == $r[2] &&
+ 4*abs($dist[0]) < $gstep_size && 4*abs($dist[1]) < $gstep_size && 4*abs($dist[2]) < $gstep_size) {
+ # skip gray detection
+ }
+ else {
+ my $j = $r[1] == $r[2] ? 0 : 1;
+ if (($r[0] == $r[1] || $r[$j] == $r[2]) && abs($r[$j]-$r[($j+1)% 3]) <= 1) {
+ my $k = $gr[1] == $gr[2] ? 0 : 1;
+ if (($gr[0] == $gr[1] || $gr[$k] == $gr[2]) && abs($gr[$k]-$gr[($k+1)% 3]) <= 2) {
+ if ($gr[$k] < 0) {
+ $r[0] = $r[1] = $r[2] = 0;
+ }
+ elsif ($gr[$k] > 23) {
+ $r[0] = $r[1] = $r[2] = 5;
+ }
+ else {
+ $r[0] = 6;
+ $r[1] = ($gr[$k] / 6);
+ $r[2] = $gr[$k]% 6;
+ }
+ }
+ }
+ }
+ return 16 + $r[0]*36 + $r[1] * 6 + $r[2];
+ };
+ $ansi_table{z} = sub {
+ my ($r, $g, $b) = map { hex } unpack '(A2)*', $_[0];
+ $vars{tc} eq 'ON' ? Terminfo::setabrgb($r, $g, $b) : Terminfo::setab256($cc->($r, $g, $b));
+ };
+ $ansi_table{Z} = sub {
+ my ($r, $g, $b) = map { hex } unpack '(A2)*', $_[0];
+ $vars{tc} eq 'ON' ? Terminfo::setafrgb($r, $g, $b) : Terminfo::setaf256($cc->($r, $g, $b));
+ };
+ sub formats_to_ansi_basic {
+ my $o = shift;
+ $o =~ s{(%((Z|z)(......)|X..|x..|.))}{
+ if ($ansi_table{$2}) { $ansi_table{$2}->() }
+ elsif ($ansi_table{$3}) { $ansi_table{$3}->($4) }
+ else { $1 }
+ }gex;
+ $o
+ }
+ }
+
+ sub _header {
+ my $str = $vars{title} // uc ::setc();
+ my $ccs = qr/%(?:Z(?:[0-9A-F]{6})|X(?:[1-6][0-9A-Z]|7[A-X])|[0-9BCFGIKMNRUWY_])/i;
+ (my $stripstr = $str) =~ s/($ccs)//g;
+ my $space = int( ((abs $vars{block}) - length $stripstr) / (1 + length $stripstr));
+ if ($space > 0) {
+ my $ss = ' ' x $space;
+ my @x = $str =~ /((?:$ccs)*\X(?:(?:$ccs)*$)?)/g;
+ $str = join $ss, '', @x, '';
+ }
+ ($stripstr = $str) =~ s/($ccs)//g;
+ my $pad = max 0, (abs $vars{block}) - length $stripstr;
+ $str = ' ' x ($pad/2) . $str . ' ' x ($pad/2 + $pad%2);
+ $str
+ }
+
+ sub _add_item {
+ my ($i, $j, $c, $wi, $screen, $mouse) = @_;
+ $screen->[$i][$j] = "%N%n$wi";
+ if (exists $vars{mouse}{$c - 1}) {
+ $mouse->[$i][$j] = $vars{mouse}{$c - 1};
+ }
+ }
+ sub update_screen {
+ $disp_update = 0;
+ unless ($sock && exists $vars{seplen} && exists $vars{block}) {
+ leave_fs(1);
+ return;
+ }
+ enter_fs();
+ @screen = () if delete $vars{redraw};
+ %mouse_coords = ();
+ my $ncols = ($vars{seplen} + abs $vars{block}) ?
+ int( ($screenWidth + $vars{seplen}) / ($vars{seplen} + abs $vars{block}) ) : 0;
+ my $xenl = ($vars{seplen} + abs $vars{block})
+ && $ncols > int( ($screenWidth + $vars{seplen} - 1) / ($vars{seplen} + abs $vars{block}) );
+ my $nrows = $screenHeight - $vars{ha};
+ my @wi = @{$vars{win}//[]};
+ my $max_items = $ncols * $nrows;
+ my $c = $show_title_bar ? 1 : 0;
+ my $items = @wi + $c;
+ my $titems = $items > $max_items ? $max_items : $items;
+ my $i = 0;
+ my $j = 0;
+ my @new_screen;
+ my @new_mouse;
+ $new_screen[0][0] = _header() #. ' ' x $vars{seplen}
+ if $show_title_bar;
+ unless ($nrows > $ncols) { # line layout
+ ++$j if $show_title_bar;
+ for my $wi (@wi) {
+ if ($j >= $ncols) {
+ $j = 0;
+ ++$i;
+ }
+ last if $i >= $nrows;
+ _add_item($i, $j, $show_title_bar ? $c : $c + 1,
+ $wi, \@new_screen, \@new_mouse);
+ if ($c + 1 < $titems && $j + 1 < $ncols) {
+ $new_screen[$i][$j] .= $vars{separator};
+ }
+ ++$j;
+ ++$c;
+ }
+ }
+ else { # column layout
+ ++$i if $show_title_bar;
+ for my $wi (@wi) {
+ if ($i >= $nrows) {
+ $i = 0;
+ ++$j;
+ }
+ last if $j >= $ncols;
+ _add_item($i, $j, $show_title_bar ? $c : $c + 1,
+ $wi, \@new_screen, \@new_mouse);
+ if ($c + $nrows < $titems) {
+ $new_screen[$i][$j] .= $vars{separator};
+ }
+ ++$i;
+ ++$c;
+ }
+ }
+ my $step = $vars{seplen} + abs $vars{block};
+ $i = 0;
+ my $str = Terminfo::sc . Terminfo::sgr0;
+ for (my $i = 0; $i < @new_screen; ++$i) {
+ for (my $j = 0; $j < @{$new_screen[$i]}; ++$j) {
+ if (defined $new_mouse[$i] && defined $new_mouse[$i][$j]) {
+ my $from = $j * $step;
+ $mouse_coords{$i}{$_} = $new_mouse[$i][$j]
+ for $from .. $from + abs $vars{block};
+ }
+ next if defined $screen[$i] && defined $screen[$i][$j]
+ && $screen[$i][$j] eq $new_screen[$i][$j];
+ $str .= Terminfo::cup($i, $j * $step)
+ . formats_to_ansi_basic($new_screen[$i][$j])
+ . Terminfo::sgr0;
+ $str .= Terminfo::el if $j == $#{$new_screen[$i]} && (!$xenl || $j + 1 != $ncols);
+ }
+ }
+ for (@new_screen .. $screenHeight - 1) {
+ if (!@screen || defined $screen[$_]) {
+ $str .= Terminfo::cup($_, 0) . Terminfo::sgr0 . Terminfo::el;
+ }
+ }
+ $str .= Terminfo::rc;
+ safe_print $str;
+ @screen = @new_screen;
+ }
+
+ sub handle_resize {
+ if (defined (my $r = safe_qx('stty size'))) {
+ ($screenHeight, $screenWidth) = split ' ', $r;
+ $resized = 0;
+ @screen = ();
+ $disp_update = 1;
+ if ($one_shot_integration == 2) {
+ $one_shot_resize--;
+ }
+ }
+ else {
+ }
+ }
+
+ sub _build_keymap {
+ %c2w = reverse( %{$vars{key}}, %{$vars{key2}} );
+ if (!grep { /^[+-]./ } keys %c2w) {
+ %c2w = (%c2w, map { ("-$_" => $c2w{$_}) } grep { !/^\^./ } keys %c2w);
+ }
+ %c2w = map {
+ my $key = $_;
+ s{^(-)?(\+)?(\^)?(.)}{
+ join '', (
+ ($1 ? "\e" : ''),
+ ($2 ? "\e\e" : ''),
+ ($3 ? "$4"^"@" : $4)
+ )
+ }e;
+ $_ => $c2w{$key}
+ } keys %c2w;
+ @seqlist = sort { length $b <=> length $a } keys %c2w;
+ }
+
+ sub _match_tmux {
+ length $ENV{TMUX} && exists $vars{irssienv}{tmux_srv} && length $vars{irssienv}{tmux_pane}
+ && $ENV{TMUX} eq $vars{irssienv}{tmux_srv}
+ }
+
+ sub process_keys {
+ Encode::_utf8_on($keybuf);
+ my $win;
+ my $use_mouse;
+ my $maybe;
+ KEY: while (length $keybuf && !$maybe) {
+ $maybe = 0;
+ if ($keybuf =~ s/^\e\[M(.)(.)(.)//) {
+ @last_mouse = @mouse;# if @mouse && $mouse[0] < 64;
+ @mouse = map { -32 + ord } ($1, $2, $3);
+ $use_mouse = 1;
+ next KEY;
+ }
+ for my $s (@seqlist) {
+ if ($keybuf =~ s/^\Q$s//) {
+ $win = $c2w{$s};
+ $use_mouse = 0;
+ next KEY;
+ }
+ elsif (length $keybuf < length $s && $s =~ /^\Q$keybuf/) {
+ $maybe = 1;
+ }
+ }
+ unless ($maybe) {
+ substr $keybuf, 0, 1, '';
+ }
+ }
+ if ($use_mouse && @mouse && @last_mouse &&
+ $mouse[2] == $last_mouse[2] &&
+ $mouse[1] == $last_mouse[1] &&
+ ($mouse[0] == 3 || $mouse[0] == 64 || $mouse[0] == 65)) {
+ if ($mouse[0] == 64) {
+ $win = 'up';
+ }
+ elsif ($mouse[0] == 65) {
+ $win = 'down';
+ }
+ elsif (exists $mouse_coords{$mouse[2] - 1}{$mouse[1] - 1}) {
+ $win = $mouse_coords{$mouse[2] - 1}{$mouse[1] - 1};
+ }
+ elsif ($mouse[2] == 1 && $mouse[1] <= abs $vars{block}) {
+ $win = $last_mouse[0] != 0 ? 'last' : 'active';
+ }
+ else {
+ }
+ }
+ if (defined $win) {
+ $win =~ s/^_//;
+ safe_print_sock("$win\n");
+ if (!exists $ENV{AWL_AUTOFOCUS} || $ENV{AWL_AUTOFOCUS}) {
+ if (_match_tmux()) {
+ safe_qx("tmux selectp -t $vars{irssienv}{tmux_pane} 2>&1");
+ }
+ elsif (exists $vars{irssienv}{xwinid}) {
+ safe_qx("wmctrl -ia $vars{irssienv}{xwinid} 2>/dev/null");
+ }
+ }
+ }
+ Encode::_utf8_off($keybuf);
+ }
+
+ sub check_integration {
+ return unless $vars{irssienv};
+ return unless $sock && exists $vars{seplen} && exists $vars{block};
+ if ($one_shot_integration == 1) {
+ my $nrows = $screenHeight - $vars{ha};
+ my $ncols = ($vars{seplen} + abs $vars{block}) ? int( ($screenWidth + $vars{seplen}) / ($vars{seplen} + abs $vars{block}) ) : 0;
+ my $items = ($show_title_bar ? 1 : 0) + @{$vars{win}//[]};
+ my $dcols_required = $nrows ? int($items/$nrows) + !!($items%$nrows) : 0;
+ my $rows_required = $ncols ? int($items/$ncols) + !!($items%$ncols) : 0;
+ $rows_required = abs $vars{ml}
+ if ($vars{ml} < 0 || ($vars{ml} > 0 && $rows_required > $vars{ml}));
+ $dcols_required = abs $vars{mc}
+ if ($vars{mc} < 0 || ($vars{mc} > 0 && $dcols_required > $vars{mc}));
+ my $rows = $rows_required + $vars{ha};
+ my $cols = ($dcols_required * ($vars{seplen} + abs $vars{block})) - $vars{seplen};
+ if (_match_tmux()) {
+ # int( ($screenWidth + $vars{seplen}) / ($vars{seplen} + abs $vars{block}) );
+ my ($pos_flag, $before);
+ if ($integration_position eq 'left') {
+ $pos_flag = 'h';
+ $before = 1;
+ }
+ elsif ($integration_position eq 'top') {
+ $pos_flag = 'v';
+ $before = 1;
+ }
+ elsif ($integration_position eq 'right') {
+ $pos_flag = 'h';
+ }
+ else {
+ $pos_flag = 'v';
+ }
+ my @cmd = "joinp -d$pos_flag -s $ENV{TMUX_PANE} -t $vars{irssienv}{tmux_pane}";
+ push @cmd, "swapp -d -t $ENV{TMUX_PANE} -s $vars{irssienv}{tmux_pane}"
+ if $before;
+ $cols = max($cols, 2);
+ $rows = max($rows, 2);
+
+ safe_qx("tmux " . (join " \\\; ", @cmd) . " 2>&1");
+ }
+ else {
+ $resized = 1;
+ #safe_qx("resize -s $screenHeight $cols 2>&1")
+ # if $cols > 0;
+ }
+ $one_shot_integration++;
+ if ($resized == 1) {
+ handle_resize();
+ resize_integration();
+ }
+ }
+ elsif ($one_shot_integration == 2) {
+ resize_integration(1);
+ }
+ }
+
+ sub resize_integration {
+ return unless $one_shot_integration;
+ return unless ($one_shot_resize//0) < 0 || shift;
+ return if ($one_shot_resize//0) > 0;
+
+ my $nrows = $screenHeight - $vars{ha};
+ my $ncols = ($vars{seplen} + abs $vars{block}) ? int( ($screenWidth + $vars{seplen}) / ($vars{seplen} + abs $vars{block}) ) : 0;
+ my $items = ($show_title_bar ? 1 : 0) + @{$vars{win}//[]};
+ my $dcols_required = $nrows ? (int($items/$nrows) + !!($items%$nrows)) : 0;
+ my $rows_required = $ncols ? int($items/$ncols) + !!($items%$ncols) : 0;
+ $rows_required = abs $vars{ml}
+ if ($vars{ml} < 0 || ($vars{ml} > 0 && $rows_required > $vars{ml}));
+ $dcols_required = abs $vars{mc}
+ if ($vars{mc} < 0 || ($vars{mc} > 0 && $dcols_required > $vars{mc}));
+ my $rows = $rows_required + $vars{ha};
+ my $cols = ($dcols_required * ($vars{seplen} + abs $vars{block})) - $vars{seplen};
+ if (_match_tmux()) {
+ my $pos_flag;
+ my $before = 0;
+ if ($integration_position eq 'left') {
+ $pos_flag = 'h';
+ $before = 1;
+ }
+ elsif ($integration_position eq 'top') {
+ $pos_flag = 'v';
+ $before = 1;
+ }
+ elsif ($integration_position eq 'right') {
+ $pos_flag = 'h';
+ }
+ else {
+ $pos_flag = 'v';
+ }
+ my @cmd;
+ # hard tmux limits
+ $cols = max($cols, 2);
+ $rows = max($rows, 2);
+ if ($pos_flag eq 'h' && $cols != $screenWidth) {
+ my $change = $screenWidth - $cols;
+ my $dir = ($before ^ ($change<0)) ? 'L' : 'R';
+ push @cmd, "resizep -$dir -t $ENV{TMUX_PANE} @{[abs $change]}";
+ #push @cmd, "resizep -x $cols -t $ENV{TMUX_PANE}";
+ $one_shot_resize = 1;
+ }
+ if ($pos_flag eq 'v' && $rows != $screenHeight) {
+ #push @cmd, "resizep -y $rows -t $ENV{TMUX_PANE}";
+ my $change = $screenHeight - $rows;
+ my $dir = ($before ^ ($change<0)) ? 'U' : 'D';
+ push @cmd, "resizep -$dir -t $ENV{TMUX_PANE} @{[abs $change]}";
+ $one_shot_resize = 1;
+ }
+
+ safe_qx("tmux " . (join " \\\; ", @cmd) . " 2>&1")
+ if @cmd;
+ }
+ else {
+ $cols = max($cols, 1);
+ $rows = max($rows, 1);
+ unless ($nrows > $ncols) { # line layout
+ if ($rows != $screenHeight) {
+ safe_qx("resize -s $rows $screenWidth 2>&1");
+ $one_shot_resize = 1;
+ }
+ }
+ else {
+ if ($cols != $screenWidth) {
+ safe_qx("resize -s $screenHeight $cols 2>&1");
+ $one_shot_resize = 1;
+ }
+ }
+ }
+ if ($resized == 1) {
+ handle_resize();
+ }
+ }
+
+ sub init_integration {
+ return unless $one_shot_integration;
+ if (_match_tmux()) {
+ }
+ else {
+ }
+ safe_print("\e]2;".(uc ::setc())."\e\\");
+ }
+
+ sub main {
+ require Getopt::Std;
+ my %opts;
+ Getopt::Std::getopts('1p:', \%opts);
+ my $one_shot = $opts{1};
+ $integration_position = $opts{p};
+ $one_shot_integration = 0+!!$one_shot;
+ #shift if @_ && $_[0] eq '--';
+ &init;
+ $show_title_bar = 0 if $ENV{AWL_NOTITLE};
+ init_integration();
+ until ($got_int) {
+ $timeout = undef;
+ if ($resized) {
+ if ($resized == 1) {
+ $timeout = 1;
+ $resized++;
+ }
+ else {
+ handle_resize();
+ resize_integration();
+ }
+ }
+ unless ($sock || $timeout) {
+ connect_it();
+ }
+ $timeout ||= RECONNECT_TIME unless $sock;
+ update_screen() if $disp_update;
+ SELECT: while (my @read = $loop->can_read($timeout)) {
+ for my $fh (@read) {
+ if ($fh == \*STDIN) {
+ if (read STDIN, my $buf, BLOCK_SIZE) {
+ do {
+ $keybuf .= $buf;
+ } while read STDIN, $buf, BLOCK_SIZE;
+ }
+ else {
+ $got_int = 1;
+ last SELECT;
+ }
+ }
+ else {
+ if ($fh->read(my $buf, BLOCK_SIZE)) {
+ do {
+ $rcvbuf .= $buf;
+ } while $fh->read($buf, BLOCK_SIZE);
+ }
+ else {
+ $disp_update = 1;
+ remove_conn($fh);
+ if ($one_shot) {
+ $got_int = 1;
+ last SELECT;
+ }
+ $timeout ||= RECONNECT_TIME;
+ }
+ }
+ }
+ $disp_update |= process_recv() if length $rcvbuf;
+ process_keys() if length $keybuf;
+ check_integration() if $one_shot;
+ update_screen() if $disp_update;
+ }
+ continue {
+ }
+ }
+ end_prog();
+ }
+}
+
+1;
+
+# Changelog
+# =========
+# 1.11
+# - fix compat with Irssi 1.4
+#
+# 1.10
+# - add /set awl_custom_key_re, to display custom keys in the $Q
+# expando. requested by madduck
+#
+# 1.9.1
+# - fix crash on mouse click
+#
+# 1.9
+# - add %Z support to viewer
+#
+# 1.8
+# - use string_width in Irssi 1.2.0
+#
+# 1.7
+# - fix crash on invalid /set awl_sort, introduced in 1.6, reported by
+# tpetazzoni
+# - delay viewer initialisation
+# - improve race condition on tmux resize integration
+#
+# 1.6
+# - add detach setting to hide windows
+# - fix race condition when loading the script, reported by madduck
+# - improve compatibility with irssi 1.2
+# - add special value lru to awl_sort to sort windows by usage
+#
+# 1.5
+# - improve compat. with sideways splits
+#
+# 1.4
+# - fix line wrapping in some themes, reported by justanotherbody
+# - fix named window key detection, reported by madduck
+# - make title (in viewer and shared_sbar) configurable
+#
+# 1.3
+# - workaround for irssi issue #572
+#
+# 1.2
+# - new format to choose abbreviation character
+#
+# 1.1
+# - infinite loop on shortening certain window names reported by Kalan
+#
+# 1.0
+# - new awl_viewer_launch setting and an array of related settings
+# - fixed regression bug /exec -interactive
+# - fixed some warnings in perl 5.10 reported by kl3
+# - workaround for crash due to infinite recursion in irssi's Perl
+# error handling
+#
+# 0.9
+# - fix endless loop in awin detection code!
+# - correct colour swap in awl_viewer
+# - fix passing of alternate socket path to the viewer
+# - potential undefinedness in mouse refnum hinted at by Canopus
+# - fixed regression bug /exec -interactive
+# - add case-insensitive modifier to awl_sort
+# - run custom_xform on awl_prefer_name also
+# - avoid inconsistent active window state after awin detection
+# reported by ss
+# - revert %9-hack in the viewer prompted by discussion with pierrot
+# - fix new warning in perl 5.22
+#
+# 0.8
+# - replace fifo mode with external viewer script
+# - remove bundled cpan modules
+# - work around bogus irssi warning
+# - improve mouse support
+# - workaround for broken cumode in irssi 0.8.15
+# - fix handling of non-meta windows (uninitialized warning)
+# - add 256 colour support, strip true colour codes
+# - fix totally bogus $N padding reported by Ed S.
+# - make /window goto #name mappings work but ignore non-existant ones
+# - improve incomplete reads reported by bcode
+# - fix single % in awl_viewer reported by bcode
+# - add support for key bindings by nike and ferret
+# - coerce utf8 key binds
+# - add settings: custom_xform, last_line_shade, hide_name_data
+# - abbreviations were broken in some cases
+# - fix some misuse of / as cmdchar in mouse script reported by bcode
+# - add shared status bar mode
+# - ${type} variables for custom_xform setting
+# - crash if custom_xform had runtime error
+# - update sorting documentation
+# - fix odd case in size calculation noted by lasers
+# - add missing font styles to the viewer reported by ishanyx
+# - add italic
+#
+# 0.7g
+# - remove screen support and replace it with fifo support
+# - add double-width support to the shortener
+# - correct documentation regarding $T vs. display_header
+# - add missing refresh for window item changed (thanks vague)
+# - add visible windows
+# - add exemptions for active window
+# - workaround for hiding the window changes from trackbar
+# - hack to force 16colours in screen mode
+# - remember last window (reported by earthnative)
+# - wrong window focus on new queries (reported by emsid)
+# - dataloss bug on trying to remember last window
+#
+# 0.6d+
+# - add support for network headers
+# - fixed regression bug /exec -interactive
+#
+# 0.6ca+
+# - add screen support (from nicklist.pl)
+# - names can now have a max length and window names can be used
+# - fixed a bug with block display in screen mode and status bar mode
+# - added space handling to ir_fe and removed it again
+# - now handling formats on my own
+# - started to work on $tag display
+# - added warning about missing sb_act_none abstract leading to
+# - display*active settings
+# - added warning about the bug in awl_display_(no)key_active settings
+# - mouse hack
+#
+# 0.5d
+# - add setting to also hide the last status bar if empty (awl_all_disable)
+# - reverted to old utf8 code to also calculate broken utf8 length correctly
+# - simplified dealing with status bars in wlreset
+# - added a little tweak for the renamed term_type somewhere after Irssi 0.8.9
+# - fixed bug in handling channel #$$
+# - reset background colour at the beginning of an entry
+#
+# 0.4d
+# - fixed order of disabling status bars
+# - several attempts at special chars, without any real success
+# and much more weird new bugs caused by this
+# - setting to specify sort order
+# - reduced timeout values
+# - added awl_hide_data
+# - make it so the dynamic sub is actually deleted
+# - fix a bug with removing of the last separator
+# - take into consideration parse_special
+#
+# 0.3b
+# - automatically kill old status bars
+# - reset on /reload
+# - position/placement settings
+#
+# 0.2
+# - automated retrieval of key bindings (thanks grep.pl authors)
+# - improved removing of status bars
+# - got rid of status chop
+#
+# 0.1
+# - Based on chanact.pl which was apparently based on lightbar.c and
+# nicklist.pl with various other ideas from random scripts.
diff --git a/scripts/ai.pl b/scripts/ai.pl
new file mode 100644
index 0000000..af3e5c1
--- /dev/null
+++ b/scripts/ai.pl
@@ -0,0 +1,265 @@
+use strict;
+use Irssi;
+use Irssi::Irc;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION="0.3";
+%IRSSI = (
+ authors=> 'BC-bd',
+ contact=> 'bd@bc-bd.org',
+ name=> 'ai',
+ description=> 'Puts people on ignore if they do a public away. See source for options.',
+ license=> 'GPL v2',
+ url=> 'https://bc-bd.org/svn/repos/irssi/trunk/',
+);
+
+# $Id: ai.pl,v 1.4 2002/06/02 15:20:03 bd Exp $
+# for irssi 0.8.4 by bd@bc-bd.org
+#
+#########
+# USAGE
+###
+#
+# Examples:
+#
+# Ignore people saying "away"
+# /set ai_words away
+#
+# Ignore people saying "gone for good" or "back"
+# /set ai_words gone for good,back
+#
+# Ignore people for 500 seconds
+# /set ai_time 500
+#
+# Ignore people forever
+# /set ai_time 0
+#
+# Ignore people only on channels #foo,#bar
+# /set ai_ignore_only_in ON
+# /set ai_channels #foo,#bar
+#
+# Ignore people on all channels BUT #foo,#bar
+# /set ai_ignore_only_in OFF
+# /set ai_channels #foo,#bar
+#
+# Ignore people on all channels
+# /set ai_ignore_only_in OFF
+# /set -clear ai_channels
+#
+# Perform a command on ignore (e.g send them a message)
+# /set ai_command ^msg -$C $N no "$W" in $T please
+#
+# would become on #foo on chatnet bar from nick dude with "dude is away"
+# /msg -cbar dude no "away" in #foo please
+#
+# look further down for details
+#
+# Per channel command on #irssi:
+# /ai #irssi ^say foobar
+#
+# delete channel command in #irssi:
+# /ai #irssi
+#
+#########
+# OPTIONS
+#########
+#
+# /set ai_words [expr[,]+]+
+# * expr : comma seperated list of expressions that should trigger an ignore
+# e.g. : away,foo,bar baz bat,bam
+#
+# /set ai_command [command]
+# * command : to be executed on a triggered ignore.
+# /set -clear ai_command to disable. The following $'s are expanded
+# ( see the default command for an example ):
+# $C : Chatnet (e.g. IRCnet, DALNet, ...)
+# $N : Nick (some dude)
+# $W : Word (the word(s) that triggered the ignore
+# $T : Target (e.g. the channel)
+#
+# /set ai_channels [#channel[ ]]+
+# * #channel : space seperated list of channels, see ai_ignore_only_in
+#
+# /set ai_time <seconds>
+# * seconds : number of seconds to wait before removing the ignore
+#
+# /set ai_ignore_only_in <ON|OFF>
+# * ON : only trigger ignores in ai_channels
+# * OFF : trigger ignores in all channels EXCEPT ai_channels
+#
+# /set ai_display <ON|OFF>
+# * ON : log whole sentence
+# * OFF : only log word that matched regex
+#
+###
+################
+###
+#
+# Changelog
+#
+# Version 0.4
+# - added optional sentence output
+#
+# Version 0.3
+# - added per channel command support
+# - the command is now executed in the channel the event occured
+# - changed the expand char from % to $
+#
+# Version 0.2
+# - changed MSGLVL_ALL to MSGLVL_ACTIONS to avoid problems
+# with channels with ignored Levels
+#
+# Version 0.1
+# - initial release
+#
+###
+################
+
+sub expand {
+ my ($string, %format) = @_;
+ my ($exp, $repl);
+ $string =~ s/\$$exp/$repl/g while (($exp, $repl) = each(%format));
+ return $string;
+}
+
+sub combineSettings {
+ my ($setting,$string,$match) = @_;
+
+ $match = quotemeta($match);
+
+ if ($setting) {
+ if ($string !~ /$match\b/i) {
+ return 1;
+ }
+ } else {
+ if ($string =~ /$match\b/i) {
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+sub sig_action {
+ my ($server,$msg,$nick,$address,$target) = @_;
+
+ my $command;
+
+ if ($server->ignore_check($nick, $address, $target, $msg, MSGLEVEL_ACTIONS)) {
+ return;
+ }
+
+ if (combineSettings(Irssi::settings_get_bool('ai_ignore_only_in'),
+ Irssi::settings_get_str('ai_channels'),$target)) {
+ return ;
+ }
+
+ my @words = split(',',Irssi::settings_get_str('ai_words'));
+
+ foreach (@words) {
+ if ($msg =~ /$_/i) {
+ my $word = $_;
+
+ my $sentence = $word;
+
+ my $channel = $server->channel_find($target);
+ my $n = $channel->nick_find($nick);
+
+ my $type = Irssi::Irc::MASK_USER | Irssi::Irc::MASK_DOMAIN;
+ my $mask = Irssi::Irc::get_mask($n->{nick}, $n->{host}, $type);
+
+ my $time = Irssi::settings_get_int('ai_time');
+ if ($time == 0) {
+ $time = "";
+ } else {
+ $time = "-time ".$time;
+ }
+ Irssi::command("^ignore ".$time." $mask");
+
+ if (Irssi::settings_get_bool('ai_display')) {
+ $sentence = $msg
+ }
+ Irssi::print("Ignoring $nick$target\@$server->{chatnet} because of '$sentence'");
+
+ my %commands = stringToHash('`',Irssi::settings_get_str('ai_commands'));
+ if (defined $commands{$target}) {
+ $command = $commands{$target};
+ } else {
+ $command = Irssi::settings_get_str('ai_command');
+ }
+
+ if ($command ne "") {
+ $command = expand($command,"C",$server->{tag},"N",$nick,"T",$target,"W",$word);
+ $server->window_item_find($target)->command($command);
+ $server->window_item_find($target)->print($command);
+ }
+
+ return;
+ }
+ }
+}
+
+sub stringToHash {
+ my ($delim,$str) = @_;
+
+ return split($delim,$str);
+}
+
+sub hashToString {
+ my ($delim,%hash) = @_;
+
+ return join($delim,%hash);
+}
+
+sub colorCommand {
+ my ($com) = @_;
+
+ $com =~ s/\$(.)/%_\$$1%_/g;
+
+ return $com;
+}
+
+sub cmd_ai {
+ my ($data, $server, $channel) = @_;
+
+ my $chan = $data;
+ $chan =~ s/ .*//;
+ $data =~ s/^\Q$chan\E *//;
+
+ my %command = stringToHash('`',Irssi::settings_get_str('ai_commands'));
+
+ if ($chan eq "") {
+ foreach my $key (keys(%command)) {
+ Irssi::print("AI: %_$key%_ = ".colorCommand($command{$key}));
+ }
+
+ Irssi::print("AI: placeholders: %_\$C%_)hatnet %_\$N%_)ick %_\$W%_)ord %_\$T%_)arget");
+ Irssi::print("AI: not enough parameters: ai <channel> [command]");
+
+ return;
+ }
+
+ if ($data eq "") {
+ delete($command{$chan});
+ } else {
+ $command{$chan} = $data;
+ }
+
+ Irssi::settings_set_str('ai_commands',hashToString('`',%command));
+
+ Irssi::print("AI: command on %_$chan%_ now: '".colorCommand($data)."'");
+}
+
+Irssi::command_bind('ai', 'cmd_ai');
+
+# "message irc action", SERVER_REC, char *msg, char *nick, char *address, char *target
+Irssi::signal_add_first('message irc action', 'sig_action');
+
+Irssi::settings_add_str('misc', 'ai_commands', '');
+Irssi::settings_add_str('misc', 'ai_words', 'away,gone,ist auf');
+Irssi::settings_add_str('misc', 'ai_command', '^msg -$C $N no "$W" in $T please');
+Irssi::settings_add_str('misc', 'ai_channels', '');
+Irssi::settings_add_int('misc', 'ai_time', 500);
+Irssi::settings_add_bool('misc', 'ai_ignore_only_in', 0);
+Irssi::settings_add_bool('misc', 'ai_display', 0);
diff --git a/scripts/aidle.pl b/scripts/aidle.pl
new file mode 100644
index 0000000..93c30ee
--- /dev/null
+++ b/scripts/aidle.pl
@@ -0,0 +1,80 @@
+use strict;
+use Irssi 20020300;
+use Irssi::Irc;
+
+# /SET aidle_max_idle_time <seconds>
+# - specifies max possible idle time
+# /SET aidle_ircnets IRCNet EFnet
+# - specifies IRCNets where anty idler will be on
+# SET -clear aidle_ircnets makes aidle work on every network;
+# /SET aidle_only_when_away - makes aidler work only when you're away
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.1b";
+%IRSSI = (
+ authors => "Maciek \'fahren\' Freudenheim",
+ contact => "fahren\@bochnia.pl",
+ name => "Antyidler",
+ description => "Antyidler with random time",
+ license => "GNU GPLv2 or later",
+ changed => "Thu Jan 2 02:58:34 CET 2003"
+);
+
+# Changelog:
+# 1.1b
+# - removed "hoho, <chatnet>" message :)
+# 1.1
+# - added /set'tings
+# 1.0
+# - fixed that annoying "your_nick: is away blah blah" message
+
+my %aidle;
+
+Irssi::settings_add_int 'aidle', 'aidle_max_idle_time', '180';
+$aidle{'max'} = Irssi::settings_get_int 'aidle_max_idle_time';
+
+Irssi::settings_add_str 'aidle', 'aidle_ircnets', '';
+@{$aidle{'ircnets'}} = (split(/ +/, Irssi::settings_get_str('aidle_ircnets')));
+
+Irssi::settings_add_bool 'aidle', 'aidle_only_when_away', 0;
+$aidle{'away'} = Irssi::settings_get_bool 'aidle_only_when_away';
+
+$aidle{'timer'} = Irssi::timeout_add $aidle{'max'} * 1000, 'antyidlesend', '';
+
+sub antyidlesend {
+ for my $server (Irssi::servers()) {
+ next if (not $server->{'connected'} or ($aidle{'away'} and not $server->{'usermode_away'})
+ or (@{$aidle{'ircnets'}} and not grep {lc $server->{'chatnet'} eq lc $_} @{$aidle{'ircnets'}}));
+ $server->send_raw("PRIVMSG " . $server->{nick} . " IDLE");
+ Irssi::timeout_remove $aidle{'timer'};
+ $aidle{'timer'} = Irssi::timeout_add int(rand($aidle{'max'})+1) * 1000, 'antyidlesend', '';
+ }
+}
+
+Irssi::signal_add 'setup changed' => sub {
+ $aidle{'away'} = Irssi::settings_get_bool 'aidle_only_when_away';
+ my $max_idle_time = Irssi::settings_get_int 'aidle_max_idle_time';
+ if ($max_idle_time < $aidle{'max'}) {
+ Irssi::timeout_remove $aidle{'timer'};
+ $aidle{'timer'} = Irssi::timeout_add int(rand($max_idle_time)+1) * 1000, 'antyidlesend', '';
+ }
+ $aidle{'max'} = $max_idle_time;
+ @{$aidle{'ircnets'}} = (split(/[\s,|-]+/, Irssi::settings_get_str('aidle_ircnets')));
+ foreach my $ircnet (@{$aidle{'ircnets'}}) {
+ Irssi::print("%RWarning%n - no such chatnet \'$ircnet\' !", MSGLEVEL_CLIENTERROR) unless (Irssi::chatnet_find($ircnet));
+ }
+};
+
+Irssi::signal_add "event 301" => sub {
+ my ($server, $data) = @_;
+
+ my ($fnick, $snick, undef) = split(' ', $data);
+
+ Irssi::signal_stop() if $fnick eq $snick;
+};
+
+Irssi::signal_add "default ctcp msg" => sub {
+ my ($server, $data, $sender, $addr, $target) = @_;
+
+ Irssi::signal_stop() if ($sender eq $target && $data eq "IDLE");
+};
diff --git a/scripts/akftp.pl b/scripts/akftp.pl
new file mode 100644
index 0000000..0c93230
--- /dev/null
+++ b/scripts/akftp.pl
@@ -0,0 +1,96 @@
+###########################################################################
+# ak FTP-Ad v1.4
+# Copyright (C) 2003 ak
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+# Or check out here, eh ;) -> http://www.gnu.org/licenses/gpl.html //ak
+###########################################################################
+
+# code follows .. nothing to do here for you,
+# just load the script into irssi with /script load akftp.pl
+# and enter /akftp for more information
+#############################################################
+
+use strict;
+use Irssi 20021117.1611 ();
+use vars qw($VERSION %IRSSI);
+ $VERSION = "1.4";
+ %IRSSI = (
+ authors => "ak",
+ contact => "ocb23\@freenet.removethis.de",
+ name => "ak FTP-Ad",
+ description => "Full configurable FTP advertiser for Irssi",
+ license => "GPLv2",
+ url => "http://members.tripod.com.br/archiv/",
+ );
+
+
+use Irssi qw(
+ settings_get_bool settings_add_bool
+ settings_get_str settings_add_str
+ settings_get_int settings_add_int
+ print
+);
+
+sub cmd_list {
+ my ($server, $msg, $nick, $mask, $target) = @_;
+ my ($c1, $c2, $trigger, $targets);
+ $trigger=settings_get_str('akftp_trigger');
+ $targets=settings_get_str('akftp_channels');
+
+ if (!settings_get_bool('akftp_enable_add')) { return 0 }
+ if(!($target =~ $targets)) { return 0 }
+ elsif ($msg=~/^$trigger/){
+ $c1=settings_get_str('akftp_color1');
+ $c2=settings_get_str('akftp_color2');
+ $server->command("^NOTICE ".$nick." ".$c1."=(".$c2."FTP Online".$c1.")= \@(".
+ $c2.settings_get_str('akftp_host').$c1.") Port:(".$c2.settings_get_str('akftp_port').
+ $c1.") Login:(".$c2.settings_get_str('akftp_login').$c1.") Pass:(".
+ $c2.settings_get_str('akftp_pass').$c1.") Quicklink: ".$c2.
+ "ftp://".settings_get_str('akftp_login').":".settings_get_str('akftp_pass')."\@".
+ settings_get_str('akftp_host').":".settings_get_str('akftp_port')."/".
+ $c1." Notes:(".$c2.settings_get_str('akftp_notes').$c1.")");
+ # Irssi::signal_stop();
+ }
+}
+
+sub cmd_akftp {
+ print("%r.--------------------<%n%_ak FTP-Ad for Irssi%_%r>--------------------<");
+ print("%r|%n Configure the script with %_/set%_ commands, to see all values,");
+ print("%r|%n you can type \"%_/set akftp%_\".");
+ print("%r|%n You can configure multiple chans by separating them with %_|%_");
+ print("%r|%n You have to specify the colors with \"%_CTRL+C##%_\". where %_##%_");
+ print("%r|%n must be numbers between %_00%_ and %_15%_! Prefix 0-9 with a zero!");
+ print("%r|%n Note that \"%_/set akftp%_\" will show empty variables for colors,");
+ print("%r|%n even if they are already set.");
+ print("%r`------------------------------------------------------------->");
+}
+
+settings_add_bool('akftp', 'akftp_enable_add', 0);
+settings_add_str('akftp', 'akftp_login', "username");
+settings_add_str('akftp', 'akftp_pass', "password");
+settings_add_str('akftp', 'akftp_host', "your.dyndns-or-static.ip");
+settings_add_str('akftp', 'akftp_notes', "Don't hammer!");
+settings_add_str('akftp', 'akftp_channels', "#chan1|#chan2");
+settings_add_int('akftp', 'akftp_port', "21");
+settings_add_str('akftp', 'akftp_color1', "\00303");
+settings_add_str('akftp', 'akftp_color2', "\00315");
+settings_add_str('akftp', 'akftp_trigger', "!list");
+
+Irssi::signal_add_last('message public', 'cmd_list');
+Irssi::command_bind('akftp', 'cmd_akftp');
+
+#EOF
diff --git a/scripts/akilluser.pl b/scripts/akilluser.pl
new file mode 100644
index 0000000..c0f350a
--- /dev/null
+++ b/scripts/akilluser.pl
@@ -0,0 +1,92 @@
+# AKILL a specified nick, either with the defined reason or with something given
+# in the command
+#
+# (C) 2006 by Joerg Jaspert <joerg@debian.org>
+# (C) 2007 by Christoph Berg <cb@df7cb.de>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+use strict;
+use Irssi;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '0.2.3';
+%IRSSI = (
+ authors => 'Joerg Jaspert',
+ contact => 'joerg@debian.org',
+ name => 'akilluser',
+ description => 'AKILLS a nick',
+ license => 'GPL v2 (and no later)',
+);
+
+########################################################################
+# Kill it
+
+sub akill_nick {
+ my ($arg, $server, $channel) = @_;
+
+ $arg =~ /(\S+)\s?(.*)?/;
+ my ($target, $reason) = ($1, $2);
+ my ($user, $host);
+
+ if ($target =~ /(.+)@(.+)/) {
+ ($user, $host) = ($1, $2);
+ if ($server->masks_match(Irssi::settings_get_str('akill_exempt'), "somebody", "${user}\@${host}")) {
+ Irssi::print("Not AKILLing an akill-exempt user");
+ return;
+ }
+ } else {
+ my @channicks = $server->nicks_get_same($target);
+ if (!@channicks) {
+ Irssi::print("User $target not found");
+ return;
+ }
+ my $nickh = $channicks[1];
+ if ($server->masks_match(Irssi::settings_get_str('akill_exempt'), $target, $nickh->{host})) {
+ Irssi::print("Not AKILLing an akill-exempt user");
+ return;
+ }
+ $nickh->{host} =~ /(\S+)@(\S+)/;
+ ($user, $host) = ("*", $2);
+ }
+
+ if ("$user$host" !~ /[\w\d]/) {
+ Irssi::print("AKILLing $user\@$host looks insane");
+ return;
+ }
+
+ if (length($reason) < 2) {
+ $reason = Irssi::settings_get_str('akill_reason');
+ }
+ if ($reason !~ /\@oftc\.net/) {
+ $reason .= " " . Irssi::settings_get_str('akill_trailer');
+ }
+
+ Irssi::print("AKILLed $target ($user\@$host) with \"$reason\"");
+ $server->command("quote os akill add $user\@$host $reason");
+}
+
+
+########################################################################
+# ---------- Do the startup tasks ----------
+
+# Add the settings
+Irssi::settings_add_str("akilluser.pl", "akill_reason", 'This host violated network policy.');
+Irssi::settings_add_str("akilluser.pl", "akill_trailer", 'Mail support@oftc.net if you think this is in error.');
+Irssi::settings_add_str("akilluser.pl", "akill_exempt", '*!*@*.sponsor.oftc.net *!*@*.advisor.oftc.net *!*@*.netrep.oftc.net *!*@*.netop.oftc.net *!*@*.noc.oftc.net *!*@*.ombudsman.oftc.net *!*@*.chair.oftc.net');
+
+Irssi::command_bind('akill', 'akill_nick');
diff --git a/scripts/alame.pl b/scripts/alame.pl
new file mode 100644
index 0000000..3c590cc
--- /dev/null
+++ b/scripts/alame.pl
@@ -0,0 +1,36 @@
+use Irssi;
+use Irssi::Irc;
+use strict;
+use warnings;
+use vars qw($VERSION %IRSSI);
+$VERSION="0.0.1";
+%IRSSI = (
+ authors => 'Christian \'mordeth\' Weber',
+ contact => 'mordeth\@mac.com',
+ name => 'alame',
+ description => 'Converts towards lame speech',
+ license => 'GPL v2',
+ url => 'http://',
+);
+
+
+# USAGE:
+# /alame <text>
+# writes "text" in lamespeech to the current channel
+
+sub cmd_lamer {
+ my ($data, $server, $witem) = @_;
+ if (!$server || !$server->{connected}) {
+ Irssi::print("Not connected to server");
+ return;
+ }
+ if ($data) {
+ my $x; $_=$data; s/./$x=rand(6); $x>3?lc($&):uc($&)/eg; s/a/4/gi; s/c/(/gi;
+ s/d/|)/gi; s/e/3/gi; s/f/|=/gi; s/h/|-|/gi; s/i/1/gi; s/k/|</gi;
+ s/l/|_/gi; s!m!/\\/\\!gi; s!n!/\\/!gi; s/o/0/gi; s/s/Z/gi; s/t/7/gi;
+ s/u/|_|/gi; s!v!\\/!gi; s!w!\\/\\/!gi; #s/w/\/\//gi;
+ $witem->command("/SAY $_");
+ }
+}
+
+Irssi::command_bind('alamer', 'cmd_lamer');
diff --git a/scripts/anotherway.pl b/scripts/anotherway.pl
new file mode 100644
index 0000000..f7a0ca8
--- /dev/null
+++ b/scripts/anotherway.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+#
+# by Stefan Tomanek <stefan@pico.ruhr.de>
+
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "2003010201";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "anotherway",
+ description => "Another auto away script",
+ license => "GPLv2",
+ changed => "$VERSION",
+);
+use Irssi 20020324;
+use vars qw($timer @signals);
+
+@signals = ('message own_public', 'message own_private');
+
+sub go_away {
+ #Irssi::print "%R>>%n Going away...$timer";
+ Irssi::timeout_remove($timer);
+ my $reason = Irssi::settings_get_str("anotherway_reason");
+ my @servers = Irssi::servers();
+ return unless @servers;
+ Irssi::signal_remove($_ , "reset_timer") foreach (@signals);
+ $servers[0]->command('AWAY '.$reason);
+ Irssi::signal_add($_ , "reset_timer") foreach (@signals);
+}
+
+sub reset_timer {
+ #Irssi::print "%R>>%n RESET";
+ Irssi::signal_remove($_ , "reset_timer") foreach (@signals);
+ foreach (Irssi::servers()) {
+ $_->command('AWAY') if $_->{usermode_away};
+ last;
+ }
+ #Irssi::signal_add('nd', "reset_timer");
+ Irssi::timeout_remove($timer);
+ my $timeout = Irssi::settings_get_int("anotherway_timeout");
+ $timer = Irssi::timeout_add($timeout*1000, "go_away", undef);
+ Irssi::signal_add($_, "reset_timer") foreach (@signals);
+}
+
+Irssi::settings_add_str($IRSSI{name}, 'anotherway_reason', 'a-nother-way');
+Irssi::settings_add_int($IRSSI{name}, 'anotherway_timeout', 300);
+
+{
+ Irssi::signal_add($_, "reset_timer") foreach (@signals);
+ reset_timer();
+}
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded';
diff --git a/scripts/antiplenk.pl b/scripts/antiplenk.pl
new file mode 100644
index 0000000..40c0d50
--- /dev/null
+++ b/scripts/antiplenk.pl
@@ -0,0 +1,47 @@
+use Irssi;
+use 5.6.0;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.2.1";
+%IRSSI = (
+ authors => 'Grigori Goronzy',
+ contact => 'greg@chown.ath.cx',
+ name => 'antiplenk',
+ description => 'notices users who "plenk"',
+ license => 'BSD',
+ url => 'http://chown.ath.cx/~greg/antiplenk/',
+ changed => 'Mi 12 Feb 2003 07:00:05 CET',
+);
+
+Irssi::settings_add_str($IRSSI{'name'}, "plenk_channels", "#foobar|#barfoo");
+Irssi::settings_add_bool($IRSSI{'name'}, "plenk_spam", "1");
+Irssi::settings_add_int($IRSSI{'name'}, "plenk_allowed", "10");
+Irssi::signal_add_last('message public', 'plenk');
+my %times;
+
+Irssi::print "antiplenk $VERSION loaded";
+
+sub plenk {
+my ($server, $msg, $nick, $address, $channel) = @_;
+my $spam = Irssi::settings_get_bool("plenk_spam");
+my $allowed = Irssi::settings_get_int("plenk_allowed");
+
+# channel in list?
+if(!($channel =~ Irssi::settings_get_str("plenk_channels"))) { return 0 }
+
+# check..
+while($msg =~ /[[:alnum:]]+ (\.|\,|\?|\!|\: |\; )(\!|\1|\?|\ß|\.|\ |$)/g) {
+ # increment
+ $times{$nick}++;
+ # "debug"
+ if($spam) { Irssi::print "antiplenk: $nick plenked on $channel for the $times{$nick}" .
+ ($times{$nick} == 1 ? "st" : $times{$nick} == 2 ? "nd" : $times{$nick} == 3 ? "rd" : "th") .
+ " time" }
+ # too often?
+ if($times{$nick} > $allowed ) {
+ $server->command("msg $nick antiplenk: you 'plenked' more than $allowed times! please stop this at once!");
+ Irssi::print "antiplenk: $nick got a notice";
+ $times{$nick} = 0; }
+ }
+}
diff --git a/scripts/apm.pl b/scripts/apm.pl
new file mode 100644
index 0000000..5ab1b62
--- /dev/null
+++ b/scripts/apm.pl
@@ -0,0 +1,122 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi::TextUI;
+
+$VERSION = "0.4";
+%IRSSI = (
+ authors => "Alexander Wirt",
+ contact => "formorer\@formorer.de",
+ name => "apm",
+ description => "Shows your battery status in your Statusbar",
+ sbitems => "power",
+ license => "GNU Public License",
+ url => "http://www.formorer.de/code",
+);
+
+
+#
+#apm.pl
+# apm.pl is a small script for displaying your Battery Level in irssi.
+# Just load the script and do a /statusbar window add apm
+# and a small box [BAT: +/-XX%] should be displayed this is only possible
+# on Computers where /proc/apm or /proc/acpi is existing.
+# The + or - indicates if battery is charging or discharging.
+#
+# /set power_refresh <sec> changes the refreshing time of the display
+#
+#
+# Changelog:
+#
+# 0.3 - Added support for ACPI and enhanced APM support
+# 0.2 - Added apm_refresh and some documentation
+# 0.1 - Initial Release
+
+
+
+
+
+my ($refresh, $last_refresh, $refresh_tag) = (10);
+
+my ($acpi,$apm) = 0;
+
+
+if (-r "/proc/acpi") { $acpi = "yes" }
+if (-r "/proc/apm") { $apm = "yes" }
+
+exit unless ($apm or $acpi);
+
+
+sub get_apm {
+ open(RC, q{<}, "/proc/apm");
+ my $line = <RC>;
+ close RC;
+ my ($ver1, $ver2, $sysstatus, $acstat, $chargstat, $batstatus, $prozent, $remain) = split(/\s/,$line);
+
+ if ($acstat eq "0x01") { return "+$prozent" } else { return "-$prozent" }
+}
+
+sub get_acpi {
+ open(RC, q{<}, "/proc/acpi/ac_adapter/ACAD/state");
+ my $line = <RC>;
+ close RC;
+ my ($text,$state) = split (/:/,$line);
+ $state =~ s/\s//g;
+
+ open (RC, q{<}, "/proc/acpi/battery/BAT0/info");
+ my ($text,$capa,$ein);
+ while (my $line = <RC>) {
+ if ($line =~ /last full capacity/) {
+ ($text, $capa,$ein) = split (/:/,$line);
+ $capa =~ s/\s//g;
+ }
+ }
+ open (RC, q{<}, "/proc/acpi/battery/BAT0/state");
+ my ($text,$remain,$ein);
+ while (my $line = <RC>) {
+ if ($line =~ /remaining capacity/) {
+ ($text, $remain,$ein) = split (/:/,$line);
+ $remain =~ s/\s//g;
+ }
+ }
+ my $pstate = $remain / $capa * 100;
+ $pstate = sprintf("%2i", $pstate);
+
+ if ($state eq "off-line") { $pstate = "-$pstate%"; } else { $pstate = "+$pstate%"; }
+ return $pstate;
+}
+
+
+sub power {
+ my ($item, $get_size_only) = @_;
+ my $pstate;
+ if ($apm) {
+ $pstate = get_apm();
+ } else {
+ $pstate = get_acpi();
+ }
+ $item->default_handler($get_size_only, undef, "BAT:$pstate", 1 );
+}
+
+
+sub set_power {
+ $refresh = Irssi::settings_get_int('power_refresh');
+ $refresh = 1 if $refresh < 1;
+ return if $refresh == $last_refresh;
+ $last_refresh = $refresh;
+ Irssi::timeout_remove($refresh_tag) if $refresh_tag;
+ $refresh_tag = Irssi::timeout_add($refresh*1000, 'refresh_power', undef);
+
+}
+
+
+sub refresh_power {
+ Irssi::statusbar_items_redraw('power');
+}
+
+Irssi::statusbar_item_register('power', '{sb $0-}', 'power');
+Irssi::statusbars_recreate_items();
+
+Irssi::settings_add_int('misc', 'power_refresh', $refresh);
+set_power();
+Irssi::signal_add('setup changed', 'set_power');
diff --git a/scripts/armeija.pl b/scripts/armeija.pl
new file mode 100644
index 0000000..fc854c6
--- /dev/null
+++ b/scripts/armeija.pl
@@ -0,0 +1,267 @@
+#!/usr/bin/perl -w
+# script to ignore boring messages in irc
+# it has a list of keywords which on a public message will cause someone
+# to be ignored for 60 seconds (changeable). also it ignores (tries to)
+# every message back to ignored people.
+# - flux@inside.org
+
+# check out my other irssi-stuff at http://xulfad.inside.org/~flux/software/irssi/
+
+use strict;
+use Irssi;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.4";
+%IRSSI = (
+ authors => "Erkki Seppälä",
+ contact => "flux\@inside.org",
+ name => "Armeija Ignore",
+ description => "Ignores people bringin up boring/repeated subjects, plus replies.",
+ license => "Public Domain",
+ url => "http://xulfad.inside.org/~flux/software/irssi/",
+ changed => "Tue Mar 5 00:06:35 EET 2002"
+);
+
+
+use Irssi::Irc;
+
+my $log = 0;
+my $logFile = "$ENV{HOME}/.irssi/armeija.log";
+
+my $retrigger = 0;
+my $wordFile = "$ENV{HOME}/.irssi/armeija.words";
+my $channelFile = "$ENV{HOME}/.irssi/armeija.channels";
+my $overflowLimit = 3;
+
+my @channels = ("#linux.fi");
+
+my @keywords = (
+
+# armeija
+ "\\barmeija", "\\brynkky", "\\bintti", "\\bintissä", "\\bgines", "\\btj\\b"
+, "\\bsaapumiserä", "\\bvarus(mies|nainen|täti)", "\\bvemppa", "\\bvempula"
+, "\\bvempa", "\\bveksi", "\\bsulkeiset", "\\bsulkeisi"
+, "\\bvlv\\b", "\\bhl\\b"
+
+# offtopic
+, "\\bsalkkari", "\\bsalatut eläm". "\\bsalattuja eläm"
+
+# urheilu
+,"\\bhiiht", "\\bhiihd", "\\bformula", "\\bolympia"
+
+);
+
+my %infected;
+my $timeout = 60;
+
+my $who = "";
+my $why = "";
+
+sub p0 {
+ my $a = $_[0];
+ while (length($a) < 2) {
+ $a = "0$a";
+ }
+ return $a;
+}
+
+sub why {
+ if ($who ne "") {
+ Irssi::print "$who was ignored: $why";
+ }
+}
+
+sub public {
+ my ($server, $msg, $nick, $address, $target) = @_;
+
+ local *F;
+
+ my $now = time;
+
+ my $skip = 1;
+ foreach my $channel (@channels) {
+ if (lc($target) eq lc($channel)) {
+ $skip = 0;
+ last;
+ }
+ }
+
+ if ($skip) {
+ return 0;
+ }
+
+ # check for keywords
+
+ my $count = 0;
+ foreach my $word (@keywords) {
+ if ($msg =~ /$word/i) {
+ ++$count;
+ }
+ }
+
+ if (($count >= 1) && ($count < $overflowLimit)) {
+ Irssi::print "Ignoring $nick";
+ $why = $msg;
+ $who = $nick;
+ if ($log) {
+ open(F, q{>>}, $logFile);
+ my @t = localtime($now);
+ $t[5] += 1900;
+ print F "$t[5]-", p0($t[4] + 1), "-", p0($t[3]), " ",
+ p0($t[2]), ":", p0($t[1]), ":", p0($t[0]), " $who/$target: $why\n";
+ close(F);
+ }
+ if ($retrigger || !exists $infected{$nick}) {
+ $infected{$nick} = $now + $timeout;
+ }
+ Irssi::signal_stop();
+ return 1;
+ }
+
+ # check and expire old ignores
+ if (exists $infected{$nick}) {
+ if ($infected{$nick} < $now) {
+ Irssi::print "Timed out: $nick";
+ delete $infected{$nick};
+ } else {
+ Irssi::signal_stop();
+ return 1;
+ }
+ }
+
+ # check for messages targetted to ignored people
+ foreach my $nick (keys %infected) {
+ if ($msg =~ /^$nick/i) {
+ # ignore messages to these people
+ Irssi::signal_stop();
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+sub logging {
+ my (@args) = @_;
+ if (@args) {
+ if ($args[0] eq "on") {
+ $log = 1;
+ Irssi::print("Armeija-logging on to file $logFile");
+ } elsif ($args[0] eq "off") {
+ $log = 0;
+ Irssi::print("Armeija-logging stopped");
+ } else {
+ $logFile = $args[0];
+ Irssi::print("Armeija-logfile set to $logFile");
+ }
+ } else {
+ Irssi::print("usage: armeija log [on|off|new log file name]");
+ Irssi::print("Log is " . ($log ? "on" : "off") . ", logfile is $logFile");
+ }
+}
+
+sub load {
+ local $/ = "\n";
+ local *F;
+ if (open(F, q{<}, $wordFile)) {
+ @keywords = ();
+ while (<F>) {
+ chomp;
+ push @keywords, $_;
+ }
+ close(F);
+ } else {
+ Irssi::print("Failed to open wordfile $wordFile\n");
+ }
+ if (open(F, q{<}, $channelFile)) {
+ @channels = ();
+ while (<F>) {
+ chomp;
+ push @channels, $_;
+ }
+ close(F);
+ }
+}
+
+sub save {
+ local *F;
+ if (open(F, q{>}, $wordFile)) {
+ for (my $c = 0; $c < @keywords; ++$c) {
+ print F $keywords[$c], "\n";
+ }
+ close(F);
+ }
+ if (open(F, q{>}, $channelFile)) {
+ for (my $c = 0; $c < @channels; ++$c) {
+ print F $channels[$c], "\n";
+ }
+ close(F);
+ }
+}
+
+sub retrigger {
+ if (@_ == 1) {
+ if ($_[0] eq "on") {
+ Irssi::print "Armeija retrigger on";
+ $retrigger = 1;
+ } elsif ($_[0] eq "off") {
+ Irssi::print "Armeija retrigger off";
+ $retrigger = 0;
+ } else {
+ Irssi::print("Invalid armeija trigger state");
+ }
+ } else {
+ Irssi::print("usage: /armeija retrigger [on|off]");
+ }
+}
+
+sub armeija {
+ my (@args) = split(" ", $_[0]);
+ if (@args) {
+ if ($args[0] eq "why") {
+ why();
+ } elsif ($args[0] eq "log") {
+ my @a = @args;
+ shift @a;
+ logging(@a);
+ } elsif ($args[0] eq "load") {
+ load();
+ } elsif ($args[0] eq "save") {
+ save();
+ } elsif ($args[0] eq "+word") {
+ my @a = @args;
+ shift @a;
+ push @keywords, join(" ", @a);
+ save();
+ } elsif ($args[0] eq "-word") {
+ my @a = @args;
+ shift @a;
+ for (my $c = 0; $c < @keywords; ++$c) {
+ for (my $d = 0; $d < @a;) {
+ if ($a[$d] eq $keywords[$c]) {
+ splice @keywords, $c, 1;
+ } else {
+ ++$d;
+ }
+ }
+ }
+ save();
+ } elsif ($args[0] eq "words") {
+ Irssi::print(join(", ", @keywords));
+ } elsif ($args[0] eq "retrigger") {
+ my @a = @args;
+ shift @a;
+ retrigger(@a);
+ } else {
+ Irssi::print("Invalid armeija command");
+ }
+ } else {
+ Irssi::print("Armeija usage: armeija [log [off|on|filename]|load|save|+word word|-word word|words]");
+ }
+}
+
+Irssi::signal_add("message public", "public");
+Irssi::command_bind("armeija", "armeija");
+
+Irssi::print "Armeija-ignore v$VERSION by $IRSSI{contact}";
+load();
diff --git a/scripts/ascii.pl b/scripts/ascii.pl
new file mode 100644
index 0000000..557ebb0
--- /dev/null
+++ b/scripts/ascii.pl
@@ -0,0 +1,405 @@
+#
+# Commands: /ASCII, /COLSAY, /COLME, /COLTOPIC, /COLKICK, /COLQUIT
+# Usage:
+# /ASCII [-c1234] [-f <fontname>] [-p <prefix>] [-l|-s|-m <where>] <text>
+# /COLSAY [-1234] [-m <where>] <text>
+# /COLME [-1234] <text>
+# /COLTOPIC [-1234] <text>
+# /COLKICK [-1234] [nick(,nick_1,...,nick_n)] <reason>
+# /COLQUIT [-1234] <reason>
+# Settings:
+# /SET ascii_figlet_path [path]
+# /SET ascii_default_font [fontname]
+# /SET ascii_default_colormode [1-4]
+# /SET ascii_default_prefix [prefix]
+# /SET ascii_default_kickreason [reason]
+# /SET ascii_default_quitreason [reason]
+#
+# Script is bassed on figlet.
+#
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.6.3";
+%IRSSI = (
+ "authors" => "Marcin Rozycki",
+ "contact" => "derwan\@irssi.pl",
+ "name" => "ascii-art",
+ "description" => "Ascii-art bassed on figlet. Available commands: /ASCII, /COLSAY, /COLME, /COLTOPIC, /COLKICK, /COLQUIT.",
+ "url" => "http://derwan.irssi.pl",
+ "license" => "GNU GPL v2",
+ "changed" => "Fri Jun 21 17:17:53 CEST 2002"
+);
+
+use IPC::Open3;
+
+# defaults
+my $ascii_default_font = "small.flf";
+my $ascii_default_kickreason = "Irssi BaBy!";
+my $ascii_default_quitreason = "I Quit!";
+my $ascii_last_color = undef;
+my @ascii_colors = (12, 12, 12, 9, 5, 4, 13, 8, 7, 3, 11, 10, 2, 6, 6, 6, 6, 10, 8, 7, 4, 3, 9, 11, 2, 12, 13, 5);
+
+# registering themes
+Irssi::theme_register([
+ 'ascii_not_connected', '%_$0:%_ You\'re not connected to server',
+ 'ascii_not_window', '%_$0:%_ Not joined to any channel or query window',
+ 'ascii_not_chanwindow', '%_$0:%_ Not joined to any channel',
+ 'ascii_not_chanop', '%_$0:%_ You\'re not channel operator in {hilight $1}',
+ 'ascii_figlet_notfound', '%_Ascii:%_ Cannot execute {hilight $0} - file not found or bad permissions',
+ 'ascii_figlet_notset', '%_Ascii:%_ Cannot find external program %_figlet%_, usign /SET ascii_figlet_path [path], to set it',
+ 'ascii_cmd_syntax', '%_$0:%_ $1, usage: $2',
+ 'ascii_figlet_error', '%_Ascii: Figlet returns error:%_ $0-',
+ 'ascii_fontlist', '%_Ascii:%_ Available fonts [in $0]: $1 ($2)',
+ 'ascii_empty_fontlist', '%_Ascii:%_ Cannot find figlet fonts in $0',
+ 'ascii_unknown_fontdir', '%_Ascii:%_ Cannot find figlet fontdir',
+ 'ascii_show_line', '$0-'
+
+]);
+
+# str find_figlet_path()
+sub find_figlet_path {
+ foreach my $dir (split(/\:/, $ENV{'PATH'}))
+ {
+ return "$dir/figlet" if ($dir and -x "$dir/figlet");
+ }
+}
+
+# int randcolor()
+sub randcolor {
+ return $ascii_colors[int(rand(12)+2)];
+}
+
+# str colorline($colormode, $text)
+sub colorline {
+ my ($colormode, $text) = @_;
+ my $colortext = undef;
+ my $last = ($ascii_last_color) ? $ascii_last_color : randcolor();
+ my $indx = $last;
+
+ if ($colormode =~ /3/) {
+ $ascii_last_color = randcolor();
+ }elsif ($colormode =~ /4/) {
+ $ascii_last_color = $ascii_colors[$last];
+ }elsif ($colormode !~ /2/) {
+ $ascii_last_color = $ascii_colors[14+$last];
+ }
+
+ while ($text =~ /./g)
+ {
+ my $char = "$&";
+
+ if ($colormode =~ /3/) {
+ while ($indx == $last) { $indx = randcolor(); };
+ $last = $indx;
+ }elsif ($colormode =~ /4/) {
+ $indx = $ascii_colors[$indx];
+ }elsif ($last) {
+ $indx = $ascii_colors[$last];
+ undef $last;
+ } else {
+ $indx = $ascii_colors[$indx];
+ $last = $indx + 14;
+ };
+
+ $colortext .= $char, next if ($char eq " ");
+ $colortext .= "\003" . sprintf("%02d", $indx) . $char;
+ $colortext .= $char if ($char eq ",");
+ };
+
+ return $colortext;
+};
+
+# int colormode()
+sub colormode {
+ my $mode = Irssi::settings_get_int("ascii_default_colormode");
+ $mode =~ s/-//g;
+ return (!$mode or $mode > 4) ? 1 : $mode;
+};
+
+# bool ascii_test($command, $flags, $server, $window)
+sub ascii_test {
+ my ($cmd, $test, $server, $window) = @_;
+
+ if ($test =~ /s/ and !$server || !$server->{connected}) {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_not_connected", $cmd);
+ return 0;
+ };
+ if ($test =~ /W/ and !$window || $window->{type} !~ /(channel|query)/i) {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_not_window", $cmd);
+ return 0;
+ };
+ if ($test =~ /(w|o)/ and !$window || $window->{type} !~ /channel/i) {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_not_chanwindow", $cmd);
+ return 0;
+ };
+ if ($test =~ /o/ and !$window->{chanop}) {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_not_chanop", $cmd, Irssi::active_win()->get_active_name());
+ return 0;
+ };
+
+ return 1;
+}
+
+# void cmd_ascii()
+# handles /ascii
+sub cmd_ascii
+{
+ my $usage = "/ASCII [-c1234] [-f <fontname>] [-p <prefix>] [-l|-s|-m <where>] <text>";
+ my $font = Irssi::settings_get_str("ascii_default_font");
+ my $prefix = Irssi::settings_get_str("ascii_default_prefix");
+ my ($arguments, $server, $witem) = @_;
+ my ($text, $cmd, $mode);
+
+ $font = $ascii_default_font unless ($font);
+ $ascii_last_color = randcolor();
+
+ my $figlet = Irssi::settings_get_str("ascii_figlet_path");
+ if (!$figlet or !(-x $figlet)) {
+ my $theme = ($figlet) ? "ascii_figlet_notfound" : "ascii_figlet_notset";
+ Irssi::printformat(MSGLEVEL_CRAP, $theme, $figlet);
+ return;
+ };
+
+ my @foo = split(/ +/, $arguments);
+ while ($_ = shift(@foo))
+ {
+ /^-l$/ and show_figlet_fonts($figlet), return;
+ /^-c$/ and $mode = colormode(), next;
+ /^-(1|2|3|4)$/ and s/-//g, $mode = $_, next;
+ /^-f$/ and $font = shift(@foo), next;
+ /^-p$/ and $prefix = shift(@foo), next;
+ /^-m$/ and $cmd = shift(@foo), next;
+ /^-s$/ and $cmd = 0, next;
+ /^-/ and Irssi::printformat(MSGLEVEL_CRAP, "ascii_cmd_syntax", "Ascii", "Unknown argument: $_", $usage), return;
+ $text = ($#foo < 0) ? $_ : $_ . " " . join(" ", @foo);
+ last;
+ }
+
+ unless (length($text)) {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_cmd_syntax", "Ascii", "Missing arguments", $usage);
+ return;
+ };
+
+ if ($cmd eq "") {
+ return unless (ascii_test("Ascii", "sW", $server, $witem));
+ $cmd = Irssi::active_win()->get_active_name();
+ } elsif ($cmd ne "0" and !ascii_test("Ascii", "s", $server, $witem)) {
+ return;
+ }
+
+ my $pid = open3(*FIGIN, *FIGOUT, *FIGERR, $figlet, qw(-k -f), $font, $text);
+
+ while (<FIGOUT>)
+ {
+ chomp;
+ next unless (/[^ ]/);
+ $_ = colorline($mode, $_) if ($mode);
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, "ascii_show_line", $prefix.$_), next if ($cmd eq "0");
+ $server->command("msg $cmd $prefix$_");
+ }
+
+ while (<FIGERR>)
+ {
+ chomp;
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_figlet_error", $_);
+ };
+
+ close FIGIN;
+ close FIGOUT;
+ close FIGERR;
+
+ waitpid $pid, 0;
+}
+
+# void show_figlet_fonts(figlet path)
+sub show_figlet_fonts {
+ my @fontlist;
+ if (my $fontdir = `"$_[0]" -I 2 2>/dev/null`) {
+ chomp $fontdir;
+ foreach my $font (glob $fontdir."/*.flf")
+ {
+ $font =~ s/^$fontdir\///;
+ $font =~ s/\.flf$//;
+ push @fontlist, $font;
+ }
+ if ($#fontlist < 0) {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_fontlist_empty", $fontdir);
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_fontlist", $fontdir, join(", ", @fontlist), scalar(@fontlist));
+ }
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_unknown_fontdir");
+ }
+}
+
+# void cmd_colsay()
+# handles /colsay
+sub cmd_colsay {
+ my $usage = "/COLSAY [-1234] [-m <where>] <text>";
+ my ($arguments, $server, $witem) = @_;
+ my ($cmd, $text);
+ my $mode = colormode();
+
+ $ascii_last_color = randcolor();
+
+ my @foo = split(/ /, $arguments);
+ while ($_ = shift(@foo))
+ {
+ /^-(1|2|3|4)$/ and $mode = $_, next;
+ /^-m$/i and $cmd = shift(@foo), next;
+ /^-/ and Irssi::printformat(MSGLEVEL_CRAP, "ascii_cmd_syntax", "Colsay", "Unknown argument: $_", $usage), return;
+ $text = ($#foo < 0) ? $_ : $_ . " " . join(" ", @foo);
+ last;
+ };
+
+ unless (length($text)) {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_cmd_syntax", "Colsay", "Missing arguments", $usage);
+ return;
+ };
+
+ if ($cmd) {
+ return unless (ascii_test("Colsay", "s", $server, $witem));
+ } else {
+ return unless (ascii_test("Colsay", "sW", $server, $witem));
+ $cmd = Irssi::active_win()->get_active_name();
+ };
+
+ $server->command("msg $cmd ".colorline($mode, $text));
+}
+
+
+sub cmd_colme {
+ my $usage = "/COLME [-1234] <text>";
+ my ($arguments, $server, $witem) = @_;
+ my $mode = colormode();
+ my $text;
+
+ $ascii_last_color = randcolor();
+
+ my @foo = split(/ /, $arguments);
+ while ($_ = shift(@foo))
+ {
+ /^-(1|2|3|4)$/ and $mode = $_, next;
+ /^-/ and Irssi::printformat(MSGLEVEL_CRAP, "ascii_cmd_syntax", "Colme", "Unknown argument: $_", $usage), return;
+ $text = ($#foo < 0) ? $_ : $_ . " " . join(" ", @foo);
+ last;
+ };
+
+ unless (length($text)) {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_cmd_syntax", "Colme", "Missing arguments", $usage);
+ return;
+ };
+
+ return unless (ascii_test("Colme", "sW", $server, $witem));
+ $witem->command("me ".colorline($mode, $text));
+}
+
+# void cmd_coltopic()
+# handles /coltopic
+sub cmd_coltopic {
+ my $usage = "/COLTOPIC [-1234] <text>";
+ my ($arguments, $server, $witem) = @_;
+ my $mode = colormode();
+ my $text;
+
+ $ascii_last_color = randcolor();
+
+ my @foo = split(/ /, $arguments);
+ while ($_ = shift(@foo))
+ {
+ /^-(1|2|3|4)$/ and $mode = $_, next;
+ /^-/ and Irssi::printformat(MSGLEVEL_CRAP, "ascii_cmd_syntax", "Coltopic", "Unknown argument: $_", $usage), return;
+ $text = ($#foo < 0) ? $_ : $_ . " " . join(" ", @foo);
+ last;
+ };
+
+ unless (length($text)) {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_cmd_syntax", "Coltopic", "Missing arguments", $usage);
+ return;
+ };
+
+ return unless (ascii_test("Coltopic", "sw", $server, $witem));
+
+ $server->command("topic " . Irssi::active_win()->get_active_name() . " " . colorline($mode, $text));
+};
+
+# void cmd_colkick()
+# handles /colkick
+sub cmd_colkick {
+ my $usage = "/COLKICK [-1234] [nick(,nick_1,...,nick_n)] <reason>";
+ my ($arguments, $server, $witem) = @_;
+ my $kickreason = Irssi::settings_get_str("ascii_default_kickreason");
+ my $mode = colormode();
+ my $who = undef;
+
+ $ascii_last_color = randcolor();
+ $kickreason = $ascii_default_kickreason unless ($kickreason);
+
+ my @foo = split(/ /, $arguments);
+ while ($_ = shift(@foo))
+ {
+ /^-(1|2|3|4)$/ and $mode = $_, next;
+ /^-/ and Irssi::printformat(MSGLEVEL_CRAP, "ascii_cmd_syntax", "Colkick", "Unknown argument: $_", $usage), return;
+ $kickreason = join(" ", @foo) if ($#foo >= 0);
+ $who = $_;
+ last;
+ };
+
+ if (!$who or !length($kickreason)) {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_cmd_syntax", "Colkick", "Missing arguments", $usage);
+ return;
+ };
+
+ return unless (ascii_test("Colkick", "swo", $server, $witem));
+ $witem->command("kick $who ".colorline($mode, $kickreason));
+};
+
+# void cmd_colquit()
+# handles /colquit
+sub cmd_colquit {
+ my $usage = "/COLQUIT [-1234] <reason>";
+ my ($arguments, $server, $witem) = @_;
+ my $quitreason = Irssi::settings_get_str("ascii_default_quitreason");
+ my $mode = colormode();
+
+ $ascii_last_color = randcolor();
+ $quitreason = $ascii_default_quitreason unless ($quitreason);
+
+ my @foo = split(/ /, $arguments);
+ while ($_ = shift(@foo))
+ {
+ /^-(1|2|3|4)$/ and $mode = $_, next;
+ /^-/ and Irssi::printformat(MSGLEVEL_CRAP, "ascii_cmd_syntax", "Colquit", "Unknown argument: $_", $usage), return;
+ $quitreason = ($#foo < 0) ? $_ : $_ . " " . join(" ", @foo);
+ last;
+ };
+
+ unless (length($quitreason)) {
+ Irssi::printformat(MSGLEVEL_CRAP, "ascii_cmd_syntax", "Colquit", "Missing arguments", $usage);
+ return;
+ };
+
+ return unless (ascii_test("Colquit", "s", $server, $witem));
+ $server->command("quit " . colorline($mode, $quitreason));
+}
+
+# registering settings
+Irssi::settings_add_str("misc", "ascii_default_font", $ascii_default_font);
+Irssi::settings_add_str("misc", "ascii_default_kickreason", $ascii_default_kickreason);
+Irssi::settings_add_str("misc", "ascii_default_quitreason", $ascii_default_quitreason);
+Irssi::settings_add_str("misc", "ascii_default_prefix", "");
+Irssi::settings_add_int("misc", "ascii_default_colormode", 1);
+Irssi::settings_add_str("misc", "ascii_figlet_path", find_figlet_path);
+
+# binding commands
+Irssi::command_bind("ascii", "cmd_ascii");
+Irssi::command_bind("colsay", "cmd_colsay");
+Irssi::command_bind("colme", "cmd_colme");
+Irssi::command_bind("coltopic", "cmd_coltopic");
+Irssi::command_bind("colkick", "cmd_colkick");
+Irssi::command_bind("colquit", "cmd_colquit");
diff --git a/scripts/auto_away.pl b/scripts/auto_away.pl
new file mode 100644
index 0000000..1c2980f
--- /dev/null
+++ b/scripts/auto_away.pl
@@ -0,0 +1,90 @@
+use Irssi;
+use Irssi::TextUI;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+#Setting variables:
+
+#first_away_message - The first /away messsage
+#second_away_message - The second /away message
+#first_away_timeout - Number of seconds to activate the first away state
+#second_away_timeout - Number of seconds to activate the second away state
+#away_servers - list of servertags seperated by spaces where auto_away will work.
+# If empty (/set -clear away_servers, it will work on every network
+#
+# CHANGELOG:
+# 21 DEC 2004:
+# the timer is only being reset when pressing enter. and the away timer starts counting after the last time you pressed enter.
+# this is less CPU consuming :-D
+
+$VERSION = '0.2';
+%IRSSI = (
+ authors => 'Tijmen Ruizendaal',
+ contact => 'tijmen@fokdat.nl',
+ name => 'auto_away.pl',
+ description => 'server specific autoaway with two different away states at different intervals',
+ license => 'GPLv2',
+ url => 'http://the-timing.nl/stuff/irssi-bitlbee',
+ changed => '2004-12-21',
+);
+
+
+my $timer;
+
+Irssi::settings_add_str('misc', 'first_away_message', undef);
+Irssi::settings_add_str('misc', 'second_away_message', undef);
+Irssi::settings_add_int('misc', 'first_away_timeout', undef);
+Irssi::settings_add_int('misc', 'second_away_timeout', undef);
+Irssi::settings_add_str('misc', 'away_servers', undef);
+
+sub reset_timer{
+ my $key=shift;
+ if($key == 10){
+ my (@servers) = Irssi::servers();
+ foreach my $server (@servers) {
+ if($server->{usermode_away} == 1){
+ $server->command("AWAY -one");
+ }
+ }
+ Irssi::timeout_remove($timer);
+ my $timeout = Irssi::settings_get_int('first_away_timeout');
+ if ($timeout){
+ $timer = Irssi::timeout_add_once($timeout*1000, 'first_away', undef); ## activate first away state
+ }
+ }
+}
+sub first_away{
+ away(1);
+ my $timeout = Irssi::settings_get_int('second_away_timeout');
+ if ($timeout){
+ Irssi::timeout_remove($timer);
+ $timer = Irssi::timeout_add_once($timeout*1000, 'away', 2); ## activate second away state
+ }
+}
+sub away{
+ my $state = shift;
+ my $server_string = Irssi::settings_get_str('away_servers');
+ my (@away_servers) = split (/ +/, $server_string);
+ my (@servers) = Irssi::servers();
+ my $message;
+
+ if($state == 1){
+ $message = Irssi::settings_get_str('first_away_message');
+ }elsif($state == 2){
+ $message = Irssi::settings_get_str('second_away_message');
+ }
+ if($server_string){
+ foreach my $away_server (@away_servers) {
+ #print "|$away_server|";
+ foreach my $server (@servers) {
+ if ($away_server eq $server->{tag} && ($server->{usermode_away} == 0 || $state == 2) ){
+ $server->command("AWAY -one $message");
+ }
+ }
+ }
+ }else{
+ my $server=$servers[0];
+ $server->command("AWAY -all $message");
+ }
+}
+Irssi::signal_add_last('gui key pressed', 'reset_timer');
diff --git a/scripts/auto_whois.pl b/scripts/auto_whois.pl
new file mode 100644
index 0000000..59fc1ef
--- /dev/null
+++ b/scripts/auto_whois.pl
@@ -0,0 +1,80 @@
+# /WHOIS all the users who send you a private message.
+# v0.9 for irssi by Andreas 'ads' Scherbaum
+# idea and some code taken from autowhois.pl from Timo Sirainen
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.9";
+%IRSSI = (
+ authors => "Andreas \'ads\' Scherbaum",
+ contact => "ads\@ufp.de",
+ name => "auto_whois",
+ description => "/WHOIS all the users who send you a private message.",
+ license => "GPL",
+ url => "http://irssi.org/",
+ changed => "2004-02-10",
+ changes => "v0.9: don't /WHOIS if query exists for the nick already"
+);
+
+# History:
+# v0.9: don't /WHOIS if query exists for the nick already
+# now we store all nicks we have seen in the last 10 minutes
+
+my @seen = ();
+
+sub msg_private_first {
+ my ($server, $msg, $nick, $address) = @_;
+
+ # go through every stored connection and remove, if timed out
+ my $time = time();
+ my ($connection);
+ my @new = ();
+ foreach $connection (@seen) {
+ if ($connection->{lasttime} >= $time - 600) {
+ # is ok, use it
+ push(@new, $connection);
+ # all timed out connections will be dropped
+ }
+ }
+ @seen = @new;
+}
+
+sub msg_private {
+ my ($server, $msg, $nick, $address) = @_;
+
+ # look, if we already know this connection
+ my ($connection, $a);
+ my $known_to_us = 0;
+ for ($a = 0; $a <= $#seen; $a++) {
+ $connection = $seen[$a];
+ # the lc() works not exact, because irc uses another charset
+ if ($connection->{server} eq $server->{address} and $connection->{port} eq $server->{port} and lc($connection->{nick}) eq lc($nick)) {
+ $known_to_us = 1;
+ # mark as refreshed
+ $seen[$a]->{lasttime} = time();
+ last;
+ }
+ }
+
+ if ($known_to_us == 1) {
+ # all ok, return
+ return;
+ }
+
+ # now store the new connection
+ $connection = {};
+ # store our own server data here
+ $connection->{server} = $server->{address};
+ $connection->{port} = $server->{port};
+ # and the nick who queried us
+ $connection->{nick} = $nick;
+ $connection->{lasttime} = time();
+ $connection->{starttime} = time();
+ push(@seen, $connection);
+
+ $server->command("whois $nick");
+}
+
+Irssi::signal_add_first('message private', 'msg_private_first');
+Irssi::signal_add('message private', 'msg_private');
diff --git a/scripts/autoaway.pl b/scripts/autoaway.pl
new file mode 100644
index 0000000..5850360
--- /dev/null
+++ b/scripts/autoaway.pl
@@ -0,0 +1,130 @@
+# /AUTOAWAY <n> - Mark user away after <n> seconds of inactivity
+# /AWAY - play nice with autoaway
+# New, brighter, whiter version of my autoaway script. Actually works :)
+# (c) 2000 Larry Daffner (vizzie@airmail.net)
+# You may freely use, modify and distribute this script, as long as
+# 1) you leave this notice intact
+# 2) you don't pretend my code is yours
+# 3) you don't pretend your code is mine
+#
+# share and enjoy!
+
+# A simple script. /autoaway <n> will mark you as away automatically if
+# you have not typed any commands in <n> seconds. (<n>=0 disables the feature)
+# It will also automatically unmark you away the next time you type a command.
+# Note that using the /away command will disable the autoaway mechanism, as
+# well as the autoreturn. (when you unmark yourself, the autoaway wil
+# restart again)
+
+# Thanks to Adam Monsen for multiserver and config file fix
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.5";
+%IRSSI = (
+ authors => 'Larry "Vizzie" Daffner',
+ contact => 'vizzie@airmail.net',
+ name => 'Automagic away setting',
+ description => 'Automatically goes away after defined inactivity',
+ license => 'BSD',
+ url => 'http://www.flamingpackets.net/~vizzie/irssi/',
+ changed => '2018-12-02',
+);
+
+my ($autoaway_sec, $autoaway_to_tag, $autoaway_state);
+$autoaway_state = 0;
+
+#
+# /AUTOAWAY - set the autoaway timeout
+#
+sub cmd_autoaway {
+ my ($data, $server, $channel) = @_;
+
+ if (!($data =~ /^[0-9]+$/)) {
+ Irssi::print("autoaway: usage: /autoaway <seconds>");
+ return 1;
+ }
+
+ $autoaway_sec = $data;
+
+ if ($autoaway_sec) {
+ Irssi::settings_set_int("autoaway_timeout", $autoaway_sec);
+ Irssi::print("autoaway timeout set to $autoaway_sec seconds");
+ } else {
+ Irssi::print("autoway disabled");
+ }
+
+ if (defined($autoaway_to_tag)) {
+ Irssi::timeout_remove($autoaway_to_tag);
+ $autoaway_to_tag = undef;
+ }
+
+ if ($autoaway_sec) {
+ $autoaway_to_tag =
+ Irssi::timeout_add($autoaway_sec*1000, "auto_timeout", "");
+ }
+}
+
+#
+# away = Set us away or back, within the autoaway system
+sub cmd_away {
+ my ($data, $server, $channel) = @_;
+
+ if ($data eq "") {
+ $autoaway_state = 0;
+ } else {
+ if ($autoaway_state eq 0) {
+ Irssi::timeout_remove($autoaway_to_tag);
+ $autoaway_to_tag = undef;
+ $autoaway_state = 2;
+ }
+ }
+}
+
+sub auto_timeout {
+ my ($data, $server) = @_;
+
+ # we're in the process.. don't touch anything.
+ $autoaway_state = 3;
+ foreach my $server (Irssi::servers()) {
+ $server->command("/AWAY autoaway after $autoaway_sec seconds");
+ }
+
+ Irssi::timeout_remove($autoaway_to_tag);
+ $autoaway_state = 1;
+}
+
+sub reset_timer {
+ if ($autoaway_state eq 1) {
+ $autoaway_state = 3;
+ foreach my $server (Irssi::servers()) {
+ $server->command("/AWAY");
+ }
+
+ $autoaway_state = 0;
+ }
+ if ($autoaway_state eq 0) {
+ if (defined($autoaway_to_tag)) {
+ Irssi::timeout_remove($autoaway_to_tag);
+ $autoaway_to_tag = undef();
+ }
+ if ($autoaway_sec) {
+ $autoaway_to_tag = Irssi::timeout_add($autoaway_sec*1000
+ , "auto_timeout", "");
+ }
+ }
+}
+
+Irssi::settings_add_int("misc", "autoaway_timeout", 0);
+
+$autoaway_sec = Irssi::settings_get_int("autoaway_timeout");
+reset_timer();
+
+Irssi::command_bind('autoaway', 'cmd_autoaway');
+Irssi::command_bind('away', 'cmd_away');
+Irssi::signal_add('send command', 'reset_timer');
+
+# vim:set expandtab ts=2 sw=2:
diff --git a/scripts/autochannel.pl b/scripts/autochannel.pl
new file mode 100644
index 0000000..43a15cf
--- /dev/null
+++ b/scripts/autochannel.pl
@@ -0,0 +1,69 @@
+#
+# Copyright (C) 2007-2021 by Peder Stray <peder.stray@gmail.com>
+#
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+
+use vars qw{$VERSION %IRSSI};
+($VERSION) = ' $Revision: 1.3.1 $ ' =~ / (\d+(\.\d+)+) /;
+%IRSSI = (
+ name => 'autochannel',
+ authors => 'Peder Stray',
+ contact => 'peder.stray@gmail.com',
+ url => 'https://github.com/pstray/irssi-autochannel',
+ license => 'GPL',
+ description => 'Auto add channels to channel list on join',
+ );
+
+# "channel joined", channel
+sub sig_channel_joined {
+ my($c) = @_;
+
+ my $server = $c->{server};
+ my $channel = $c->{name};
+
+ return unless $server->{chatnet};
+ return unless Irssi::settings_get_bool('channel_add_on_join');
+
+ Irssi::command(sprintf "channel add %s %s %s",
+ Irssi::settings_get_bool('channel_add_with_auto')
+ ? '-auto' : '',
+ $channel,
+ $server->{chatnet},
+ );
+}
+
+# "message part", SERVER_REC, char *channel, char *nick, char *address, char *reason
+sub sig_message_part {
+ my($server,$channel,$nick,$addr,$reason) = @_;
+
+ return unless $nick eq $server->{nick};
+ return unless $server->{chatnet};
+ return unless
+ Irssi::settings_get_bool('channel_remove_on_part') ||
+ Irssi::settings_get_bool('channel_remove_auto_on_part');
+
+ if (Irssi::settings_get_bool('channel_remove_on_part')) {
+ Irssi::command(sprintf "channel remove %s %s",
+ $channel,
+ $server->{chatnet},
+ );
+ }
+ elsif (Irssi::settings_get_bool('channel_remove_auto_on_part')) {
+ Irssi::command(sprintf "channel add %s %s %s",
+ '-noauto',
+ $channel,
+ $server->{chatnet},
+ );
+ }
+}
+
+Irssi::settings_add_bool('autochannel', 'channel_add_on_join', 1);
+Irssi::settings_add_bool('autochannel', 'channel_add_with_auto', 1);
+Irssi::settings_add_bool('autochannel', 'channel_remove_auto_on_part', 1);
+Irssi::settings_add_bool('autochannel', 'channel_remove_on_part', 0);
+
+Irssi::signal_add_last('channel joined', 'sig_channel_joined');
+Irssi::signal_add_last('message part', 'sig_message_part');
diff --git a/scripts/autocycle.pl b/scripts/autocycle.pl
new file mode 100644
index 0000000..3095470
--- /dev/null
+++ b/scripts/autocycle.pl
@@ -0,0 +1,47 @@
+# Usage: /SET auto_regain_ops [On/Off]
+# /autocycle
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi 20020313 qw( settings_add_bool settings_get_bool servers command_bind timeout_add );
+$VERSION = "0.4";
+%IRSSI = (
+ authors => "Marcin Rozycki",
+ contact => "derwan\@irssi.pl",
+ name => "autocycle",
+ description => "Auto regain ops in empty opless channels",
+ url => "http://derwan.irssi.pl",
+ license => "GNU GPL v2",
+ changed => "Fri Jan 3 23:20:06 CET 2003"
+);
+
+sub check_channels {
+ foreach my $server (servers) {
+ if ($server->{usermode} !~ m/r/ and my @channels = $server->channels) {
+ CHANNEL: while (my $channel = shift @channels) {
+ my $modes = $channel->{mode};
+ my $test = ($modes and $modes =~ m/a/) ? 1 : 0;
+ if (!$test && $channel->{synced} && $channel->{name} !~ m/^[\+\!]/ && !$channel->{ownnick}->{op}) {
+ foreach my $nick ($channel->nicks) {
+ ($nick->{nick} eq $server->{nick}) or goto CHANNEL;
+ }
+ $channel->print("Auto regain op in empty channel " . $channel->{name});
+ $channel->command("cycle");
+ }
+ }
+ }
+ }
+}
+
+sub autocycle {
+ if (settings_get_bool("auto_regain_ops")) {
+ check_channels();
+ }
+}
+
+settings_add_bool "misc", "auto_regain_ops", 1;
+command_bind "autocycle", "check_channels";
+timeout_add 60000, \&autocycle, undef;
+autocycle;
+
diff --git a/scripts/autolimit.pl b/scripts/autolimit.pl
new file mode 100644
index 0000000..d77666c
--- /dev/null
+++ b/scripts/autolimit.pl
@@ -0,0 +1,53 @@
+use strict;
+use Irssi 20010920.0000 ();
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.01";
+%IRSSI = (
+ authors => 'David Leadbeater',
+ contact => 'dgl@dgl.cx',
+ name => 'autolimit',
+ description => 'does an autolimit for a channel',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.dgl.cx/',
+);
+
+my $sname=$IRSSI{name};
+my $channel;
+my $offset;
+my $tolerence;
+my $time;
+my $timeouttag;
+
+sub sig_setup_changed {
+ $channel=Irssi::settings_get_str($sname.'_channel');
+ $offset=Irssi::settings_get_int($sname.'_offset');
+ $tolerence=Irssi::settings_get_int($sname.'_tolerence');
+ $time=Irssi::settings_get_int($sname.'_time');
+ if (defined $timeouttag) {
+ Irssi::timeout_remove($timeouttag);
+ }
+ $timeouttag = Irssi::timeout_add($time * 1000, 'checklimit','');
+}
+
+sub checklimit {
+ my $c = Irssi::channel_find($channel);
+ return unless ref $c;
+ return unless $c->{chanop};
+ my $users = scalar @{[$c->nicks]};
+
+ if(($c->{limit} <= ($users+$offset-$tolerence)) ||
+ ($c->{limit} > ($users+$offset+$tolerence))) {
+ $c->{server}->send_raw("MODE $channel +l " . ($users+$offset));
+ }
+}
+
+Irssi::signal_add('setup changed', \&sig_setup_changed);
+
+Irssi::settings_add_str($sname, $sname.'_channel', "#channel");
+Irssi::settings_add_int($sname, $sname.'_offset', 5);
+Irssi::settings_add_int($sname, $sname.'_tolerence', 2);
+Irssi::settings_add_int($sname, $sname.'_time', 60);
+
+sig_setup_changed();
+
+# vim:set ts=3 sw=3 expandtab:
diff --git a/scripts/autoopper.pl b/scripts/autoopper.pl
new file mode 100644
index 0000000..61882f3
--- /dev/null
+++ b/scripts/autoopper.pl
@@ -0,0 +1,412 @@
+use strict;
+use Irssi;
+use POSIX;
+use Socket;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "3.7";
+%IRSSI = (
+ authors => 'Toni Salomäki',
+ name => 'autoopper',
+ contact => 'Toni@IRCNet',
+ description => 'Auto-op script with dynamic address support and random delay',
+ license => 'GNU GPLv2 or later',
+ url => 'http://vinku.dyndns.org/irssi_scripts/'
+);
+
+# This is a script to auto-op people on a certain channel (all or, represented with *).
+# Users are auto-opped on join with random delay.
+# There is a possibility to use dns aliases (for example dyndns.org) for getting the correct address.
+# The auto-op list is stored into ~/.irssi/autoop
+#
+# To get the dynamic addresses to be refreshed automatically, set value to autoop_dynamic_refresh (in hours)
+# The value will be used next time the script is loaded (at startup or manual load)
+#
+# NOTICE: the datafile is in completely different format than in 1.0 and this version cannot read it. Sorry.
+#
+
+# COMMANDS:
+#
+# autoop_show - Displays list of auto-opped hostmasks & channels
+# The current address of dynamic host is displayed in parenthesis
+#
+# autoop_add - Add new auto-op. Parameters hostmask, channel (or *) and dynamic flag
+#
+# Dynamic flag has 3 different values:
+# 0: treat host as a static ip
+# 1: treat host as an alias for dynamic ip
+# 2: treat host as an alias for dynamic ip, but do not resolve the ip (not normally needed)
+#
+# autoop_del - Remove auto-op
+#
+# autoop_save - Save auto-ops to file (done normally automatically)
+#
+# autoop_load - Load auto-ops from file (use this if you have edited the autoop -file manually)
+#
+# autoop_check - Check all channels and op people needed
+#
+# autoop_dynamic - Refresh dynamic addresses (automatically if parameter set)
+#
+# Data is stored in ~/.irssi/autoop
+# format: host channels flag
+# channels separated with comma
+# one host per line
+
+my (%oplist);
+my (@opitems);
+srand();
+
+#resolve dynamic host
+sub resolve_host {
+ my ($host, $dyntype) = @_;
+
+ if (my $iaddr = inet_aton($host)) {
+ if ($dyntype ne "2") {
+ if (my $newhost = gethostbyaddr($iaddr, AF_INET)) {
+ return $newhost;
+ } else {
+ return inet_ntoa($iaddr);
+ }
+ } else {
+ return inet_ntoa($iaddr);
+ }
+ }
+ return "error";
+}
+
+# return list of dynamic hosts with real addresses
+sub fetch_dynamic_hosts {
+ my %hostcache;
+ my $resultext;
+ foreach my $item (@opitems) {
+ next if ($item->{dynamic} ne "1" && $item->{dynamic} ne "2");
+
+ my (undef, $host) = split(/\@/, $item->{mask}, 2);
+
+ # fetch the host's real address (if not cached)
+ unless ($hostcache{$host}) {
+ $hostcache{$host} = resolve_host($host, $item->{dynamic});
+ $resultext .= $host . "\t" . $hostcache{$host} . "\n";
+ }
+ }
+ chomp $resultext;
+ return $resultext;
+}
+
+# fetch real addresses for dynamic hosts
+sub cmd_change_dynamic_hosts {
+ pipe READ, WRITE;
+ my $pid = fork();
+
+ unless (defined($pid)) {
+ Irssi::print("Can't fork - aborting");
+ return;
+ }
+
+ if ($pid > 0) {
+ # the original process, just add a listener for pipe
+ close (WRITE);
+ Irssi::pidwait_add($pid);
+ my $target = {fh => \*READ, tag => undef};
+ $target->{tag} = Irssi::input_add(fileno(READ), INPUT_READ, \&read_dynamic_hosts, $target);
+ } else {
+ # the new process, fetch addresses and write to the pipe
+ print WRITE fetch_dynamic_hosts;
+ close (READ);
+ close (WRITE);
+ POSIX::_exit(1);
+ }
+}
+
+# get dynamic hosts from pipe and change them to users
+sub read_dynamic_hosts {
+ my $target = shift;
+ my $rh = $target->{fh};
+ my %hostcache;
+
+ while (<$rh>) {
+ chomp;
+ my ($dynhost, $realhost, undef) = split (/\t/, $_, 3);
+ $hostcache{$dynhost} = $realhost;
+ }
+
+ close($target->{fh});
+ Irssi::input_remove($target->{tag});
+
+ my $mask;
+ my $count = 0;
+ undef %oplist if (%oplist);
+
+ foreach my $item (@opitems) {
+ if ($item->{dynamic} eq "1" || $item->{dynamic} eq "2") {
+ my ($user, $host) = split(/\@/, $item->{mask}, 2);
+
+ $count++ if ($item->{dynmask} ne $hostcache{$host});
+ $item->{dynmask} = $hostcache{$host};
+ $mask = $user . "\@" . $hostcache{$host};
+ } else {
+ $mask = $item->{mask};
+ }
+
+ foreach my $channel (split (/,/,$item->{chan})) {
+ $oplist{$channel} .= "$mask ";
+ }
+ }
+ chop %oplist;
+ Irssi::print("$count dynamic hosts changed") if ($count > 0);
+}
+
+# Save data to file
+sub cmd_save_autoop {
+ my $file = Irssi::get_irssi_dir."/autoop";
+ open FILE, ">", "$file" or return;
+
+ foreach my $item (@opitems) {
+ printf FILE ("%s\t%s\t%s\n", $item->{mask}, $item->{chan}, $item->{dynamic});
+ }
+
+ close FILE;
+ Irssi::print("Auto-op list saved to $file");
+}
+
+# Load data from file
+sub cmd_load_autoop {
+ my $file = Irssi::get_irssi_dir."/autoop";
+ open FILE, "<","$file" or return;
+ undef @opitems if (@opitems);
+
+ while (<FILE>) {
+ chomp;
+ my ($mask, $chan, $dynamic, undef) = split (/\t/, $_, 4);
+ my $item = {mask=>$mask, chan=>$chan, dynamic=>$dynamic, dynmask=>undef};
+ push (@opitems, $item);
+ }
+
+ close FILE;
+ Irssi::print("Auto-op list reloaded from $file");
+ cmd_change_dynamic_hosts;
+}
+
+# Show who's being auto-opped
+sub cmd_show_autoop {
+ my %list;
+ foreach my $item (@opitems) {
+ foreach my $channel (split (/,/,$item->{chan})) {
+ $list{$channel} .= "\n" . $item->{mask};
+ $list{$channel} .= " (" . $item->{dynmask} . ")" if ($item->{dynmask});
+ }
+ }
+
+ Irssi::print("All channels:" . $list{"*"}) if (exists $list{"*"});
+ delete $list{"*"}; #this is already printed, so remove it
+ foreach my $channel (sort (keys %list)) {
+ Irssi::print("$channel:" . $list{$channel});
+ }
+}
+
+# Add new auto-op
+sub cmd_add_autoop {
+ my ($data) = @_;
+ my ($mask, $chan, $dynamic, undef) = split(" ", $data, 4);
+ my $found = 0;
+
+ if ($chan eq "" || $mask eq "" || !($mask =~ /.+!.+@.+/)) {
+ Irssi::print("Invalid hostmask. It must contain both ! and @.") if (!($mask =~ /.+!.+@.+/));
+ Irssi::print("Usage: /autoop_add <hostmask> <*|#channel> [dynflag]");
+ Irssi::print("Dynflag: 0 normal, 1 dynamic, 2 dynamic without resolving");
+ return;
+ }
+
+ foreach my $item (@opitems) {
+ next unless ($item->{mask} eq $mask);
+ $found = 1;
+ $item->{chan} .= ",$chan";
+ last;
+ }
+
+ if ($found == 0) {
+ $dynamic = "0" unless ($dynamic eq "1" || $dynamic eq "2");
+ my $item = {mask=>$mask, chan=>$chan, dynamic=>$dynamic, dynmask=>undef};
+ push (@opitems, $item);
+ }
+
+ $oplist{$chan} .= " $mask";
+
+ Irssi::print("Added auto-op: $chan: $mask");
+}
+
+# Remove autoop
+sub cmd_del_autoop {
+ my ($data) = @_;
+ my ($mask, $channel, undef) = split(" ", $data, 3);
+
+ if ($channel eq "" || $mask eq "") {
+ Irssi::print("Usage: /autoop_del <hostmask> <*|#channel>");
+ return;
+ }
+
+ my $i=0;
+ foreach my $item (@opitems) {
+ if ($item->{mask} eq $mask) {
+ if ($channel eq "*" || $item->{chan} eq $channel) {
+ splice @opitems, $i, 1;
+ Irssi::print("Removed: $mask");
+ } else {
+ my $newchan;
+ foreach my $currchan (split (/,/,$item->{chan})) {
+ if ($channel eq $currchan) {
+ Irssi::print("Removed: $channel from $mask");
+ } else {
+ $newchan .= $currchan . ",";
+ }
+ }
+ chop $newchan;
+ Irssi::print("Couldn't remove $channel from $mask") if ($item->{chan} eq $newchan);
+ $item->{chan} = $newchan;
+ }
+ last;
+ }
+ $i++;
+ }
+}
+
+# Do the actual opping
+sub do_autoop {
+ my $target = shift;
+
+ Irssi::timeout_remove($target->{tag});
+
+ # nick has to be fetched again, because $target->{nick}->{op} is not updated
+ my $nick = $target->{chan}->nick_find($target->{nick}->{nick});
+
+ # if nick is changed during delay, it will probably be lost here...
+ if ($nick->{nick} ne "") {
+ if ($nick->{host} eq $target->{nick}->{host}) {
+ $target->{chan}->command("op " . $nick->{nick}) unless ($nick->{op});
+ } else {
+ Irssi::print("Host changed for nick during delay: " . $nick->{nick});
+ }
+ }
+ undef $target;
+}
+
+# Someone joined, might be multiple person. Check if opping is needed
+sub event_massjoin {
+ my ($channel, $nicklist) = @_;
+ my @nicks = @{$nicklist};
+
+ return if (!$channel->{chanop});
+
+ my $masks = $oplist{"*"} . " " . $oplist{$channel->{name}};
+
+ foreach my $nick (@nicks) {
+ my $host = $nick->{host};
+ $host=~ s/^~//g; # remove this if you don't want to strip ~ from username (no ident)
+ next unless ($channel->{server}->masks_match($masks, $nick->{nick}, $host));
+
+ my $min_delay = Irssi::settings_get_int("autoop_min_delay");
+ my $max_delay = Irssi::settings_get_int("autoop_max_delay") - $min_delay;
+ my $delay = int(rand($max_delay)) + $min_delay;
+
+ my $target = {nick => $nick, chan => $channel, tag => undef};
+
+ $target->{tag} = Irssi::timeout_add($delay, 'do_autoop', $target);
+ }
+
+}
+
+# Check channel op status
+sub do_channel_check {
+ my $target = shift;
+
+ Irssi::timeout_remove($target->{tag});
+
+ my $channel = $target->{chan};
+ my $server = $channel->{server};
+ my $masks = $oplist{"*"} . " " . $oplist{$channel->{name}};
+ my $nicks = "";
+
+ foreach my $nick ($channel->nicks()) {
+ next if ($nick->{op});
+
+ my $host = $nick->{host};
+ $host=~ s/^~//g; # remove this if you don't want to strip ~ from username (no ident)
+
+ if ($server->masks_match($masks, $nick->{nick}, $host)) {
+ $nicks = $nicks . " " . $nick->{nick};
+ }
+ }
+ $channel->command("op" . $nicks) unless ($nicks eq "");
+
+ undef $target;
+}
+
+#check people needing opping after getting ops
+sub event_nickmodechange {
+ my ($channel, $nick, $setby, $mode, $type) = @_;
+
+ return unless (($mode eq '@') && ($type eq '+'));
+
+ my $server = $channel->{server};
+
+ return unless ($server->{nick} eq $nick->{nick});
+
+ my $min_delay = Irssi::settings_get_int("autoop_min_delay");
+ my $max_delay = Irssi::settings_get_int("autoop_max_delay") - $min_delay;
+ my $delay = int(rand($max_delay)) + $min_delay;
+
+ my $target = {chan => $channel, tag => undef};
+
+ $target->{tag} = Irssi::timeout_add($delay, 'do_channel_check', $target);
+}
+
+#Check all channels / all users if someone needs to be opped
+sub cmd_autoop_check {
+ my ($data, $server, $witem) = @_;
+
+ foreach my $channel ($server->channels()) {
+ Irssi::print("Checking: " . $channel->{name});
+ next if (!$channel->{chanop});
+
+ my $masks = $oplist{"*"} . " " . $oplist{$channel->{name}};
+
+ foreach my $nick ($channel->nicks()) {
+ next if ($nick->{op});
+
+ my $host = $nick->{host};
+ $host=~ s/^~//g; # remove this if you don't want to strip ~ from username (no ident)
+
+ if ($server->masks_match($masks, $nick->{nick}, $host)) {
+ $channel->command("op " . $nick->{nick}) if (!$nick->{op});
+ }
+ }
+ }
+}
+
+#Set dynamic refresh period.
+sub set_dynamic_refresh {
+ my $refresh = Irssi::settings_get_int("autoop_dynamic_refresh");
+ return if ($refresh == 0);
+
+ Irssi::print("Dynamic host refresh set for $refresh hours");
+ Irssi::timeout_add($refresh*3600000, 'cmd_change_dynamic_hosts', undef);
+}
+
+Irssi::command_bind('autoop_show', 'cmd_show_autoop');
+Irssi::command_bind('autoop_add', 'cmd_add_autoop');
+Irssi::command_bind('autoop_del', 'cmd_del_autoop');
+Irssi::command_bind('autoop_save', 'cmd_save_autoop');
+Irssi::command_bind('autoop_load', 'cmd_load_autoop');
+Irssi::command_bind('autoop_check', 'cmd_autoop_check');
+Irssi::command_bind('autoop_dynamic', 'cmd_change_dynamic_hosts');
+Irssi::signal_add_last('massjoin', 'event_massjoin');
+Irssi::signal_add_last('setup saved', 'cmd_save_autoop');
+Irssi::signal_add_last('setup reread', 'cmd_load_autoop');
+Irssi::signal_add_last("nick mode changed", "event_nickmodechange");
+Irssi::settings_add_int('autoop', 'autoop_max_delay', 15000);
+Irssi::settings_add_int('autoop', 'autoop_min_delay', 1000);
+Irssi::settings_add_int('autoop', 'autoop_dynamic_refresh', 0);
+
+
+cmd_load_autoop;
+set_dynamic_refresh;
diff --git a/scripts/autorealname.pl b/scripts/autorealname.pl
new file mode 100644
index 0000000..33103e6
--- /dev/null
+++ b/scripts/autorealname.pl
@@ -0,0 +1,304 @@
+# Print realname of everyone who join to channels
+# for irssi 0.7.99 by Timo Sirainen
+
+use Irssi 20011207;
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.8.7";
+%IRSSI = (
+ authors => "Timo \'cras\' Sirainen, Bastian Blank",
+ contact => "tss\@iki.fi, waldi\@debian.org",
+ name => "auto realname",
+ description => "Print realname of everyone who join to channels",
+ license => "GPLv2 or later",
+ url => "http://irssi.org/",
+ changed => "2021-01-16"
+);
+
+# v0.8.7 changes - bw1
+# - fix Can't call method "nick_find" ... line 282.
+# v0.8.6 changes - Juhamatti Niemelä
+# - fix join msg printing when there are multiple common channels
+# v0.8.5 changes - Bastian Blank
+# - really use the introduced state variable
+# v0.8.4 changes - Bastian Blank
+# - fix queue abort
+# v0.8.3 changes - Bastian Blank
+# - on queue abort print any join messages
+# v0.8.2 changes - Bastian Blank
+# - use channelname instead of Irssi::Irc::Channel for channelname within message on join
+# v0.8.1 changes - Bastian Blank
+# - print any join messages on abort
+# - also remove any timeouts
+# v0.8 changes - Bastian Blank
+# - join message includes realname
+# - add timeout
+# - don't print realname for our self
+# - change license because german law doesn't allow to give away the copyright
+# v0.71 changes
+# - a bit safer now with using "redirect last"
+# v0.7 changes
+# - pretty much a rewrite - shouldn't break anymore
+# v0.62 changes
+# - upgraded redirection to work with latest CVS irssi - lot easier
+# to handle it this time :)
+# v0.61 changes
+# - forgot to reset %chan_list..
+# v0.6 changes
+# - works now properly when a nick joins to multiple channels
+# v0.5 changes
+# - Use "message join" so we won't ask realname for ignored people
+
+Irssi::theme_register([
+ 'join', '{channick_hilight $0} {chanhost_hilight $1} has joined {channel $2}',
+ 'join_realname', '{channick_hilight $0} ({hilight $1}) {chanhost_hilight $2} has joined {channel $3}',
+ 'join_realname_only', '{channick_hilight $0} is {hilight $1}',
+]);
+
+my $whois_queue_length_before_abort = 10; # max. whois queue length before we should abort the whois queries for next few seconds (people are probably joining behind a netsplit)
+my $whois_abort_seconds = 10; # wait for 10 secs when there's been too many joins
+my $debug = 0;
+
+my %servers;
+
+my %whois_waiting;
+my %whois_queue;
+my %aborted;
+my %chan_list;
+
+sub sig_connected {
+ my $server = shift;
+ $servers{$server->{tag}} = {
+ abort_time => 0, # if join event is received before this, abort
+ waiting => 0, # waiting reply for WHOIS request
+ queue => [], # whois queue
+ nicks => {} # nick => [ #chan1, #chan2, .. ]
+ };
+}
+
+sub sig_disconnected {
+ my $server = shift;
+ delete $servers{$server->{tag}};
+}
+
+sub msg_join {
+ my ($server, $channame, $nick, $host) = @_;
+ $channame =~ s/^://;
+ my $rec = $servers{$server->{tag}};
+
+ # don't display realname for our self
+ return if ($nick eq $server->{nick});
+
+ # don't whois people who netjoin back
+ return if ($server->netsplit_find($nick, $host));
+
+ return if (time < $rec->{abort_time});
+ $rec->{abort_time} = 0;
+
+ Irssi::signal_stop();
+
+ # check if the nick is already found from another channel
+ {
+ my $ret = 0;
+ foreach my $channel ($server->channels()) {
+ my $nickrec = $channel->nick_find($nick);
+ if ($nickrec && $nickrec->{realname}) {
+ # this user already has a known realname - use it.
+ $channel = $server->channel_find($channame);
+ $channel->printformat(MSGLEVEL_JOINS, 'join_realname', $nick, $nickrec->{realname}, $nickrec->{host}, $channel->{name});
+ $channel->print("autorealname: already found: $nick", MSGLEVEL_CLIENTCRAP) if $debug;
+ $ret = 1;
+ last;
+ }
+ }
+
+ return if ($ret);
+ }
+
+ # save channel to nick specific hash so we can later check which channels
+ # it needs to print the realname
+
+ if ($rec->{nicks}->{$nick}) {
+ # don't send the WHOIS again if nick is already in queue
+ push @{$rec->{nicks}->{$nick}->{chans_join}}, $channame;
+ push @{$rec->{nicks}->{$nick}->{chans_realname}}, $channame;
+ $rec->{nicks}->{$nick}->{state} = 0;
+ my $channel = $server->channel_find($channame);
+ $channel->print("autorealname: already in queue: $nick", MSGLEVEL_CLIENTCRAP) if $debug;
+ }
+ else {
+ $rec->{nicks}->{$nick} = {};
+ $rec->{nicks}->{$nick}->{chans_join} = [$channame];
+ $rec->{nicks}->{$nick}->{chans_realname} = [$channame];
+ $rec->{nicks}->{$nick}->{state} = 0;
+
+ # add the nick to queue
+ push @{$rec->{queue}}, $nick;
+
+ # timeout
+ $rec->{nicks}->{$nick}->{timeout} = Irssi::timeout_add(1000, \&timeout_whois, [$server, $nick]);
+ my $channel = $server->channel_find($channame);
+ $channel->print("autorealname: add to queue: $nick", MSGLEVEL_CLIENTCRAP) if $debug;
+ }
+
+ if (scalar @{$rec->{queue}} >= $whois_queue_length_before_abort) {
+ # too many whois requests in queue, abort
+ foreach $nick (@{$rec->{queue}}) {
+ foreach my $channel (@{$rec->{nicks}->{$nick}->{chans_join}}) {
+ my $chanrec = $server->channel_find($channel);
+ my $nickrec = $chanrec->nick_find($nick);
+ if ($chanrec && $nickrec) {
+ $chanrec->printformat(MSGLEVEL_JOINS, 'join', $nick, $nickrec->{host}, $channel);
+ $chanrec->print("autorealname: queue abort: $nick", MSGLEVEL_CLIENTCRAP) if $debug;
+ }
+ }
+ Irssi::timeout_remove($rec->{nicks}->{$nick}->{timeout}) if (!($rec->{nicks}->{$nick}->{state} & 2));
+ delete $rec->{nicks}->{$nick};
+ }
+ $rec->{queue} = [];
+ $rec->{abort_time} = time+$whois_abort_seconds;
+ return;
+ }
+
+ # waiting for WHOIS reply..
+ return if $rec->{waiting};
+
+ request_whois($server, $rec);
+}
+
+sub request_whois {
+ my ($server, $rec) = @_;
+ return if (scalar @{$rec->{queue}} == 0);
+
+ my @whois_nicks = splice(@{$rec->{queue}}, 0, $server->{max_whois_in_cmd});
+ my $whois_query = join(',', @whois_nicks);
+
+ # ignore all whois replies except the first line of the WHOIS reply
+ my $redir_arg = $whois_query.' '.join(' ', @whois_nicks);
+ $server->redirect_event("whois", 1, $redir_arg, 0,
+ "redir autorealname_whois_last", {
+ "event 311" => "redir autorealname_whois",
+ "event 401" => "redir autorealname_whois_unknown",
+ "redirect last" => "redir autorealname_whois_last",
+ "" => "event empty" });
+
+ $server->send_raw("WHOIS :$whois_query");
+ $rec->{waiting} = 1;
+}
+
+sub event_whois {
+ my ($server, $data) = @_;
+ my ($num, $nick, $user, $host, $empty, $realname) = split(/ +/, $data, 6);
+ $realname =~ s/^://;
+ my $rec = $servers{$server->{tag}};
+
+ return if not $rec->{nicks}->{$nick};
+
+ $rec->{nicks}->{$nick}->{state} |= 1;
+
+ if (!($rec->{nicks}->{$nick}->{state} & 2)) {
+ Irssi::timeout_remove($rec->{nicks}->{$nick}->{timeout});
+ foreach my $channel (@{$rec->{nicks}->{$nick}->{chans_join}}) {
+ my $chanrec = $server->channel_find($channel);
+ my $nickrec = $chanrec->nick_find($nick);
+ if ($chanrec && $nickrec) {
+ $chanrec->printformat(MSGLEVEL_JOINS, 'join_realname', $nick, $realname, $nickrec->{host}, $channel);
+ $chanrec->print("autorealname: got whois: $nick, state: ".$rec->{nicks}->{$nick}->{state}, MSGLEVEL_CLIENTCRAP) if $debug;
+ }
+ }
+ $rec->{nicks}->{$nick}->{chans_join} = [];
+ $rec->{nicks}->{$nick}->{chans_realname} = [];
+ $rec->{nicks}->{$nick}->{state} |= 2;
+ }
+ else {
+ foreach my $channel (@{$rec->{nicks}->{$nick}->{chans_realname}}) {
+ my $chanrec = $server->channel_find($channel);
+ next unless (defined $chanrec);
+ my $nickrec = $chanrec->nick_find($nick);
+ if ($chanrec && $nickrec) {
+ $chanrec->printformat(MSGLEVEL_JOINS, 'join_realname_only', $nick, $realname);
+ $chanrec->print("autorealname: got whois: $nick, state: ".$rec->{nicks}->{$nick}->{state}, MSGLEVEL_CLIENTCRAP) if $debug;
+ }
+ }
+ $rec->{nicks}->{$nick}->{chans_realname} = [];
+ }
+
+ delete $rec->{nicks}->{$nick} if ($rec->{nicks}->{$nick}->{state} == 3);
+}
+
+sub event_whois_unknown {
+ my ($server, $data) = @_;
+ my ($temp, $nick) = split(" ", $data);
+ my $rec = $servers{$server->{tag}};
+
+ return if not $rec->{nicks}->{$nick};
+
+ $rec->{nicks}->{$nick}->{state} |= 1;
+
+ if (!($rec->{nicks}->{$nick}->{state} & 2)) {
+ Irssi::timeout_remove($rec->{nicks}->{$nick}->{timeout});
+ foreach my $channel (@{$rec->{nicks}->{$nick}->{chans_join}}) {
+ my $chanrec = $server->channel_find($channel);
+ my $nickrec = $chanrec->nick_find($nick);
+ if ($chanrec && $nickrec) {
+ $chanrec->printformat(MSGLEVEL_JOINS, 'join', $nick, $nickrec->{host}, $channel);
+ $chanrec->print("autorealname: got unknown whois: $nick", MSGLEVEL_CLIENTCRAP) if $debug;
+ }
+ }
+ $rec->{nicks}->{$nick}->{chans_join} = [];
+ } else {
+ foreach my $channel (@{$rec->{nicks}->{$nick}->{chans_join}}) {
+ my $chanrec = $server->channel_find($channel);
+ $chanrec->print("autorealname: got unknown whois (already considered): $nick", MSGLEVEL_CLIENTCRAP) if $debug;
+ }
+ }
+
+ delete $rec->{nicks}->{$nick} if ($rec->{nicks}->{$nick}->{state} == 3);
+}
+
+sub event_whois_last {
+ my $server = shift;
+ my $rec = $servers{$server->{tag}};
+
+ $rec->{waiting} = 0;
+ request_whois($server, $rec);
+}
+
+foreach my $server (Irssi::servers()) {
+ sig_connected($server);
+}
+
+sub timeout_whois {
+ my $server = shift @{$_[0]};
+ my $nick = shift @{$_[0]};
+
+ my $rec = $servers{$server->{tag}};
+
+ return if not $rec->{nicks}->{$nick};
+
+ Irssi::timeout_remove($rec->{nicks}->{$nick}->{timeout});
+ $rec->{nicks}->{$nick}->{state} |= 2;
+
+ my @channels = @{$rec->{nicks}->{$nick}->{chans_join}};
+ foreach my $channel (@channels) {
+ my $chanrec = $server->channel_find($channel);
+ next unless (defined $chanrec);
+ my $nickrec = $chanrec->nick_find($nick);
+ if ($nickrec && $chanrec) {
+ $chanrec->printformat(MSGLEVEL_JOINS, 'join', $nick, $nickrec->{host}, $channel);
+ $chanrec->print("autorealname: timeout: $nick, state: ".$rec->{nicks}->{$nick}->{state}, MSGLEVEL_CLIENTCRAP) if $debug;
+ }
+ }
+
+ $rec->{nicks}->{$nick}->{chans_join} = [];
+}
+
+Irssi::signal_add( {
+ 'server connected' => \&sig_connected,
+ 'server disconnected' => \&sig_disconnected,
+ 'message join' => \&msg_join,
+ 'redir autorealname_whois' => \&event_whois,
+ 'redir autorealname_whois_unknown' => \&event_whois_unknown,
+ 'redir autorealname_whois_last' => \&event_whois_last });
+
+# vim:set sw=2 ts=8 et:
diff --git a/scripts/autorejoinpunish.pl b/scripts/autorejoinpunish.pl
new file mode 100644
index 0000000..31f6e68
--- /dev/null
+++ b/scripts/autorejoinpunish.pl
@@ -0,0 +1,124 @@
+##
+# autorejoinpunish - your solution for banning people who don't
+# know what kicks are for.
+# This script is for irssi 0.8.4, and was written by Paul Raade,
+# laaama in IRCNet.
+##
+# Explanations for the settings, with defaults shown:
+#
+# /set autorejoinpunish_time_limit 3
+# - The time limit in seconds for measuring what is an
+# autorejoin, and what is not.
+# /set autorejoinpunish_kickban_message Kickban for autorejoining.
+# - Kick reason, if kickban was selected.
+# /set autorejoinpunish_knockout ON
+# - Whether kick or knockout. As default, knockout is
+# selected, so that the bans will be removed automatically.
+# /set autorejoinpunish_knockout_time 60
+# - Time in seconds how long a ban will be kept if
+# knockout is selected.
+# /set autorejoinpunish_knockout_message Temporary ban for autorejoining.
+# - Kick reason, if knockout was selected.
+# /set autorejoinpunish_channels
+# - Space separated list of channels on which autorejoin punishment
+# be used will
+# /set autorejoinpunish_only_own_kicks ON
+# - If set ON, only people kicked by you will be banned.
+##
+# Changelog:
+# - 0.2: Better way of checking channels, /set autorejoinpunish_only_own_kicks added.
+# - 0.1: Initial release.
+##
+# Happy banning! ;)
+##
+
+use strict;
+use Irssi qw(settings_get_str settings_get_int settings_get_bool
+timeout_add settings_add_int settings_add_str settings_add_bool
+signal_add_first command server_find_tag);
+
+use vars qw(%IRSSI $VERSION);
+$VERSION = '0.3';
+%IRSSI = (
+ authors => 'Paul \'laaama\' Raade',
+ contact => 'paul\@raade.org',
+ name => 'Autorejoin punisher',
+ description => 'Kickbans or knockouts people who use autorejoin on kick.',
+ license => 'BSD',
+ url => 'http://www.raade.org/~paul/irssi/scripts/',
+ changes => 'Changed signals to be added to the top of the list to make the script work with scripts that stop the signals (autorealname, for example).',
+ changed => 'Thu 02 May 2002, 22:04:48 EEST'
+);
+
+my %victims;
+my %bans;
+
+sub message_kick { # Set a time stamp for people who are kicked.
+ # "message kick", SERVER_REC, char *channel, char *nick, char *kicker, char *address, char *reason
+ my ($server, $channel, $nick, $kicker, $address, undef) = @_;
+ if ((settings_get_bool('autorejoinpunish_only_own_kicks') == 0) || (settings_get_bool('autorejoinpunish_only_own_kicks') == 1 && ($kicker eq $server->{nick}) )) {
+ foreach my $item (split(' ', lc(settings_get_str('autorejoinpunish_channels')))) {
+ if ((lc $channel) eq $item) { $victims{$channel}{$nick} = time(); }
+ }
+ }
+}
+
+sub message_join { # Check for recent kicks,
+ # "message join", SERVER_REC, char *channel, char *nick, char *address
+ my ($server, $channel, $nick, $address) = @_;
+ if ($victims{$channel}{$nick} && ((time()-$victims{$channel}{$nick}) <= settings_get_int('autorejoinpunish_time_limit'))) {
+ if (settings_get_bool('autorejoinpunish_knockout') == 1) {
+ $server->command('mode' . ' ' . $channel . ' +b *!' . $address);
+ $server->command('kick' . ' ' . $channel . ' ' . $nick . ' ' . settings_get_str('autorejoinpunish_knockout_message'));
+ $bans{$server->{tag}}{time()} = $channel . '/' . $address;
+ } else {
+ $server->command('mode' . ' ' . $channel . ' +b *!' . $address);
+ $server->command('kick' . ' ' . $channel . ' ' . $nick . ' ' . settings_get_str('autorejoinpunish_kickban_message'));
+ }
+ }
+ delete $victims{$channel}{$nick};
+}
+
+sub clean_list {
+ my ($channelkey, $nickkey);
+ if (%victims) {
+ foreach $channelkey (keys %victims) {
+ foreach $nickkey (keys %{$victims{$channelkey}}) {
+ if ((time()-$victims{$channelkey}{$nickkey}) > settings_get_int('autorejoinpunish_time_limit')) {
+ delete $victims{$channelkey}{$nickkey};
+ }
+ }
+ }
+ }
+}
+
+sub check_bans {
+ my ($server, $timestamp);
+ if (%bans) {
+ foreach $server (keys %bans) {
+ foreach $timestamp (keys %{$bans{$server}}) {
+ if ((time()-$timestamp) > settings_get_int('autorejoinpunish_knockout_time')) {
+ my ($channel, $address) = split(/\//, $bans{$server}{$timestamp});
+ server_find_tag($server)->command('mode' . ' ' . $channel . ' -b *!' . $address);
+ delete $bans{$server}{$timestamp};
+ }
+ }
+ }
+ }
+}
+
+
+settings_add_int ('misc', 'autorejoinpunish_time_limit', '3');
+settings_add_str ('misc', 'autorejoinpunish_kickban_message', 'Kickban for autorejoining.');
+settings_add_bool ('misc', 'autorejoinpunish_knockout', '1');
+settings_add_int ('misc', 'autorejoinpunish_knockout_time', '60');
+settings_add_str ('misc', 'autorejoinpunish_knockout_message', 'Temporary ban for autorejoining.');
+settings_add_str ('misc', 'autorejoinpunish_channels', '');
+settings_add_bool ('misc', 'autorejoinpunish_only_own_kicks', '1');
+
+signal_add_first 'message join' => 'message_join';
+signal_add_first 'message kick' => 'message_kick';
+
+timeout_add ('5000', 'check_bans', '');
+timeout_add ('3600000', 'clean_list', '');
+# 1h = 60min * 60s * 1000ms = 3600000ms
diff --git a/scripts/autoreminder.pl b/scripts/autoreminder.pl
new file mode 100644
index 0000000..3548b28
--- /dev/null
+++ b/scripts/autoreminder.pl
@@ -0,0 +1,147 @@
+#####################
+#
+# irssi autoreminder script.
+# Copyright (C) Terry Lewis
+# Terry Lewis <mrkennie@kryogenic.co.uk>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+#####################
+#
+# Auto reminder script for irssi
+# This is really a first attempt at an irssi script,
+# really more of a hack I suppose, to auto remind
+# someone at certain intervals.
+# It will not remind at every interval defined, so its
+# kinda less annoying, but hopefully effective.
+#
+# To start:
+# /start <nick> <"reminder message"> [interval]
+# (<> = required, [] = optional)
+# reminder Message must use "" parenthasis.
+#
+# to stop reminding use /stop
+#
+# I know the code is not fantastic but I will appreciate
+# any patches for improvements, just mail them to me if
+# you do improve it :)
+#
+# I use a rather nice script called cron.pl by Piotr
+# Krukowiecki which I found at http://www.irssi.org/scripts/
+# so I can start and stop the script at certain times.
+# I hope someone finds this useful, Enjoy =)
+#
+#####################
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+$VERSION = '0.01';
+%IRSSI = (
+ authors => 'Terry Lewis',
+ contact => 'terry@kryogenic.co.uk',
+ name => 'Auto Reminder',
+ description => 'This script ' .
+ 'Reminds people ' .
+ 'to do stuff! :)',
+ license => 'GPLv2',
+);
+
+my($timeout_tag, $timeout, $state, @opts, $date, @time, @hour, $start_hour, $end_hour);
+
+
+#default state 0 meaning we are not started yet
+$state = 0;
+
+
+# /start <nick> <"message"> [interval]
+sub cmd_start {
+ if($state != 1){
+ my($data,$server,$channel) = @_;
+ @opts = split(/\s\B\"(.*)\b\"/, $data);
+
+ if($opts[0] ne ''){
+ if($opts[1] ne ''){
+ if($opts[0] =~ /\s/g){
+ Irssi::print("Invalid username");
+ }elsif($opts[1] eq ''){
+ Irssi::print("You must type a message to send");
+ }else{
+
+ $state = 1;
+
+ if($opts[2] =~ /[0-9]/g){
+ $opts[2] =~ s/\s//g;
+ $timeout = $opts[2];
+ timeout_init($timeout);
+ }else{
+ Irssi::print("Invalid interval value, using defaults (15mins)") unless $opts[2] eq '';
+ $timeout = "900000";
+ timeout_init($timeout);
+ }
+ Irssi::print "Bugging $opts[0] with message \"$opts[1]\" every \"$timeout ms\"";
+ }
+ }else{
+ Irssi::print ("Usage: /start nick \"bug_msg\" [interval] (interval is optional)");
+ }
+ }else{
+ Irssi::print ("Usage: /start nick \"bug_msg\" [interval] (interval is optional)");
+ }
+
+ }else{
+ Irssi::print "Already started";
+ }
+}
+
+# /stop
+sub cmd_stop {
+ if($state == 1){
+ $state = 0;
+ Irssi::print "No longer bugging $opts[0]";
+ Irssi::timeout_remove($timeout_tag);
+ $timeout_tag = undef;
+ }else{
+ Irssi::print "Not started";
+ }
+}
+
+sub timeout_init {
+ if($state == 1){
+
+ Irssi::timeout_remove($timeout_tag);
+ $timeout_tag = undef;
+ $timeout_tag = Irssi::timeout_add($timeout, "remind_them", "");
+ }
+}
+
+sub remind_them {
+ if($state == 1){
+ my (@servers) = Irssi::servers();
+
+ # make it random, so we dont remind at every defined interval
+ my $time = rand()*3;
+
+ if($time < 1){
+ $servers[0]->command("MSG $opts[0] Hi, this is an automated reminder, $opts[1]");
+ }
+ timeout_init($timeout);
+ }
+}
+
+
+Irssi::command_bind('start', \&cmd_start);
+Irssi::command_bind('stop', \&cmd_stop);
+
diff --git a/scripts/autoversion.pl b/scripts/autoversion.pl
new file mode 100644
index 0000000..47d4475
--- /dev/null
+++ b/scripts/autoversion.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.0.1";
+%IRSSI = (
+ authors => "Christian 'mordeth' Weber",
+ contact => "chris\@mac.ruhr.de",
+ name => "autoversion",
+ description => "Auto-CTCP Verison on every joining nick",
+ license => "GPLv2",
+ url => "",
+ changed => "20020821",
+ modules => ""
+);
+
+sub event_message_join ($$$$) {
+ my ($server, $channel, $nick, $address) = @_;
+ if (lc($channel) eq lc(Irssi::active_win()->{active}->{name})) {
+ $server->command("ctcp $nick VERSION");
+ };
+}
+
+Irssi::signal_add('message join', 'event_message_join');
+
diff --git a/scripts/autovoice.pl b/scripts/autovoice.pl
new file mode 100644
index 0000000..168371c
--- /dev/null
+++ b/scripts/autovoice.pl
@@ -0,0 +1,684 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+BEGIN {
+ unless (exists $::{"Irssi::"}) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage(-verbose => 2);
+ }
+}
+
+use Irssi;
+our $VERSION = '0.06';
+our %IRSSI = (
+ authors => 'aluser',
+ name => 'autovoice',
+ description => 'autovoice',
+ license => 'GPL',
+ );
+
+our %bad;
+
+=head1 SYNOPSIS
+
+ /script load autovoice
+ /autovoice add #somechannel
+Idle on #somechannel as [half]op, and you will voice people :)
+
+=head1 MOTIVATION
+
+This is certainly not a new concept, but I dislike many implementations of autovoicing because they are not as intelligent as they could be. Blindly voicing everyone who joins your channel is dumb, because it removes the protection that +m is supposed to give you. A troublemake need merely to rejoin the channel to get his voice back. You probably want to voice newcomers to your channel, so a password or hostmask system is no good. Besides, it's intuitive that anybody leaving the channel without voice and quickly rejoining is trying to leverage your autovoicer! So, the main purpose of this script is to automatically detect these people and not voice them.
+
+The other important feature is fine-grained control over where you voice people. You might want to autovoice in efnet #foo but not in dalnet #foo. The C</autovoice add> command gives you C<-server> and C<-ircnet> options to control on which channels you will autovoice, even if the channels have identical names.
+
+I still consider this script to be lightly tested, but I do hope that it is well documented enough that it can be debugged well.
+
+=head1 INSTALL
+
+Just place this script in F<~/.irssi/scripts>. To have it load automatically when you start Irssi, do this:
+
+ mkdir -p ~/.irssi/scripts/autorun
+ ln -s ../autovoice.pl ~/.irssi/scripts/autorun/
+
+If you haven't figured it out yet, you can run the script outside of Irssi to get a man page type document, like this:
+
+ chmod +x autovoice.pl
+ ./autovoice.pl
+
+=head1 COMMANDS
+
+=over
+
+=item I</autovoice add>
+
+This is a helper to add channels to L<autovoice_channels> for you.
+I'm going to explain this by example:
+
+ /autovoice add #channelfoo
+ /autovoice add -server irc.foo.com #barbarfoo
+ /autovoice add -ircnet EFNet #perlhelp
+ /autovoice add -server irc.efnet.org -ircnet Undernet #irssi
+
+Note that the last example actually adds two "channels" to the setting, both named #irssi. The channel will be valid on Undernet or the server irc.efnet.org.
+
+=item I</autovoice remove>
+
+This is a helper to remove channels from L<autovoice_channels> for you.
+Example:
+
+ /autovoice remove #somechannel
+ /autovoice remove #channel1 #channel2
+
+=item I</autovoice dump>
+
+Mostly for debugging, this dumps the perl hash containing blacklisted nicks to your screen.
+
+=item I</autovoice flush>
+
+Flush the blacklists.
+
+=back
+
+=head1 SETTINGS
+
+=over
+
+=item bool I<autovoice> = ON
+
+Set autovoicing on or off.
+
+=item string I<autovoice_channels> =
+
+Control which channels we will autovoice. The simplest form is
+
+ #channel1 , #channel2 , #channel3
+
+Space before the commas is mandatory; after is optional. For any channel in the list, you may specify a chatnet or a server like this:
+
+ #channel1 , #channel2 =>SOMECHATNET , #channel3 @some.server.com
+
+Space after the channels and before the C<< => >> or C<@> is required. Space after the C<< => >> or C<@> is optional. (not shown)
+
+See L</autovoice add> and L</autovoice remove> for wrappers to this.
+
+=item int I<autovoice_cycletime> = 600
+
+Control the amount of time, in seconds, for which we remember that a nick left a channel without voice.
+
+=item bool I<autovoice_voice_ops> = OFF
+
+Whether or not to give voice to people who already have op or halfop
+
+=item bool I<autovoice_use_ident> = OFF
+
+Whether to distinguish between nicks which have the same host but different user names. (nick![ident@host] vs nick!ident@[host])
+
+=back
+
+=cut
+
+
+=head1 BUGS
+
+Plenty.
+
+=over
+
+=item
+
+&add will add duplicate channels
+
+=item
+
+Error checking in &add is weak.
+
+=item
+
+Setting L<autovoice_use_ident> causes the existing blacklists to be ineffective.
+
+=item
+
+C<parse_channels> and C<deparse_channels> mix up the ordering of the channels in the autovoice_channels setting. This is a property of the hash used to represent the setting.
+
+=item
+
+remove doesn't let you remove only one channel when several use the same name.
+
+=item
+
+Setting L<autovoice_cycletime> does not change the timing for entries already in the badlist, only for entries made after the setting is changed. As far as I can tell, the alternatives are to A) Have a potentially ever-growing %bad, or B) to run a cleanup on a timer which must traverse all of %bad.
+
+=back
+
+=cut
+
+
+=head1 HACKING
+
+This section is for people interested in tweaking/fixing/improving/developing/hacking this script. It describes every subroutine and data structure in the script. If you do not know Perl you should stop reading here.
+
+Variables ending in C<_rec> are Irssi objects of some sort. I also use C<_text> to indicate normal strings.
+
+=head2 DATA STRUCTURES
+
+=over
+
+=item %bad
+
+This hash holds the badlists for all channels. Each key is a tag as supplied by C<$server_rec->{tag}>. Each value is a hash reference as follows:
+
+Each key is a lowercased channel name as given by C<< lc $channel_rec->{name} >> . Each value is a hash referenc described as follows:
+
+Each key is a lowercased host. If the host was marked bad while autovoice_use_ident was set, it is in the form "username@host.com". If not, it is just "host.com". Each value is a tag as returned by C<Irssi::timeout_add>. This is used to remove the callback which is planning to remove the entry from the badlist after autovoice_cycletime expires.
+
+=item %commands
+
+This hash holds the commands invoked as C<< /autovoice <command> [ arg1 arg2 ... ] >>. Each key is the lowercased name of a command, and each value is a reference to a subroutine. The subroutine should expect an Irssi Server object, a WindowItem object, and a list of user supplied arguments. The case of the arguments is left as supplied by the user.
+
+=back
+
+=cut
+
+=head2 SUBROUTINES
+
+=over
+
+=item I<massjoin($channel_rec, $nicks_ray)>
+
+The nicks in the array referenced by $nicks_ray are joining $channel_rec. This is an irssi signal handler.
+
+=cut
+
+sub massjoin {
+ my ($channel_rec, $nicks_ray) = @_;
+ voicem($channel_rec, @$nicks_ray);
+}
+
+=item I<message_part($server_rec, $channel_text, $nick_text, $addr, $reason)>
+
+A nick is parting a channel. $addr and $reason are not used. This is an irssi signal handler.
+
+=cut
+
+sub message_part {
+ my ($server_rec, $channel_text, $nick_text) = @_;
+ #Irssi::print("chan: $channel_text, nick: $nick_text");
+ #return unless defined $nick_text; # happens if the part was us
+ no warnings;
+ my $channel_rec = $server_rec->channel_find($channel_text);
+ use warnings;
+ return unless defined $channel_rec;
+ my $nick_rec = $channel_rec->nick_find($nick_text);
+ partem($channel_rec, $nick_rec);
+}
+
+=item I<message_quit($server_rec, $nick_text, $addr, $reason)>
+
+A nick is quiting the server. $addr and $reason are not used. This is an irssi signal handler.
+
+=cut
+
+sub message_quit {
+ my ($server_rec, $nick_text, $addr, $reason) = @_;
+ my $chanstring = $server_rec->get_channels();
+ $chanstring =~ s/ .*//; #strip channel keys
+ my @channels_text = split /,/, $chanstring;
+ no warnings;
+ my @channels_rec =
+ map { $server_rec->channel_find($_) } @channels_text;
+ use warnings;
+ for (@channels_rec) {
+ my $nick_rec = $_->nick_find($nick_text);
+ if (defined $nick_rec) {
+ partem($_, $nick_rec);
+ }
+ }
+}
+
+=item I<message_kick($server_rec, $channel_text, $nick_text, $addr, $reason)>
+
+Called when a nick is kicked from a channel. This is an Irssi signal handler.
+
+=cut
+
+sub message_kick {
+ my ($server_rec, $channel_text, $nick_text) = @_;
+ my $channel_rec = $server_rec->channel_find($channel_text);
+ return unless defined $channel_rec;
+ my $nick_rec = $channel_rec->nick_find($nick_text);
+ partem($channel_rec, $nick_rec);
+}
+
+=item I<voicem($channel_rec, @nicks)>
+
+This voices all of @nicks on $channel_rec, provided they aren't in the blacklist.
+
+=cut
+
+sub voicem {
+ my ($channel_rec, @nicks) = @_;
+ if (is_auto($channel_rec)) {
+ for my $nick_rec (@nicks) {
+ unless (is_bad($channel_rec, $nick_rec)
+ or $nick_rec->{voice}) {
+ if (get_voiceops() or
+ !($nick_rec->{op} or $nick_rec->{halfop})) {
+ my $nick_text = $nick_rec->{nick};
+ $channel_rec->command("voice $nick_text");
+ }
+ }
+ }
+ }
+}
+
+=item I<partem($channel_rec, $nick_rec)>
+
+Called when a nick is leaving a channel, by any means. This is what decides whether the nick does or does not have voice.
+
+=cut
+
+sub partem {
+ my ($channel_rec, $nick_rec) = @_;
+ #$channel_rec->print("partem called");
+ if (is_auto($channel_rec)) {
+ #$channel_rec->print("this channel is autovoiced.");
+ if (not $nick_rec->{voice} and
+ not $nick_rec->{op} and
+ not $nick_rec->{halfop}) {
+ #$channel_rec->print("nick leaving with no voice");
+ make_bad($channel_rec, $nick_rec);
+ } else {
+ make_unbad($channel_rec, $nick_rec);
+ }
+ }
+}
+
+=item I<is_bad($channel_rec, $nick_rec)>
+
+Returns 1 if $nick_rec is blacklisted on $channel_rec, 0 otherwise.
+
+=cut
+
+sub is_bad {
+ my ($channel_rec, $nick_rec) = @_;
+ my $server_tag = $channel_rec->{server}->{tag};
+ my $channel_text = lc $channel_rec->{name};
+ my $host_text = lc $nick_rec->{host};
+ if (not get_useident()) {
+ $host_text =~ s/.*?\@//;
+ }
+ #$channel_rec->print("calling is_bad {$server_tag}{$channel_text}{$host_text}");
+ return
+ exists $bad{$server_tag} &&
+ exists $bad{$server_tag}{$channel_text} &&
+ exists $bad{$server_tag}{$channel_text}{$host_text};
+}
+
+=item I<make_bad($channel_rec, $nick_rec)>
+
+Blacklist $nick_rec on $channel_rec for autovoice_cycletime seconds.
+
+=cut
+
+sub make_bad {
+ my ($channel_rec, $nick_rec) = @_;
+ my $tag = $channel_rec->{server}->{tag};
+ my $channel_text = lc $channel_rec->{name};
+ my $host_text = lc $nick_rec->{host};
+ if (not get_useident()) {
+ $host_text =~ s/.*?\@//;
+ }
+ #$channel_rec->print("channel_rec: ".ref($channel_rec)."nick_rec: ".ref($nick_rec).". make bad $tag, $channel_text, $host_text");
+ Irssi::timeout_remove($bad{$tag}{$channel_text}{$host_text})
+ if exists $bad{$tag}{$channel_text}{$host_text};
+ $bad{$tag}{$channel_text}{$host_text} =
+ Irssi::timeout_add(get_cycletime(),
+ 'timeout',
+ [ $channel_rec, $nick_rec ]);
+}
+
+=item I<timeout([$channel_rec, $nick_rec])>
+
+This is the irssi timeout callback which removes $nick_rec from the blacklist for $channel_rec when autovoice_cycletime seconds have elapsed. make_unbad finds the tag in the badlist in order to keep this from being called again. Note that it only takes one argument, an array ref
+
+=cut
+
+sub timeout {
+ my ($channel_rec, $nick_rec) = @{$_[0]};
+ #$channel_rec->print("timing out");
+ make_unbad($channel_rec, $nick_rec);
+}
+
+=item I<make_unbad($channel_rec, $nick_rec)>
+
+Remove $nick_rec from the blacklist for $channel_rec
+
+=cut
+
+sub make_unbad {
+ my ($channel_rec, $nick_rec) = @_;
+ my $tag = $channel_rec->{server}->{tag};
+ my $channel_text = lc $channel_rec->{name};
+ my $host_text = lc $nick_rec->{host};
+ if (not get_useident()) {
+ $host_text =~ s/.*\@//;
+ }
+ if (exists $bad{$tag}{$channel_text}{$host_text}) {
+ Irssi::timeout_remove($bad{$tag}{$channel_text}{$host_text});
+ delete $bad{$tag}{$channel_text}{$host_text};
+ if (not keys %{$bad{$tag}{$channel_text}}) {
+ delete $bad{$tag}{$channel_text};
+ }
+ if (not keys %{$bad{$tag}}) {
+ delete $bad{$tag};
+ }
+ }
+}
+
+=item I<parse_channels()>
+
+Examine autovoice_channels and return a hash reference. Each key is a channel name, lowercased. Each value is a hash with one to three keys, 'server', 'chatnet', and/or 'plain'. If server, it holds an array ref with all servers on which the channel is autovoice. If chatnet, it holds an array ref with all the chatnets on which the channel is autovoice. If plain, it just has the value 1.
+
+=cut
+
+sub parse_channels {
+ my $chanstring = lc Irssi::settings_get_str('autovoice_channels');
+ $chanstring =~ s/^\s+//;
+ $chanstring =~ s/\s+$//;
+ my @fields = split /\s+,\s*/, $chanstring;
+ my %hash;
+ keys %hash = scalar @fields;
+ for (@fields) {
+ if (/\s=>/) {
+ my ($channel, $chatnet) = split /\s+=>\s*/, $_, 2;
+ add_channel_to_parsed(\%hash, $channel, $chatnet, undef);
+ } elsif (/\s\@/) {
+ my ($channel, $server) = split /\s+\@\s*/, $_, 2;
+ add_channel_to_parsed(\%hash, $channel, undef, $server);
+ } else {
+ my ($channel) = /(\S+)/;
+ add_channel_to_parsed(\%hash, $channel, undef, undef);
+ }
+ }
+ return \%hash;
+}
+
+=item I<deparse_channels($hashr)>
+
+Take a hash ref like that produced by parse_channels and convert it into a string suitable for autovoice_channels
+
+=cut
+
+sub deparse_channels {
+ my $hashr = shift;
+ my @fields;
+ for my $channel (keys %$hashr) {
+ my $s = $channel;
+ push(@fields, $s) if exists $hashr->{$channel}->{plain};
+ if (exists $hashr->{$channel}->{server}) {
+ for (@{$hashr->{$channel}->{server}}) {
+ push(@fields, $s.' @ '.$_);
+ }
+ }
+ if (exists $hashr->{$channel}->{chatnet}) {
+ for (@{$hashr->{$channel}->{chatnet}}) {
+ push(@fields, $s.' => '.$_);
+ }
+ }
+ }
+ return join ' , ', @fields;
+}
+
+=item I<is_auto($channel_rec)>
+
+Returns 1 if $channel_rec is an autovoiced channel as defined by autovoice_channels, 0 otherwise.
+
+=cut
+
+sub is_auto {
+ unless (Irssi::settings_get_bool('autovoice')) {
+ return 0;
+ }
+ my $channel_rec = shift;
+ my $channel_text = lc $channel_rec->{name};
+ my $parsedchannels = parse_channels();
+ return 0 unless exists $parsedchannels->{$channel_text};
+ if (exists $parsedchannels->{$channel_text}->{plain}) {
+ return 1;
+ } elsif (exists $parsedchannels->{$channel_text}->{chatnet}) {
+ #Irssi::print("looking at chatnet @{$parsedchannels->{$channel_text}->{chatnet}}");
+ for (@{$parsedchannels->{$channel_text}->{chatnet}}) {
+ return 1 if $_ eq lc $channel_rec->{server}->{chatnet};
+ }
+ return 0;
+ } else {
+ for (@{$parsedchannels->{$channel_text}->{server}}) {
+ return 1 if $_ eq lc $channel_rec->{server}->{address};
+ }
+ return 0;
+ }
+}
+
+our %commands = (
+ dump => \&dump,
+ add => \&add,
+ remove => \&remove,
+ flush => \&flush,
+ );
+
+=item I<autovoice_cmd($data, $server, $witem)>
+
+Irssi command handler which dispatches all the /autovoice * commands. Autovoice commands are given ($server_rec, $witem, @args), where @args is the result of split ' ', $data minus the first element ("autovoice"). Note that the case of @args is not changed.
+
+=cut
+
+sub autovoice_cmd {
+ my ($data, $server, $witem) = @_;
+ my ($cmd, @args) = (split ' ', $data);
+ $cmd='' if (!defined $cmd);
+ $cmd = lc $cmd;
+ if (exists $commands{$cmd}) {
+ $commands{$cmd}->($server, $witem, @args)
+ } else {
+ Irssi::print("No such subcommand: autovoice '$cmd'");
+ }
+}
+
+=item I<dump($server_rec, $witem, @args)>
+
+Invoked as C</autovoice dump>, this C<require>s Data::Dumper and dumps the blacklist hash to the current window. @args and $server_rec are ignored.
+
+=cut
+
+sub dump {
+ require Data::Dumper;
+ my $witem = $_[1];
+ my $string = Data::Dumper->Dump([\%bad], ['bad']);
+ chomp $string;
+ if ($witem) {
+ $witem->print($string);
+ } else {
+ Irssi::print($string);
+ }
+}
+
+=item I<add($server_rec, $witem, @args)>
+
+Invoked as C</autovoice add (args)>. This adds channels to autovoice_channels. See L</autovoice add> in COMMANDS for usage.
+
+=cut
+
+sub add {
+ my ($server_rec, $witem, @args) = @_;
+ @args = map {lc} @args;
+ my $parsedchannels = parse_channels();
+ my ($server, $chatnet, $channel);
+ for (my $i = 0; $i < @args; ++$i) {
+ if ($args[$i] eq '-ircnet') {
+ if (defined $chatnet) {
+ Irssi::print("autovoice add: warning: -ircnet given twice, using the second value.");
+ }
+ $chatnet = $args[$i+1];
+ splice(@args, $i, 1)
+ } elsif ($args[$i] eq '-server') {
+ if (defined $server) {
+ Irssi::print("autovoice add: warning: -server given twice, using the second value.");
+ }
+ $server = $args[$i+1];
+ splice(@args, $i, 1);
+ } else {
+ if (defined $channel) {
+ Irssi::print("autovoice add: warning: more than one channel specified, using the last one.");
+ }
+ $channel = $args[$i];
+ $channel = '#'.$channel
+ unless $server_rec->ischannel($channel);
+ }
+ }
+ unless (defined $channel) {
+ Irssi::print("autovoice add: no channel specified");
+ return;
+ }
+ add_channel_to_parsed($parsedchannels, $channel, $chatnet, $server);
+ Irssi::settings_set_str('autovoice_channels' =>
+ deparse_channels($parsedchannels));
+ if ($witem) {
+ $witem->command("set autovoice_channels");
+ } else {
+ Irssi::command("set autovoice_channels");
+ }
+}
+
+=item I<add_channel_to_parsed($parsedchannels, $channel, $chatnet, $server)>
+
+Adds a channel to a hash ref like that returned by &parse_channels. If $chatnet is defined but $server is not, restrict it to the chatnet. If $server is defined but $chatnet is not, restrict it to the server. If both are defined, add to channels, one restricted to the server and the other to the chatnet. (Both with the same name) If neither is defined, do not restrict the channel to a chatnet or server.
+
+=cut
+
+sub add_channel_to_parsed {
+ my ($parsedchannels, $channel, $chatnet, $server) = @_;
+ if (defined $chatnet) {
+ push @{$parsedchannels->{$channel}->{chatnet}}, $chatnet;
+ }
+ if (defined $server) {
+ push @{$parsedchannels->{$channel}->{server}}, $server;
+ }
+ if (not defined($chatnet) and not defined($server)) {
+ $parsedchannels->{$channel}->{plain} = 1;
+ }
+}
+
+=item I<remove($server_rec, $witem, @args)>
+
+Invoked as
+
+ /autovoice remove [-ircnet IRCNET] [-server SERVER] #chan1 [-ircnet IRCNET] [-server SERVER] #chan2
+
+Removes all channels matching those specified. An -ircnet or -server option only applies to the channel following it, and must be specified before its channel name. A channel without -ircnet or -server options removes all channels with that name.
+
+=cut
+
+sub remove {
+ my ($server_rec, $witem, @args) = @_;
+ my %parsedchannels = %{parse_channels()};
+ my ($wantserver, $wantchatnet, $server, $chatnet);
+ for (@args) {
+ $_ = lc;
+ if ($wantserver) {
+ $wantserver = 0;
+ $server = $_;
+ } elsif ($wantchatnet) {
+ $wantchatnet = 0;
+ $chatnet = $_;
+ } elsif ($_ eq '-server') {
+ $wantserver = 1;
+ } elsif ($_ eq '-ircnet') {
+ $wantchatnet = 1;
+ } elsif (exists $parsedchannels{$_}) {
+ my $chan = $_;
+ if (defined $server and exists $parsedchannels{$chan}{server}) {
+ @{$parsedchannels{$chan}{server}} = grep {$_ ne $server} @{$parsedchannels{$chan}{server}};
+ }
+ if (defined $chatnet and exists $parsedchannels{$chan}{chatnet}) {
+ @{$parsedchannels{$chan}{chatnet}} = grep {$_ ne $chatnet} @{$parsedchannels{$chan}{chatnet}};
+ }
+ if (not defined $server and not defined $chatnet) {
+ delete $parsedchannels{$chan};
+ } else {
+ if (exists $parsedchannels{$chan}{server} and not @{$parsedchannels{$chan}{server}}) {
+ delete $parsedchannels{$chan}{server};
+ }
+ if (exists $parsedchannels{$chan}{chatnet} and not @{$parsedchannels{$chan}{chatnet}}) {
+ delete $parsedchannels{$chan}{chatnet};
+ }
+ }
+ }
+ }
+ Irssi::settings_set_str('autovoice_channels' =>
+ deparse_channels(\%parsedchannels));
+ if ($witem) {
+ $witem->command("set autovoice_channels");
+ } else {
+ Irssi::command("set autovoice_channels");
+ }
+}
+
+=item I<flush($server_rec, $witem, @args)>
+
+Flush the badlist.
+
+=cut
+
+sub flush {
+ %bad = ();
+}
+
+=item I<get_cycletime()>
+
+Checks autovoice_cycletime and returns the cycle time in milliseconds.
+
+=cut
+
+sub get_cycletime {
+ 1000 * Irssi::settings_get_int("autovoice_cycletime");
+}
+
+=item I<get_voiceops()>
+
+Return the value of autovoice_voice_ops
+
+=cut
+
+sub get_voiceops {
+ Irssi::settings_get_bool("autovoice_voice_ops");
+}
+
+=item I<get_useident()>
+
+Return the value of autovoice_use_ident
+
+=cut
+
+sub get_useident {
+ Irssi::settings_get_bool("autovoice_use_ident");
+}
+
+=back
+
+=cut
+
+Irssi::signal_add_first('message part', 'message_part');
+Irssi::signal_add_first('message quit', 'message_quit');
+Irssi::signal_add_first('message kick', 'message_kick');
+Irssi::signal_add_last('massjoin', 'massjoin');
+Irssi::settings_add_str('autovoice', 'autovoice_channels' => "");
+Irssi::settings_add_int('autovoice', 'autovoice_cycletime' => 600);
+Irssi::settings_add_bool('autovoice', 'autovoice_voice_ops' => 0);
+Irssi::settings_add_bool('autovoice', 'autovoice_use_ident' => 0);
+Irssi::settings_add_bool('autovoice', 'autovoice' => 1);
+
+Irssi::command_bind($IRSSI{name},'autovoice_cmd');
+foreach (keys %commands) {
+ Irssi::command_bind($IRSSI{name}.' '.$_,'autovoice_cmd');
+}
diff --git a/scripts/autowhois.pl b/scripts/autowhois.pl
new file mode 100644
index 0000000..5ec6c19
--- /dev/null
+++ b/scripts/autowhois.pl
@@ -0,0 +1,39 @@
+# /WHOIS all the users who send you a private message.
+# v1.1 for irssi 0.7.98 by Timo Sirainen
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.1";
+%IRSSI = (
+ authors => "Timo \'cras\' Sirainen",
+ contact => "tss\@iki.fi",
+ name => "autowhois",
+ description => "/WHOIS all the users who send you a private message.",
+ license => "Public Domain",
+ url => "http://irssi.org/",
+ changed => "2002-03-04T22:47+0100",
+ changes => "v1.1: don't /WHOIS if query exists for the nick already"
+);
+
+# History:
+# v1.1: don't /WHOIS if query exists for the nick already
+
+my ($lastfrom, $lastquery);
+
+sub msg_private_first {
+ my ($server, $msg, $nick, $address) = @_;
+
+ $lastquery = $server->query_find($nick);
+}
+
+sub msg_private {
+ my ($server, $msg, $nick, $address) = @_;
+
+ return if $lastquery || $lastfrom eq $nick;
+
+ $lastfrom = $nick;
+ $server->command("whois $nick");
+}
+
+Irssi::signal_add_first('message private', 'msg_private_first');
+Irssi::signal_add('message private', 'msg_private');
diff --git a/scripts/autowrap.pl b/scripts/autowrap.pl
new file mode 100644
index 0000000..c110c91
--- /dev/null
+++ b/scripts/autowrap.pl
@@ -0,0 +1,38 @@
+use strict;
+use Text::Wrap;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '2007031900';
+%IRSSI = (
+ authors => 'Bitt Faulk',
+ contact => 'lxsfx3h02@sneakemail.com',
+ name => 'autowrap',
+ description => 'Automatically wraps long sent messages into multiple shorter sent messages',
+ license => 'BSD',
+ url => 'none',
+ modules => 'Text::Wrap',
+);
+
+sub event_send_text () {
+ my ($line, $server_rec, $wi_item_rec) = @_;
+ my @shortlines;
+ if (length($line) <= 400) {
+ return;
+ } else {
+ # split line, recreate multiple "send text" events
+ local($Text::Wrap::columns) = 400;
+ @shortlines = split(/\n/,wrap('','',$line));
+ foreach (@shortlines) {
+ if ($_ >= 400) {
+ Irssi::print("autowrap: unable to split long line. sent as-is");
+ return;
+ }
+ }
+ foreach (@shortlines) {
+ Irssi::signal_emit('send text', $_, $server_rec, $wi_item_rec);
+ }
+ Irssi::signal_stop();
+ }
+}
+
+Irssi::signal_add_first('send text', "event_send_text");
diff --git a/scripts/away.pl b/scripts/away.pl
new file mode 100644
index 0000000..9018903
--- /dev/null
+++ b/scripts/away.pl
@@ -0,0 +1,199 @@
+# $Id: away.pl,v 1.6 2003/02/25 08:48:56 nemesis Exp $
+
+use strict;
+use Irssi 20020121.2020 ();
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.23";
+%IRSSI = (
+ authors => 'Jean-Yves Lefort, Larry "Vizzie" Daffner, Kees Cook',
+ contact => 'jylefort@brutele.be, vizzie@airmail.net, kc@outflux.net',
+ name => 'away',
+ description => 'Away with reason, unaway, and autoaway',
+ license => 'BSD',
+ changed => '$Date: 2003/02/25 08:48:56 $ ',
+);
+
+# /SET
+#
+# away_reason if you are not away and type /AWAY without
+# arguments, this string will be used as
+# your away reason
+#
+# autoaway number of seconds before marking away,
+# only actions listed in "autounaway_level"
+# will reset the timeout.
+#
+# autounaway_level if you are away and you type a message
+# belonging to one of these levels, you'll be
+# automatically unmarked away
+#
+# levels considered:
+#
+# DCC a dcc chat connection has
+# been established
+# PUBLICS a public message from you
+# MSGS a private message from you
+# ACTIONS an action from you
+# NOTICES a notice from you
+#
+# changes:
+# 2003-02-24
+# 0.23?
+# merged with autoaway script
+#
+# 2003-01-09 release 0.22
+# * command char independed
+#
+# 2002-07-04 release 0.21
+# * signal_add's uses a reference instead of a string
+#
+# todo:
+#
+# * rewrite the away command to support -one and -all switches
+# * make auto-away stuff sane for multiple servers
+# * make auto-away reason configurable
+#
+# (c) 2003 Jean-Yves Lefort (jylefort@brutele.be)
+#
+# (c) 2000 Larry Daffner (vizzie@airmail.net)
+# You may freely use, modify and distribute this script, as long as
+# 1) you leave this notice intact
+# 2) you don't pretend my code is yours
+# 3) you don't pretend your code is mine
+#
+# (c) 2003 Kees Cook (kc@outflux.net)
+# merged 'autoaway.pl' and 'away.pl'
+#
+# BUGS:
+# - This only works for the first server
+
+use Irssi;
+use Irssi::Irc; # for DCC object
+
+my ($autoaway_sec, $autoaway_to_tag, $am_away);
+
+sub away {
+ my ($args, $server, $item) = @_;
+
+ if ($server)
+ {
+ if (!$server->{usermode_away})
+ {
+ # go away
+ $am_away=1;
+
+ # stop autoaway
+ if (defined($autoaway_to_tag)) {
+ Irssi::timeout_remove($autoaway_to_tag);
+ $autoaway_to_tag = undef();
+ }
+
+ if (!defined($args))
+ {
+ $server->command("AWAY " . Irssi::settings_get_str("away_reason"));
+ Irssi::signal_stop();
+ }
+ }
+ else
+ {
+ # come back
+ $am_away=0;
+ reset_timer();
+ }
+
+ }
+}
+
+sub cond_unaway {
+ my ($server, $level) = @_;
+ if (Irssi::level2bits(Irssi::settings_get_str("autounaway_level")) & $level)
+ {
+ #if ($server->{usermode_away})
+ if ($am_away)
+ {
+ # come back from away
+ $server->command("AWAY");
+ }
+ else
+ {
+ # bump the autoaway timeout
+ reset_timer();
+ }
+ }
+}
+
+sub dcc_connected {
+ my ($dcc) = @_;
+ cond_unaway($dcc->{server}, MSGLEVEL_DCC) if ($dcc->{type} eq "CHAT");
+}
+
+sub message_own_public {
+ my ($server, $msg, $target) = @_;
+ cond_unaway($server, MSGLEVEL_PUBLIC);
+}
+
+sub message_own_private {
+ my ($server, $msg, $target, $orig_target) = @_;
+ cond_unaway($server, MSGLEVEL_MSGS);
+}
+
+sub message_irc_own_action {
+ my ($server, $msg, $target) = @_;
+ cond_unaway($server, MSGLEVEL_ACTIONS);
+}
+
+sub message_irc_own_notice {
+ my ($server, $msg, $target) = @_;
+ cond_unaway($server, MSGLEVEL_NOTICES);
+}
+
+#
+# /AUTOAWAY - set the autoaway timeout
+#
+sub away_setupcheck {
+ $autoaway_sec = Irssi::settings_get_int("autoaway");
+ reset_timer();
+}
+
+
+sub auto_timeout {
+ my ($data, $server) = @_;
+ my $msg = "autoaway after $autoaway_sec seconds";
+
+ Irssi::timeout_remove($autoaway_to_tag);
+ $autoaway_to_tag=undef;
+
+ Irssi::print($msg);
+
+ $am_away=1;
+
+ my (@servers) = Irssi::servers();
+ $servers[0]->command("AWAY $msg");
+}
+
+sub reset_timer {
+ if (defined($autoaway_to_tag)) {
+ Irssi::timeout_remove($autoaway_to_tag);
+ $autoaway_to_tag = undef;
+ }
+ if ($autoaway_sec) {
+ $autoaway_to_tag = Irssi::timeout_add($autoaway_sec*1000,
+ "auto_timeout", "");
+ }
+}
+
+Irssi::settings_add_str("misc", "away_reason", "not here");
+Irssi::settings_add_str("misc", "autounaway_level", "PUBLIC MSGS ACTIONS DCC");
+Irssi::settings_add_int("misc", "autoaway", 0);
+
+Irssi::signal_add("dcc connected", \&dcc_connected);
+Irssi::signal_add("message own_public", \&message_own_public);
+Irssi::signal_add("message own_private", \&message_own_private);
+Irssi::signal_add("message irc own_action", \&message_irc_own_action);
+Irssi::signal_add("message irc own_notice", \&message_irc_own_notice);
+Irssi::signal_add("setup changed" => \&away_setupcheck);
+
+Irssi::command_bind("away", "away");
+
+away_setupcheck();
+
diff --git a/scripts/away2web.pl b/scripts/away2web.pl
new file mode 100644
index 0000000..7414c23
--- /dev/null
+++ b/scripts/away2web.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "2003100201";
+%IRSSI = (
+ authors => "Oskari 'Okko' Ojala",
+ contact => "sorter.irssi-scripts\@okko.net",
+ name => "away2web",
+ description => "Write /away information to a file to be used on web pages",
+ license => "BSD",
+ changed => "$VERSION",
+);
+use Irssi 20020324;
+
+#
+# Writes /away information to a file. A web page script (cgi / php / pl..) can
+# then read the file and display online/offline information.
+#
+# The web page script is left as an excersise for the user because the platforms
+# vary. :-)
+#
+# Tip: You can also modify this script to directly write HTML and then just include
+# the file on your web page.
+#
+#
+# Format of the file:
+# First line: Either "1" or "0". 0=Offline (away), 1=Online (not away).
+# Second line: The away reason (message). If the user is Online, second line is
+# empty but exists.
+#
+# File is written to ~/.irssi/away2web-status.
+#
+
+sub catch_away {
+ my $server = shift;
+
+ open(STATUSFILE, q{>}, $ENV{'HOME'}.'/.irssi/away2web-status') || die ("away2web.pl: Could not open file for writing:".$!);
+
+ if ($server->{usermode_away}) {
+ # User is offline.
+ print STATUSFILE "0\n";
+ } else {
+ # User is online.
+ print STATUSFILE "1\n";
+ }
+
+ print STATUSFILE $server->{'away_reason'}."\n";
+
+ close(STATUSFILE);
+
+}
+
+Irssi::signal_add("away mode changed", "catch_away");
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' (c) '.$IRSSI{authors}.' loaded';
+
+# end of script.
diff --git a/scripts/away_hilight_notice.pl b/scripts/away_hilight_notice.pl
new file mode 100644
index 0000000..2ee719b
--- /dev/null
+++ b/scripts/away_hilight_notice.pl
@@ -0,0 +1,215 @@
+#!/usr/bin/perl -w
+
+## Bugreports and Licence disclaimer.
+#
+# For bugreports and other improvements contact Geert Hauwaerts <geert@hauwaerts.be>
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the Free
+# Software Foundation; either version 2 of the License, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+# more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this script; if not, write to the Free Software Foundation, Inc., 59 Temple
+# Place, Suite 330, Boston, MA 02111-1307 USA.
+##
+
+
+## Documentation.
+#
+# Versioning:
+#
+# This script uses the YEAR.FEATURE.REVISION versioning scheme and must abide
+# by the follwing rules:
+#
+# 1) when adding a new feature, you must increase the FEATURE
+# numeric by one;
+#
+# 2) when fixing a bug, you must increase the REVISION numeric
+# by one; and
+#
+# 3) the first feature or bug change in any given year must set the YEAR
+# numeric to the two digit representation of the current year, and
+# reset the FEATURE and REVISION numerics to 01.
+#
+# Settings:
+#
+# away_hilight_notice_timeout
+#
+# The default time between notices sent to the same person are 3600
+# seconds or once an hour.
+#
+# away_hilight_notice_filter
+#
+# A list of channels, separated by space, on which the script will be
+# disabled.
+##
+
+
+##
+# Load the required libraries.
+##
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+
+##
+# Declare the administrative information.
+##
+
+$VERSION = '15.01.01';
+
+%IRSSI = (
+ authors => 'Geert Hauwaerts',
+ contact => 'geert@hauwaerts.be',
+ name => 'away_hilight_notice.pl',
+ description => 'This script will notice your away message in response to a hilight.',
+ license => 'GNU General Public License',
+ url => 'https://github.com/GeertHauwaerts/irssi-scripts/blob/master/src/away_hilight_notice.pl',
+ changed => 'Thu Jun 25 20:46:51 UTC 2015',
+);
+
+
+##
+# Register the custom theme formats.
+##
+
+Irssi::theme_register([
+ 'away_hilight_notice_loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.',
+]);
+
+
+##
+# Declare the script variables.
+##
+
+my %lasthilight;
+
+
+## Function.
+#
+# Irssi::away_hilight_notice::away_hilight_notice() function.
+#
+# Function: away_hilight_notice()
+# Arguments: The destination.
+# The text.
+# The stripped text.
+#
+# Description: Sends a notice with your away message.
+##
+
+sub away_hilight_notice {
+
+
+ ##
+ # Parse the parameters.
+ ##
+
+ my ($dest, $text, $stripped) = @_;
+ my $server = $dest->{'server'};
+ my $hilight = Irssi::parse_special('$;');
+
+
+ ##
+ # Check whether the message is irrelevant.
+ ##
+
+ if (!$server || !($dest->{'level'} & MSGLEVEL_HILIGHT) || ($dest->{'level'} & (MSGLEVEL_MSGS|MSGLEVEL_NOTICES|MSGLEVEL_SNOTES|MSGLEVEL_CTCPS|MSGLEVEL_ACTIONS|MSGLEVEL_JOINS|MSGLEVEL_PARTS|MSGLEVEL_QUITS|MSGLEVEL_KICKS|MSGLEVEL_MODES|MSGLEVEL_TOPICS|MSGLEVEL_WALLOPS|MSGLEVEL_INVITES|MSGLEVEL_NICKS|MSGLEVEL_DCC|MSGLEVEL_DCCMSGS|MSGLEVEL_CLIENTNOTICE|MSGLEVEL_CLIENTERROR))) {
+ return;
+ }
+
+
+ ##
+ # Check whether we are marked as away.
+ ##
+
+ if ($server->{'usermode_away'}) {
+
+
+ ##
+ # Loop through each entry in the filter.
+ ##
+
+ foreach (split /\s+/, Irssi::settings_get_str('away_hilight_notice_filter')) {
+
+
+ ##
+ # Check if the target is filtered.
+ ##
+
+ if (lc($dest->{'target'}) eq lc($_)) {
+ return;
+ }
+ }
+
+
+ ##
+ # Check whether we need to send a notice.
+ ##
+
+ if (!$lasthilight{lc($hilight)}{'last'} || ($lasthilight{lc($hilight)}{'last'} && ((time() - $lasthilight{lc($hilight)}{'last'}) > Irssi::settings_get_int('away_hilight_notice_timeout')))) {
+ $lasthilight{lc($hilight)}{'last'} = time();
+ $server->command('^NOTICE ' . $hilight . ' I\'m away (' . $server->{'away_reason'} . ')');
+ }
+ }
+}
+
+
+## Function.
+#
+# Irssi::away_hilight_notice::clear_associative_array() function.
+#
+# Function: clear_associative_array()
+# Arguments: The server.
+#
+# Description: Remove the timers from the memory.
+##
+
+sub clear_associative_array {
+
+
+ ##
+ # Parse the parameters.
+ ##
+
+ my ($server) = @_;
+
+
+ ##
+ # Check whether we are marked as active.
+ ##
+
+ if (!$server->{'usermode_away'}) {
+ %lasthilight = ();
+ }
+}
+
+
+##
+# Register the signals to hook on.
+##
+
+Irssi::signal_add('print text', 'away_hilight_notice');
+Irssi::signal_add('away mode changed', 'clear_associative_array');
+
+
+##
+# Register the custom settings.
+##
+
+Irssi::settings_add_int('away', 'away_hilight_notice_timeout', 3600);
+Irssi::settings_add_str('away', 'away_hilight_notice_filter', '#bitlbee #twitter');
+
+
+##
+# Display the script banner.
+##
+
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'away_hilight_notice_loaded', $IRSSI{name}, $VERSION, $IRSSI{authors}); \ No newline at end of file
diff --git a/scripts/away_verbose.pl b/scripts/away_verbose.pl
new file mode 100644
index 0000000..29aefd1
--- /dev/null
+++ b/scripts/away_verbose.pl
@@ -0,0 +1,234 @@
+use Irssi;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '0.0.7';
+%IRSSI = (
+ authors => 'Wouter Coekaerts, Koenraad Heijlen',
+ contact => 'vipie@ulyssis.org, wouter@coekaerts.be',
+ name => 'away_verbose',
+ description => 'A verbose away script, displays a verbose away/back message in the channels you are in. BUT it can limit the channels (not spamming every channel!)',
+ license => 'GNU GPL version 2',
+ url => 'http://vipie.studentenweb.org/dev/irssi/',
+ changed => '2004-01-01'
+);
+
+#--------------------------------------------------------------------
+# Changelog
+#--------------------------------------------------------------------
+#
+# away_verbose.pl 0.7 (2004-01-01)
+# * Wouter Coekaerts
+# - don't hard code the command char
+#
+# away_verbose.pl 0.5 (2002-11-17)
+# * James Seward
+# - make regex case insensitive
+#
+#--------------------------------------------------------------------
+
+#--------------------------------------------------------------------
+# Public Variables
+#--------------------------------------------------------------------
+my $away_time_texts = "wk,wks,day,days,hr,hrs,min,mins,sec,secs";
+my ($away_set, $away_time, $away_reason, $away_silent)=(0,0,"",0);
+my %myHELP = ();
+
+
+#--------------------------------------------------------------------
+# Help function
+#--------------------------------------------------------------------
+sub cmd_help {
+ my ($about) = @_;
+
+ %myHELP = (
+ back => "
+BACK
+
+Away is unset, the time you were away is displayed in the channel with the reason.
+
+like this: /me away_back_text_part1 <reason> away_back_text_part2 TIME
+
+Currently it will display:
+/me " . Irssi::settings_get_str('away_back_text_part1') . " Some Reason " . Irssi::settings_get_str('away_back_text_part2') . " " . &secs2text(10000) . "
+
+You can change this by changing the settings (with /set setting_name):
+
+* away_back_text_part1 (default: is back from)
+* away_back_text_part2 (default: after)
+* away_time_texts (default: wk,wks,day,days,hr,hrs,min,mins,sec,secs)
+
+",
+
+ gone => "
+GONE <your away reason>
+
+Sets you away with the given reason, and displays it publically on the allowed channels.
+
+like this: /me away_gone_text <reason>
+
+Currently it will display:
+/me " . Irssi::settings_get_str('away_gone_text') . " Some Reason
+
+You can change this by changing the settings (with /set setting_name):
+
+* away_gone_text (default: is gone:)
+
+
+How do I decide on which channels they away message is displayed?
+-----------------------------------------------------------------
+
+You set 2 settings: away_order_channels, away_allow_channels.
+
+away_order_channels = [allow|exclude]
+ Should the channels be allowed or excluded using a regular expression. (exclude = all but the matching channels).
+
+away_allow_channels = <regular expression>
+ The regular expression limiting the channels (eg 'linux|home' without the '').
+",
+
+ awe => "
+AWE [<your away reason>]
+
+When a reason is given, it acts as GONE
+When no reason is supplied it acts as BACK.
+
+SEE ALSO: HELP BACK, HELP GONE
+",
+
+);
+
+ if ( $about =~ /(back|gone|awe)/i ) {
+ Irssi::print($myHELP{$1});
+ }
+}
+
+
+#--------------------------------------------------------------------
+# Translate the number of seconds to a human readable format.
+#--------------------------------------------------------------------
+sub secs2text {
+ $away_time_texts = Irssi::settings_get_str('away_time_texts');
+ my ($secs) = @_;
+ my ($wk_,$wks_,$day_,$days_,$hr_,$hrs_,$min_,$mins_,$sec_,$secs_) = (0,1,2,3,4,5,6,7,8,9,10);
+ my @texts = split(/,/,$away_time_texts);
+ my $mins=int($secs/60); $secs -= ($mins*60);
+ my $hrs=int($mins/60); $mins -= ($hrs*60);
+ my $days=int($hrs/24); $hrs -= ($days*24);
+ my $wks=int($days/7); $days -= ($wks*7);
+ my $text = (($wks>0) ? (($wks>1) ? "$wks $texts[$wks_] " : "$wks $texts[$wk_] ") : "" );
+ $text .= (($days>0) ? (($days>1) ? "$days $texts[$days_] " : "$days $texts[$day_] ") : "" );
+ $text .= (($hrs>0) ? (($hrs>1) ? "$hrs $texts[$hrs_] " : "$hrs $texts[$hr_] ") : "" );
+ $text .= (($mins>0) ? (($mins>1) ? "$mins $texts[$mins_] " : "$mins $texts[$min_] ") : "" );
+ $text .= (($secs>0) ? (($secs>1) ? "$secs $texts[$secs_] " : "$secs $texts[$sec_] ") : "" );
+ $text =~ s/ $//;
+ return $text;
+}
+
+#--------------------------------------------------------------------
+# Output the public away on all permitted channels.
+#--------------------------------------------------------------------
+sub away_describe_pub_channels {
+ my $away_allow_channels=Irssi::settings_get_str('away_allow_channels');
+ my $away_order_channels=Irssi::settings_get_str('away_order_channels');
+ my ($server,$text) = @_;
+ foreach my $server (Irssi::servers) {
+ foreach my $chan ($server->channels) {
+
+ if ((($server->{chatnet} .":". $chan->{name}) =~ /$away_allow_channels/i) != ($away_order_channels eq "exclude")) {
+ $server->command("DESCRIBE $chan->{name} $text");
+ }
+ }
+ }
+}
+
+#--------------------------------------------------------------------
+# Set the away reason, and call the function to do the announce.
+#--------------------------------------------------------------------
+sub away_setaway {
+ my ($server, $reason)=@_;
+
+ my $away_gone_text=Irssi::settings_get_str('away_gone_text');
+
+ $server->command("AWAY " . $reason);
+ away_describe_pub_channels($server,"$away_gone_text $reason");
+ $away_time=time;
+ $away_reason=$reason;
+ $away_set=1;
+}
+
+#--------------------------------------------------------------------
+# Remove the away reason, and call the function to do the announce.
+#--------------------------------------------------------------------
+sub away_back {
+ my($server)=@_;
+
+ my $away_back_text_part1=Irssi::settings_get_str('away_back_text_part1');
+ my $away_back_text_part2=Irssi::settings_get_str('away_back_text_part2');
+
+ if ( $away_set ) {
+ $server->command("AWAY");
+ away_describe_pub_channels($server,"$away_back_text_part1 $away_reason $away_back_text_part2 " . secs2text(time - $away_time));
+ $away_time=0;
+ $away_reason="";
+ $away_set=0;
+
+ } else {
+ Irssi::print("Don't use back if you are not away! OXYMORON");
+ Irssi::print("(ed. note) OXYMORON: a combination of contradictory or incongruous words (as cruel kindness)");
+ return;
+ }
+}
+
+#--------------------------------------------------------------------
+# Defintion of /gone, /back and /awe
+#--------------------------------------------------------------------
+sub gone {
+ my ($args, $server, $item) = @_;
+ away_setaway($server,$args);
+}
+
+sub back {
+ my ($args, $server, $item) = @_;
+ away_back($server);
+}
+
+sub cmd_away {
+ my ($args, $server, $item) = @_;
+
+ if ( $args ) {
+ away_setaway($server,$args);
+ } else {
+ away_back($server);
+ }
+}
+
+
+#--------------------------------------------------------------------
+# Irssi::Settings / Irssi::command_bind
+#--------------------------------------------------------------------
+
+Irssi::settings_add_str('away', 'away_allow_channels', "^\$");
+Irssi::settings_add_str('away', 'away_order_channels', "exclude");
+Irssi::settings_add_str('away', 'away_time_texts', $away_time_texts);
+
+Irssi::settings_add_str('away', 'away_gone_text', "is gone:");
+Irssi::settings_add_str('away', 'away_back_text_part1', "is back from");
+Irssi::settings_add_str('away', 'away_back_text_part2', "after");
+
+Irssi::command_bind("gone", "gone", "Advanced Away");
+Irssi::command_bind("back", "back", "Advanced Away");
+Irssi::command_bind("awe","cmd_away", "Advanced Away");
+
+Irssi::command_bind("help","cmd_help", "Irssi commands");
+
+#--------------------------------------------------------------------
+# This text is printed at Load time.
+#--------------------------------------------------------------------
+
+Irssi::print("Use /back, /gone <reason>, or the toggle /awe [<reason>]");
+Irssi::print("Use /away [<reason>] for silent away");
+Irssi::print("Use /help back or gone or awe for more information.");
+
+
+#- end
diff --git a/scripts/awaybar.pl b/scripts/awaybar.pl
new file mode 100644
index 0000000..7d11ae5
--- /dev/null
+++ b/scripts/awaybar.pl
@@ -0,0 +1,44 @@
+# awaybar.pl -- initially built for Irssi 0.8.9
+# thanks to mood.pl for practically allowing me
+# to copy the approach..
+use strict;
+use Irssi;
+use Irssi::TextUI;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.1.1";
+%IRSSI = (
+ authors => 'Simon Shine',
+ contact => 'http://shine.eu.org/',
+ name => 'awaybar',
+ description => 'Provides a menubar item with away message',
+ sbitems => 'awaybar',
+ license => 'Public domain',
+);
+
+Irssi::statusbar_item_register('awaybar', 0, 'awaybar');
+Irssi::signal_add('away mode changed', 'awaybar_redraw');
+
+sub awaybar {
+ my ($item, $get_size_only) = @_;
+ my $away_reason = !Irssi::active_server() ? undef : Irssi::active_server()->{away_reason};
+
+ if (defined $away_reason && length $away_reason) {
+ my %r = ('\{' => '(',
+ '\}' => ')',
+ '%' => '%%',);
+ $away_reason =~ s/$_/$r{$_}/g for (keys %r);
+
+ #my $format = $theme->format_expand("{sb_awaybar $away_reason}");
+ my $format = "{sb Away: $away_reason}";
+
+ $item->{min_size} = $item->{max_size} = length($away_reason);
+ $item->default_handler($get_size_only, $format, 0, 1);
+ } else {
+ $item->{min_size} = $item->{max_size} = 0;
+ }
+}
+
+sub awaybar_redraw {
+ Irssi::statusbar_items_redraw('awaybar');
+}
diff --git a/scripts/awaylogcnt.pl b/scripts/awaylogcnt.pl
new file mode 100644
index 0000000..5c9ec82
--- /dev/null
+++ b/scripts/awaylogcnt.pl
@@ -0,0 +1,59 @@
+# $Id: awaylogcnt.pl,v 0.2 2004/10/27 19:46 derwan Exp $
+#
+# Run command '/statusbar window add -after user -priority 1 awaylogcnt' after loading awaylogcnt.pl.
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+$VERSION = '0.2';
+%IRSSI = (
+ authors => 'Marcin Rozycki',
+ contact => 'derwan@irssi.pl',
+ name => 'awalogcnt',
+ description => 'Displays in statusbar number of messages in awaylog',
+ modules => '',
+ sbitems => 'awaylogcnt',
+ license => 'GNU GPL v2',
+ url => 'http://derwan.irssi.pl',
+ changed => 'Wed Oct 27 19:46:28 CEST 2004'
+);
+
+use Irssi::TextUI;
+
+our $cnt = 0;
+our $fname = undef();
+
+
+Irssi::signal_add( 'log started' => sub {
+ my $logfile = Irssi::settings_get_str( 'awaylog_file' );
+ return unless ( $_[0]->{fname} eq $logfile );
+ ($fname, $cnt) = ($logfile, 0);
+ Irssi::statusbar_items_redraw('awaylogcnt');
+});
+
+Irssi::signal_add( 'log stopped' => sub {
+ return unless ( $_[0]->{fname} eq $fname );
+ ($cnt, $fname) = (0, undef);
+ Irssi::statusbar_items_redraw('awaylogcnt');
+});
+
+Irssi::signal_add( 'log written' => sub {
+ return unless ( $_[0]->{fname} eq $fname );
+ $cnt++;
+ Irssi::statusbar_items_redraw('awaylogcnt');
+});
+
+sub awaylogcnt ($$) {
+ my ($sbitem, $get_size_only) = @_;
+ unless ( $cnt )
+ {
+ $sbitem->{min_size} = $sbitem->{max_size} = 0 if ( ref $sbitem );
+ return;
+ }
+ my $format = sprintf('{sb \%%yawaylog\%%n %d}', $cnt);
+ $sbitem->default_handler($get_size_only, $format, undef, 1);
+}
+
+Irssi::statusbar_item_register('awaylogcnt', undef, 'awaylogcnt');
diff --git a/scripts/awayproxy.pl b/scripts/awayproxy.pl
new file mode 100644
index 0000000..8e84833
--- /dev/null
+++ b/scripts/awayproxy.pl
@@ -0,0 +1,279 @@
+# vim:syntax=perl
+# vim:tabstop=4
+# vim:shiftwidth=4
+# vim:foldmethod=marker
+# vim:foldenable
+# vim:enc=utf-8
+########################################################################################################
+## WARNING!! BAD ENGLISH BELOW :P
+##
+## This script is designed for those who have been using muh irc bouncer.
+## Basicly this script just monitors the proxy module and if new client
+## connects it sets you automatically back from away state and when client
+## disconnects it sets you automatically away if you arent allready away.
+##
+## Other hand if you dont use irssi-proxy you still have a good reason to
+## use this if you want to forward messages that come to you while
+## you are away to email box.
+## This is usefull for forwarding messages to an SMS-gateway ;)
+##
+## btw.. if you find any bugs or have any ideas for development of this
+## script dont hesitate to send msg to BCOW@IrcNET
+## or send email to anttip@n0-life.com
+##
+#### Version history:
+# 0.1
+# * basic functionality
+# 0.2b
+# * a patch from Wulf that gives a user ability to change the autoaway reason.
+# * Added away_level parameter that gives you ability to control how many
+# clients there can be connected to the irssi_proxy module before you are
+# set away.
+# * You arent set away when disconnecting from the irssi_proxy if you already
+# are away. This means that your current away reason isn't changed.
+# * Sends cumulated away messages back to the client when it connects to the
+# irssi_proxy module.
+# 0.2c
+# * Fixes bug where cummulated messages weren't sent.
+# * Code cleanup.
+# * Text wrapping to standart 80x24 text console.
+# * Added debug mode.
+# * Added script modes.
+# * Got rid of crappy irssi setings system.
+# * New logging expansion capability, either time or line based.
+# 0.2d
+# * Micro fix to get back only when needed
+# 0.2e
+# * Changed default values for $config{script_mode} and $config{emailto} for IRC-only and a non-existing placeholder respectively.
+#### To come / planned / wanted:
+# * Make expansion system log several channels at once.
+# * Make this script server based.
+########################################################################################################
+
+use strict;
+use warnings;
+
+# irssi imports
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI %config);
+
+$VERSION = "0.2e";
+%IRSSI = (
+ authors => "BCOW",
+ contact => "anttip\@n0-life.com",
+ name => "awayproxy",
+ description => "Sets nick away when client discconects from the "
+ . "irssi-proxy. If away gathers messages targeted to nick and forwards "
+ . "them to an email address.",
+ license => "GPLv2",
+ url => "http://www.n0-life.com",
+);
+
+# After how much seconds we can check if there are any messages to send?
+$config{check_interval} = 45;
+# this setting controls that when this amout of clients are connected to the
+# proxy module script sets you away. If you set this to 0 you are set away when
+# no clients are connected to the proxy module. If you set this to lets say 5
+# then you will be set away allways when the amount of clients connected to the
+# proxy module is 5 or under.
+$config{away_level} = 0;
+# Controls expansion mode. This mode records pub msgs that come after one with
+# your nick in it. you can use line counting or time counting.
+# 0 - off
+# line - line counting
+# time - time counting
+$config{expansion_mode} = 'time';
+# How many lines include after start line?
+$config{expansion_lines} = 12;
+# After how many seconds stop gathering msgs?
+$config{expansion_timeout} = 90;
+# script operation mode:
+# 0 - to send messages both to email and when you get back to proxy
+# 1 - only email
+# 2 - only irc
+# 3 - off
+$config{script_mode} = 2;
+# email address where to send the email
+$config{emailto} = 'recipient@domain.tld';
+# sendmail location
+$config{sendmail} = '/usr/sbin/sendmail';
+# who is the sender of the email
+$config{emailfrom} = 'sender@domain.tld';
+# Subject of email
+$config{emailsubject} = '[irssi-proxy]';
+# and the awayreason setting (Thanx Wulf)
+$config{awayreason} = 'Auto-away because client has disconnected from proxy.';
+# Debugging mode
+$config{debug} = 0;
+
+# -- Don't change anything below this line if you don't know Perl. --
+# number of clients connected
+$config{clientcount} = 0;
+# number of lines recorded
+$config{expansion_lines_count} = 0;
+
+$config{expansion_started} = 0;
+# the small list and archive list
+$config{awaymsglist} = [];
+$config{awaymsglist2} = [];
+
+if ( $config{script_mode} == 0 || $config{script_mode} == 1 ) { # {{{
+ # timeouts for check loop
+ debug('Timer on, timeout: ' . $config{check_interval});
+ Irssi::timeout_add($config{check_interval} * 1000, 'msgsend_check', '');
+} # }}}
+
+sub debug { # {{{
+ if ($config{debug}) {
+ my $text = shift;
+ my $caller = caller;
+ Irssi::print('From ' . $caller . ":\n" . $text);
+ }
+} # }}}
+sub msgsend_check { # {{{
+ # If there are any messages to send
+ my $count = @{$config{awaymsglist}};
+ debug("Checking for messages: $count");
+ # Check if we didn't grep msgs right now
+ if ($count > 0 && !$config{expansion_started}) {
+ # Concentate messages into one text.
+ my $text = join "\n", @{$config{awaymsglist}};
+ # Then empty list.
+ $config{awaymsglist} = [];
+ # Finally send email
+ debug("Concentated msgs: $text");
+ send_mail($text);
+ }
+} # }}}
+sub send_mail { # {{{
+ my $text = shift;
+ debug("Sending mail");
+ open MAIL, q{|-}, $config{sendmail} . " -t";
+ print MAIL "To: $config{emailto}\n";
+ print MAIL "From: $config{emailfrom}\n";
+ print MAIL "Subject: $config{emailsubject}\n";
+ print MAIL "$text";
+ close MAIL;
+} # }}}
+sub client_connect { # {{{
+ my (@servers) = Irssi::servers;
+
+ $config{clientcount}++;
+ debug("Client connected, current script mode: $config{script_mode}");
+
+ # setback
+ foreach my $server (@servers) {
+ # if you're away on that server send yourself back
+ if ($server->{usermode_away} == 1) {
+ $server->send_raw('AWAY :');
+ # and then send the current contents of archive list as notify's to
+ # your self ;)
+ # .. weird huh? :)
+ # This sends all the away messages to ALL the servers where you are
+ # connected... this is somewhat weird i know
+ # but if someone wants to make a patch to this i would really
+ # appreciate it.
+ if ($config{script_mode} == 0 || $config{script_mode} == 2) {
+ debug('Sending notices');
+ $server->send_raw('NOTICE ' . $server->{nick} . " :$_")
+ for @{$config{awaymsglist2}};
+ }
+ }
+ }
+ # and "clear" the awaymessage list
+ $config{awaymsglist2} = []
+ if $config{script_mode} == 0 || $config{script_mode} == 2;
+} # }}}
+sub client_disconnect { # {{{
+ my (@servers) = Irssi::servers;
+ debug('Client Disconnectted');
+
+ $config{clientcount}-- unless $config{clientcount} == 0;
+
+ # setaway
+ if ($config{clientcount} <= $config{away_level}) {
+ # ok.. we have the away_level of clients connected or less.
+ foreach my $server (@servers) {
+ if ($server->{usermode_away} == "0") {
+ # we are not away on this server allready.. set the autoaway
+ # reason
+ $server->send_raw(
+ 'AWAY :' . $config{awayreason}
+ );
+ }
+ }
+ }
+} # }}}
+sub msg_pub { # {{{
+ my ($server, $data, $nick, $mask, $target) = @_;
+
+ sub push_into_archive { # {{{
+ my ($nick, $mask, $target, $data) = @_;
+ # simple list that is emptied on the email run
+ push @{$config{awaymsglist}}, "<$nick!$mask\@$target> $data"
+ if $config{script_mode} == 0 || $config{script_mode} == 1;
+ # archive list that is emptied only on the client connect run
+ push @{$config{awaymsglist2}}, "<$nick!$mask\@$target> $data"
+ if $config{script_mode} == 0 || $config{script_mode} == 2;
+ } # }}}
+
+ if ($config{expansion_started}) {
+ if ($config{expansion_mode} eq 'line') {
+ if ($config{expansion_lines_count} <= $config{expansion_lines} -1) {
+ if ($config{expansion_chan} eq $target) {
+ debug("In effect from line expansion, pushing on. Cnt: "
+ . $config{expansion_lines_count});
+ push_into_archive($nick, $mask, $target, $data);
+ $config{expansion_lines_count}++;
+ }
+ }
+ else {
+ debug("Line counter reached max, stopping expansion");
+ $config{expansion_lines_count} = 0;
+ $config{expansion_started} = 0;
+ $config{expansion_chan} = '';
+ }
+ }
+ elsif ($config{expansion_mode} eq 'time') {
+ if ($config{expansion_chan} eq $target) {
+ debug("Time expansion in effect, pushing on.");
+ push_into_archive($nick, $mask, $target, $data);
+ }
+ }
+ }
+ elsif ($server->{usermode_away} == "1" && $data =~ /$server->{nick}/i) {
+ debug("Got pub msg with my name");
+ push_into_archive($nick, $mask, $target, $data);
+ if ($config{expansion_mode}) {
+ debug("Starting expansion in mode: " . $config{expansion_mode});
+ $config{expansion_started} = 1;
+ $config{expansion_chan} = $target;
+ $config{expansion_time_out} = Irssi::timeout_add(
+ $config{expansion_timeout} * 1000, 'expansion_stop', ''
+ ) if $config{expansion_mode} eq 'time';
+ }
+ }
+} # }}}
+sub expansion_stop { # {{{
+ debug("Stopping expansion from timer");
+ $config{expansion_started} = 0;
+ $config{expansion_chan} = '';
+} # }}}
+sub msg_pri { # {{{
+ my ($server, $data, $nick, $address) = @_;
+ if ($server->{usermode_away} == "1") {
+ debug("Got priv msg");
+ # simple list that is emptied on the email run
+ push @{$config{awaymsglist}}, "<$nick!$address> $data"
+ if $config{script_mode} == 0 || $config{script_mode} == 1;
+ # archive list that is emptied only on the client connect run
+ push @{$config{awaymsglist2}}, "<$nick!$address> $data"
+ if $config{script_mode} == 0 || $config{script_mode} == 2;
+ }
+} # }}}
+
+Irssi::signal_add_last('proxy client connected', 'client_connect');
+Irssi::signal_add_last('proxy client disconnected', 'client_disconnect');
+Irssi::signal_add_last('message public', 'msg_pub');
+Irssi::signal_add_last('message private', 'msg_pri');
diff --git a/scripts/badword.pl b/scripts/badword.pl
new file mode 100644
index 0000000..20a0b57
--- /dev/null
+++ b/scripts/badword.pl
@@ -0,0 +1,163 @@
+###############################################################################
+# badword.pl
+# Copyright (C) 2002 Jan 'fissie' Sembera <fis@ji.cz>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+###############################################################################
+# This is configurable badword script. It may be configured to ban immediately
+# when first badword is detected, or it may count badwords and if number of
+# badwords of given nick exceeds limit, ban him. Badword count may also be
+# expired if no badword is seen for specified period of time. Optional
+# verbosity (let's call it logging) may be enabled as well
+#
+# Runtime variables:
+#
+# badword_channels = list of channels where script is active, separated by space
+# badword_words = list of 'bad words' that trigger this, separated by space
+# badword_reason = reason used in kick when count exceeds permitted limit
+# badword_limit = if number of detected badwords reaches this number, ban'em.
+# Set 1 to immediately kickban.
+# badword_clear_delay = if no badword is detected from user for time specified
+# here (in seconds), clear his counter. Set 0 to disable.
+# badword_verbose = turns on/off logging features
+# badword_ban_delay = ban after number of kicks specified here. 0 - disables
+# banning, 1 - ban immediately, ...
+###############################################################################
+#
+# Changelog:
+#
+# Jun 4 2002
+# - added ban delaying feature
+#
+###############################################################################
+use Irssi;
+use Irssi::Irc;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.0.3";
+
+%IRSSI = (
+ authors => "Jan 'fissie' Sembera",
+ contact => "fis\@ji.cz",
+ name => "badword",
+ description => "Configurable badword kickbanning script",
+ license => "GPL v2 and any later",
+ url => "http://fis.bofh.cz/devel/irssi/",
+);
+
+my %nick_dbase;
+
+sub sig_public {
+ my ($server, $msg, $nick, $address, $target) = @_;
+ my $watch_channels = Irssi::settings_get_str('badword_channels');
+ my $watch_words = Irssi::settings_get_str('badword_words');
+
+ my @chanz = split (/ /, $watch_channels);
+ my @wordz = split (/ /, $watch_words);
+
+ my $nickrec = $server->channel_find($target)->nick_find($nick);
+ my $nickmode = $nickrec->{op} ? "@" : $nickrec->{voice} ? "+" : "";
+
+ my $aux = 0;
+
+ if (! ($nickmode eq "")) {
+ return;
+ }
+
+ foreach my $ch (@chanz) {
+ if ($ch eq $target) {
+ $aux = 1;
+ }
+ }
+
+ if ($aux == 0) {
+ return;
+ }
+
+ $aux = 0;
+ foreach my $bw (@wordz) {
+# if (($msg =~ /\ $bw/) || ($msg =~ /^$bw/)) {
+ if ($msg =~ /$bw/) {
+ $aux = 1;
+ }
+ }
+
+ if ($aux == 0) {
+ return;
+ }
+
+ # Ok, here comes badword, check record
+
+ my $luser = $nick_dbase{$nick}{$target};
+
+ if (!$luser) {
+ $nick_dbase{$nick}{$target}{'count'} = 1;
+ $nick_dbase{$nick}{$target}{'kcount'} = 0;
+ $nick_dbase{$nick}{$target}{'stamp'} = time();
+ } else {
+ if ((Irssi::settings_get_int('badword_clear_delay') != 0) && (($nick_dbase{$nick}{$target}{'stamp'})+(Irssi::settings_get_int('badword_clear_delay'))) < time()) {
+ $nick_dbase{$nick}{$target}{'count'} = 1;
+ if (Irssi::settings_get_bool('badword_verbose') == 1) { Irssi::print('BW: Expired for '.$nick.' with hostmask '.$address.' on channel '.$target); }
+ } else {
+ $nick_dbase{$nick}{$target}{'count'} = ($nick_dbase{$nick}{$target}{'count'})+1;
+ }
+ $nick_dbase{$nick}{$target}{'stamp'} = time();
+ }
+
+ $luser = $nick_dbase{$nick}{$target}{'count'};
+
+ if (Irssi::settings_get_bool('badword_verbose') == 1) { Irssi::print('BW: Detected badword from nick '.$nick.' with hostmask '.$address.' on channel '.$target.' - '.$nick_dbase{$nick}{$target}{'count'}.' times'); }
+
+ if ($luser == Irssi::settings_get_int('badword_limit')) {
+ $nick_dbase{$nick}{$target}{'count'} = 0;
+ # Ban'em!
+ my @host = split(/\@/, $address);
+ if (($host[0] =~ /\~/) || ($host[0] =~ /\-/) || ($host[0] =~ /\=/) || ($host[0] =~ /\^/)) { $host[0] = "*"; }
+ my $mask = '*!'.$host[0].'@'.$host[1];
+ $nick_dbase{$nick}{$target}{'kcount'} = ($nick_dbase{$nick}{$target}{'kcount'})+1;
+ if ((Irssi::settings_get_int('badword_ban_delay') > 0) && (Irssi::settings_get_int('badword_ban_delay') == $nick_dbase{$nick}{$target}{'kcount'})) {
+ $server->command('mode '.$target.' +b '.$mask);
+ $nick_dbase{$nick}{$target}{'kcount'} = 0;
+ if (Irssi::settings_get_bool('badword_verbose') == 1) { Irssi::print('BW: Nick '.$nick.' with mask '.$mask.' punished for badwording on channel '.$target.' - banned'); }
+ } else {
+ if (Irssi::settings_get_bool('badword_verbose') == 1) { Irssi::print('BW: Nick '.$nick.' with mask '.$mask.' punished for badwording on channel '.$target.' - kicked'); }
+ }
+ $server->command('quote kick '.$target.' '.$nick.' :'.Irssi::settings_get_str('badword_reason'));
+ }
+}
+
+sub sig_nick {
+ my ($server, $newnick, $nick, $address) = @_;
+
+ $newnick = substr ($newnick, 1) if ($newnick =~ /^:/);
+ my $count = $nick_dbase{$nick};
+ if ($count) {
+ $nick_dbase{$nick} = undef;
+ $nick_dbase{$newnick} = $count;
+ if (Irssi::settings_get_bool('badword_verbose') == 1) { Irssi::print('BW: Tranferred badwords from '.$nick.' to '.$newnick); }
+ }
+}
+
+Irssi::settings_add_str("misc", "badword_channels", "");
+Irssi::settings_add_str("misc", "badword_words", "");
+Irssi::settings_add_str("misc", "badword_reason", "BW: badword limit exceeded");
+Irssi::settings_add_int("misc", "badword_limit", 3);
+Irssi::settings_add_int("misc", "badword_clear_delay", 3600);
+Irssi::settings_add_int("misc", "badword_ban_delay", 1);
+Irssi::settings_add_bool("misc", "badword_verbose", 0);
+
+Irssi::signal_add_last('message public', 'sig_public');
+Irssi::signal_add_last('event nick', 'sig_nick');
diff --git a/scripts/ban.pl b/scripts/ban.pl
new file mode 100644
index 0000000..8915dbc
--- /dev/null
+++ b/scripts/ban.pl
@@ -0,0 +1,394 @@
+use Irssi 20020300;
+use 5.6.0;
+use strict;
+use Socket;
+use POSIX;
+
+use vars qw($VERSION %IRSSI %HELP);
+$HELP{ban} = "
+BAN [channel] [-normal|-host|-user|-domain|-crap|-ip|-class -before \"command\"|-after \"command\" nicks|masks] ...
+
+Bans the specified nicks or userhost masks.
+
+If nick is given as parameter, the ban type is used to generate the ban mask.
+/SET banpl_type specified the default ban type. Ban type is one of the following:
+
+ normal - *!fahren\@*.ds14.agh.edu.pl
+ host - *!*\@plus.ds14.agh.edu.pl
+ user - *!fahren@*
+ domain - *!*\@*.agh.edu.pl
+ crap - *?fah???\@?l??.?s??.??h.???.?l
+ ip - *!fahren\@149.156.124.*
+ class - *!*\@149.156.124.*
+
+Only one flag can be specified for a given nick.
+Script removes any conflicting bans before banning.
+
+You can specify command that will be executed before or after
+banning nick/mask using -before or -after.
+
+Examples:
+ /BAN fahren - Bans the nick 'fahren'
+ /BAN -ip fahren - Bans the ip of nick 'fahren'
+ /BAN fahren -ip fantazja -crap nerhaf -normal ff
+ - Bans 'fahren' (using banpl_type set), ip of 'fantazja',
+ host with crap mask of 'nerhaf' and 'ff' with normal bantype.
+ /BAN *!*fahren@* - Bans '*!*fahren@*'
+ /BAN #chan -after \"KICK #chan fahren :reason\" fahren
+ - Bans and kicks 'fahren' from channel '#chan' with reason 'reason'.
+
+ /ALIAS ipkb ban \$C -after \"KICK \$C \$0 \$1-\" -ip \$0
+ - Adds command /ipkb <nick> [reason] which kicks 'nick' and bans it's ip address.
+";
+$VERSION = "1.4d";
+%IRSSI = (
+ authors => "Maciek \'fahren\' Freudenheim",
+ contact => "fahren\@bochnia.pl",
+ name => "ban",
+ description => "/BAN [channel] [-normal|-host|-user|-domain|-crap|-ip|-class -before|-after \"cmd\" nick|mask] ... - bans several nicks/masks on channel, removes any conflicting bans before banning",
+ license => "GNU GPLv2 or later",
+ changed => "Tue Nov 19 18:11:09 CET 2002"
+);
+
+# Changelog:
+# 1.4d
+# - getting user@host of someone who isn't on channel was broken
+# 1.4c
+# - fixed banning of unresolved hosts
+# - fixed problem with /ban unexisting_nick other_nick
+# 1.4b
+# - doesn't require op to see banlist :)
+# 1.4
+# - few fixes
+# - using banpl_type instead of irssi's builtin ban_type
+# - changed -normal behaviour
+# 1.3
+# - :( fixed crap banning (yes, i'm to stupid to code it)
+# 1.2
+# - queuing MODES for nicks that aren't on channel
+# 1.11
+# - fixed .. surprise! crap banning
+# - added use 5.6.0
+# 1.1
+# - fixed banning 10-char long idents
+# - fixed crap banning (once more)
+# - added -before and -after [command] for executing command before/after setting ban
+# 1.0
+# - -o+b if banning opped nick
+# - fixed -crap banning
+# - always banning with *!*ident@ (instead of *!ident@)
+# - can take channel as first argument now
+# - displays error if it couldn't resolve host for -ip / -class ban
+# - groups all modes and sends them at once, ie. -bbo\n+b-o+b
+# - gets user@host via USERHOST if requested ban of someone who is not on channel
+# - added help
+
+my (%ftag, $parent, %modes, %modes_args, %b, @userhosts);
+
+sub cmd_ban {
+ my ($args, $server, $winit) = @_;
+
+ my $chan;
+ my ($channel) = $args =~ /^([^\s]+)/;
+
+ if (($server->ischannel($channel))) {
+ $args =~ s/^[^\s]+\s?//;
+ return unless ($args);
+ unless (($chan = $server->channel_find($channel)) && $chan->{chanop}) {
+ Irssi::print("%R>>%n You are not on $channel or you are not opped.");
+ Irssi::signal_stop();
+ return;
+ }
+ } else {
+ return unless ($args);
+ unless ($winit && $winit->{type} eq "CHANNEL" && $winit->{chanop}) {
+ Irssi::print("%R>>%n You don't have active channel in that window or you are not opped.");
+ Irssi::signal_stop();
+ return;
+ }
+ $chan = $winit;
+ $channel = $chan->{name};
+ }
+
+ Irssi::signal_stop();
+
+ my $bantype = Irssi::settings_get_str("banpl_type");
+ my $max = $server->{max_modes_in_cmd};
+ my ($cmdwhat, $cmdwhen) = (0, 0);
+ $b{$channel} = 0;
+
+ # counts nicks/masks to ban, lame :|
+ for my $cmd (split("\"", $args)) {
+ ($cmdwhen) and $cmdwhen = 0, next;
+ for (split(/ +/, $cmd)) {
+ next unless $_;
+ /^-(normal|host|user|domain|crap|ip|class)$/ and next;
+ /^-(before|after)$/ and $cmdwhen = 1, next;
+ $b{$channel}++;
+ }
+ }
+
+ for my $cmd (split("\"", $args)) {
+ ($cmdwhen && !$cmdwhat) and $cmdwhat = $cmd, next;
+ for my $arg (split(/ +/, $cmd)) {
+ next unless $arg;
+ $arg =~ /^-(normal|host|user|domain|crap|ip|class)$/ and $bantype = $1, next;
+ $arg eq "-before" and $cmdwhen = 1, next;
+ $arg eq "-after" and $cmdwhen = 2, next;
+
+ if (index($arg, "@") == -1) {
+ my $n;
+ if ($n = $chan->nick_find($arg)) {
+ # nick is on channel
+
+ my ($user, $host) = split("@", $n->{host});
+
+ if ($bantype eq "ip" || $bantype eq "class") {
+ # requested ip ban, forking
+ my $pid = &ban_fork;
+ unless (defined $pid) { # error
+ $cmdwhen = $cmdwhat = 0;
+ $b{$channel}--;
+ next;
+ } elsif ($pid) { # parent
+ $cmdwhen = $cmdwhat = 0;
+ next;
+ }
+ my $ia = gethostbyname($host);
+ unless ($ia) {
+ print($parent "error $channel %R>>%n Couldn't resolve $host.\n");
+ } else {
+ print($parent "execute $server->{tag} $channel " . (($n->{op})? $arg : 0) . " " . make_ban($user, inet_ntoa($ia), $bantype) . " $cmdwhen $cmdwhat\n");
+ }
+ close $parent; POSIX::_exit(1);
+ }
+ ban_execute($chan, (($n->{op})? $arg : 0), make_ban($user, $host, $bantype), $max, $cmdwhen, $cmdwhat);
+ } else {
+ # nick is not on channel, trying to get addres via /userhost
+ $server->redirect_event('userhost', 1, $arg, 0, undef, {
+ 'event 302' => 'redir ban userhost',
+ '' => 'event empty' } );
+ $server->send_raw("USERHOST :$arg");
+ my $uh = {
+ tag => $server->{tag},
+ nick => lc($arg),
+ channel => $channel,
+ chanhash => $chan,
+ bantype => $bantype,
+ cmdwhen => $cmdwhen,
+ cmdwhat => $cmdwhat
+ };
+ push @userhosts, $uh;
+ }
+ } else {
+ # specified mask
+ my $ban;
+ $ban = "*!" if (index($arg, "!") == -1);
+ $ban .= $arg;
+ ban_execute($chan, 0, $ban, $max, $cmdwhen, $cmdwhat);
+ }
+
+ $cmdwhen = $cmdwhat = 0;
+ }
+ }
+}
+
+sub push_mode ($$$$) {
+ my ($chan, $mode, $arg, $max) = @_;
+
+ my $channel = $chan->{name};
+ $modes{$channel} .= $mode;
+ $modes_args{$channel} .= "$arg ";
+
+ flush_mode($chan) if (length($modes{$channel}) >= ($max * 2));
+}
+
+sub flush_mode ($) {
+ my $chan = shift;
+
+ my $channel = $chan->{name};
+ return unless (defined $modes{$channel});
+# Irssi::print("MODE $channel $modes{$channel} $modes_args{$channel}");
+ $chan->command("MODE $channel $modes{$channel} $modes_args{$channel}");
+ undef $modes{$channel}; undef $modes_args{$channel};
+}
+
+sub userhost_red {
+ my ($server, $data) = @_;
+ $data =~ s/^[^ ]* :?//;
+
+ my $uh = shift @userhosts;
+
+ unless ($data && $data =~ /^([^=\*]*)\*?=.(.*)@(.*)/ && lc($1) eq $uh->{nick}) {
+ Irssi::print("%R>>%n No such nickname: $uh->{nick}");
+ $b{$uh->{channel}}--;
+ flush_mode($uh->{chanhash}) unless ($b{$uh->{channel}});
+ return;
+ }
+
+ my ($user, $host) = (lc($2), lc($3));
+
+ if ($uh->{bantype} eq "ip" || $uh->{bantype} eq "class") {
+ # requested ip ;/
+ my $pid = &ban_fork;
+ unless (defined $pid) { # error
+ $b{$uh->{channel}}--;
+ return;
+ } elsif ($pid) { # parent
+ return;
+ }
+ my $ia = gethostbyname($host);
+ unless ($ia) {
+ print($parent "error " . $uh->{channel} . " %R>>%n Couldn't resolve $host.\n");
+ } else {
+ print($parent "execute " . $uh->{tag} . " " . $uh->{channel} . " 0 " . make_ban($user, inet_ntoa($ia), $uh->{bantype}) . " " . $uh->{cmdwhen} . " " . $uh->{cmdwhat} . "\n");
+ }
+ close $parent; POSIX::_exit(1);
+ }
+
+ my $serv = Irssi::server_find_tag($uh->{tag});
+ ban_execute($uh->{chanhash}, 0, make_ban($user, $host, $uh->{bantype}), $serv->{max_modes_in_cmd}, $uh->{cmdwhen}, $uh->{cmdwhat});
+}
+
+sub ban_execute ($$$$$$) {
+ my ($chan, $nick, $ban, $max, $cmdwhen, $cmdwhat) = @_;
+
+ my $no = 0;
+ my $channel = $chan->{name};
+
+ for my $hash ($chan->bans()) {
+ if (mask_match($ban, $hash->{ban})) {
+ # should display also who set the ban (if available)
+ Irssi::print("%Y>>%n $channel: ban $hash->{ban}");
+ $no = 1;
+ last;
+ } elsif (mask_match($hash->{ban}, $ban)) {
+ push_mode($chan, "-b", $hash->{ban}, $max);
+ }
+ }
+
+ unless ($no) {
+ my ($cmdmode, $cmdarg);
+ # is requested command a MODE so we can put it to queue?
+ ($cmdmode, $cmdarg) = $cmdwhat =~ /^MODE\s+[^\s]+\s+([^\s]+)\s+([^\s]+)/i if $cmdwhen;
+ if ($cmdwhen == 1) { # command requested *before* banning
+ unless ($cmdmode) { # command isn't mode, ie: KICK
+ flush_mode($chan); # flush all -b conflicting bans
+ $chan->command($cmdwhat); # execute
+ } else { # command is MODE, we can add it to queue
+ push_mode($chan, $cmdmode, $cmdarg, $max);
+ }
+ }
+ push_mode($chan, "-o", $nick, $max) if ($nick);
+ push_mode($chan, "+b", $ban, $max);
+ if ($cmdwhen == 2) { # command requested *after* banning
+ unless ($cmdmode) {
+ flush_mode($chan); # flush all modes
+ $chan->command($cmdwhat);
+ } else {
+ push_mode($chan, $cmdmode, $cmdarg, $max);
+ }
+ }
+ }
+
+ $b{$channel}--;
+ flush_mode($chan) unless ($b{$channel});
+}
+
+sub ban_fork {
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ my $pid = fork();
+ unless (defined $pid) {
+ Irssi::print("%R>>%n Failed to fork() :/ - $!");
+ close $rh; close $wh;
+ return undef;
+ } elsif ($pid) { # parent
+ close $wh;
+ $ftag{$rh} = Irssi::input_add(fileno($rh), INPUT_READ, \&ifork, $rh);
+ Irssi::pidwait_add($pid);
+ } else { # child
+ close $rh;
+ $parent = $wh;
+ }
+ return $pid;
+}
+
+sub ifork {
+ my $rh = shift;
+ while (<$rh>) {
+ /^error\s([^\s]+)\s(.+)/ and $b{$1}--, Irssi::print("$2"), last;
+ if (/^execute\s([^\s]+)\s([^\s]+)\s([^\s]+)\s([^\s]+)\s([^\s]+)\s(.+)/) {
+ my $serv = Irssi::server_find_tag($1);
+ ban_execute($serv->channel_find($2), $3, $4, $serv->{max_modes_in_cmd}, $5, $6);
+ last;
+ }
+ }
+ Irssi::input_remove($ftag{$rh});
+ delete $ftag{$rh};
+ close $rh;
+}
+
+sub make_ban ($$$) {
+ my ($user, $host, $bantype) = @_;
+
+ $user =~ s/^[~+\-=^]/*/;
+ if ($bantype eq "ip") {
+ $host =~ s/\.[0-9]+$/.*/;
+ } elsif ($bantype eq "class") {
+ $user = "*";
+ $host =~ s/\.[0-9]+$/.*/;
+ } elsif ($bantype eq "user") {
+ $host = "*";
+ } elsif ($bantype eq "domain") {
+ # i know -- lame
+ if ($host =~ /^.*\..*\..*\..*$/) {
+ $host =~ s/.*(\..+\..+\..+)$/*\1/;
+ } elsif ($host =~ /^.*\..*\..*$/) {
+ $host =~ s/.*(\..+\..+)$/*\1/;
+ }
+ $user = "*";
+ } elsif ($bantype eq "host") {
+ $user = "*";
+ } elsif ($bantype eq "normal") {
+# $host =~ s/^[A-Za-z\-]*[0-9]+\./*./;
+ if ($host =~ /\d$/) {
+ $host =~ s/\.[0-9]+$/.*/;
+ } else {
+ $host =~ s/^[^.]+\./*./ if $host =~ /^.*\..*\..*$/;
+ }
+ } elsif ($bantype eq "crap") {
+ my $crap;
+ for my $c (split(//, $user)) {
+ $crap .= ((int(rand(2)))? "?" : $c);
+ }
+ $user = $crap;
+ $crap = "";
+ for my $c (split(//, $host)) {
+ $crap .= ((int(rand(2)))? "?" : $c);
+ }
+ $host = $crap;
+ }
+
+ return ("*!" . $user . "@" . $host);
+}
+
+sub mask_match ($$) {
+ my ($what, $match) = @_;
+
+ # stolen from shasta's friend.pl
+ $match =~ s/\\/\\\\/g;
+ $match =~ s/\./\\\./g;
+ $match =~ s/\*/\.\*/g;
+ $match =~ s/\!/\\\!/g;
+ $match =~ s/\?/\./g;
+ $match =~ s/\+/\\\+/g;
+ $match =~ s/\^/\\\^/g;
+ $match =~ s/\[/\\\[/g;
+
+ return ($what =~ /^$match$/i);
+}
+
+Irssi::command_bind 'ban' => \&cmd_ban;
+Irssi::settings_add_str 'misc', 'banpl_type', 'normal';
+Irssi::signal_add 'redir ban userhost' => \&userhost_red;
diff --git a/scripts/bandwidth.pl b/scripts/bandwidth.pl
new file mode 100644
index 0000000..8c0d0fb
--- /dev/null
+++ b/scripts/bandwidth.pl
@@ -0,0 +1,115 @@
+# Mrtg-compatible any statistic loader
+# /SET status_min_in - The minimum load to show
+# /SET status_min_in - The minimum load to show
+# /SET status_refresh - How often the loadavg is refreshed
+#
+# takes output from mrtg compatible scripts,
+# see the mrtg-contrib and mrtgutils package for scripts to load
+#
+# this one requires /usr/bin/mrtg-ip-acct from mrtgutils package
+#
+# TODO ; add support for more than one stat at the same time
+# TODO : negative amounts?
+
+use Irssi 20011113;
+use Irssi::TextUI;
+
+use strict;
+use 5.6.0;
+
+use vars qw($VERSION %IRSSI);
+
+# header begins here
+
+$VERSION = "1.0";
+%IRSSI = (
+ authors => "Riku Voipio",
+ contact => "riku.voipio\@iki.fi",
+ name => "bandwidth",
+ description => "shows bandwidth usage in statusbar",
+ sbitems => "stats",
+ license => "GPLv2",
+ url => "http://nchip.ukkosenjyly.mine.nu/irssiscripts/",
+ );
+
+my ($refresh, $last_refresh, $refresh_tag) = (10);
+my ($last_in, $last_out) = (0.0,0.0);
+my ($min_in, $min_out) = (1.0,1.0);
+my ($cur_in, $cur_out, $first_run) = (0.0,0.0,1);
+my $command = '/usr/bin/mrtg-ip-acct';
+
+
+sub get_stats
+{
+ my ($old_in, $old_out) = ($last_in, $last_out);
+
+ my @localstats;
+ if (open my $fh, q{-|}, $command)
+ {
+ @localstats = <$fh>;
+ close $fh;
+ } else {
+ Irssi::print("Failed to execute $command: $!", MSGLEVEL_CLIENTERROR);
+ }
+
+ for(@localstats[0..1]) {
+ return unless defined;
+ return unless /^\d+$/;
+ }
+ $last_in=$localstats[0];
+ $last_out=$localstats[1];
+
+ if ($old_out==0){return;}
+
+ $cur_out=($last_out-$old_out) / ($refresh*1024);
+ $cur_in=($last_in-$old_in) / ($refresh*1024);
+}
+
+sub stats {
+ my ($item, $get_size_only) = @_;
+ #get_stats();
+
+ $min_out = Irssi::settings_get_int('stats_min_out');
+ $min_in = Irssi::settings_get_int('stats_min_in');
+ $min_in = 0 if $min_in < 0;
+ $min_out = 0 if $min_out < 0;
+
+
+ if ($cur_in < $min_in and $cur_out <$min_out){
+ #dont print
+ if ($get_size_only) {
+ $item->{min_size} = $item->{max_size} = 0;
+ }
+ } else {
+ $item->default_handler($get_size_only, undef, sprintf("i:%.2f o:%.2f",$cur_in, $cur_out ), 1 );
+ }
+}
+
+sub refresh_stats {
+ get_stats();
+ Irssi::statusbar_items_redraw('stats');
+}
+
+sub read_settings {
+ $refresh = Irssi::settings_get_int('stats_refresh');
+ $command = Irssi::settings_get_str('stats_commandline');
+ $refresh = 1 if $refresh < 1;
+ return if $refresh == $last_refresh;
+ $last_refresh = $refresh;
+
+ Irssi::timeout_remove($refresh_tag) if $refresh_tag;
+ $refresh_tag = Irssi::timeout_add($refresh*1000, 'refresh_stats', undef);
+}
+
+Irssi::settings_add_int('misc', 'stats_min_in', $min_in);
+Irssi::settings_add_int('misc', 'stats_min_out', $min_out);
+Irssi::settings_add_int('misc', 'stats_refresh', $refresh);
+Irssi::settings_add_str('misc', 'stats_commandline', $command);
+
+Irssi::statusbar_item_register('stats', '{sb S: $0-}', 'stats');
+Irssi::statusbars_recreate_items();
+
+read_settings();
+Irssi::signal_add('setup changed', 'read_settings');
+
+
diff --git a/scripts/bansearch.pl b/scripts/bansearch.pl
new file mode 100644
index 0000000..cc961ad
--- /dev/null
+++ b/scripts/bansearch.pl
@@ -0,0 +1,421 @@
+#!/usr/bin/perl
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.3";
+%IRSSI = (
+ authors => 'Nathan Handler, Joseph Price',
+ contact => 'nathan.handler@gmail.com, pricechild@ubuntu.com',
+ name => 'bansearch',
+ description => 'Searches for bans, quiets, and channel modes affecting a user',
+ license => 'GPLv3+',
+);
+
+my($channel,$person,$nick,$user,$host,$real,$account,$string,$issues,$running,@jchannels,@jchannelstocheck,$debug);
+
+$running=0;
+
+sub bansearch {
+ my($data,$server,$witem) = @_;
+
+ if($running) {
+ Irssi::print("bansearch is already running.");
+ }
+
+ $running=1;
+ @jchannels=();
+ @jchannelstocheck=();
+
+ #Clear variables and register redirects
+ &reset();
+ $debug = Irssi::settings_get_bool('bansearch_debug');
+
+ #Split command arguments into a nick and a channel separated by a space
+ ($person,$channel)=split(/ /, $data, 2);
+
+ #If no channel is specified, use the current window if it is a channel
+ if($channel!~m/^#/ && $person!~m/^\s*$/ && $witem->{type} eq "CHANNEL") {
+ $channel=$witem->{name};
+ }
+
+ #Stop the script and display usage information if they did not specify a person or if we can't find a channel to use
+ if($channel!~m/^#/ || $person=~m/^\s*$/) {
+ Irssi::active_win()->print("\x02Usage\x02: /bansearch nick [#channel]");
+ $running=0;
+ return;
+ }
+
+ #Print the name of the channel we are running on
+ Irssi::active_win()->print("\x02Channel\x02: $channel");
+
+ #Perform a /who <user> %uhnar
+ $server->redirect_event('who',1, '', 0, undef,
+ {
+ 'event 352' => 'redir rpl_whoreply',
+ 'event 354' => 'redir rpl_whospcrpl',
+ 'event 315' => 'redir rpl_endofwho',
+ 'event 401' => 'redir err_nosuchnick',
+ '' => 'event empty',
+ }
+ );
+ $server->send_raw("WHO $person %uhnar");
+}
+#Irssi::signal_add('event empty', 'EMPTY');
+Irssi::signal_add('redir rpl_whoreply', 'RPL_WHOREPLY');
+Irssi::signal_add('redir rpl_whospcrpl', 'RPL_WHOSPCRPL');
+Irssi::signal_add('redir rpl_endofwho', 'RPL_ENDOFWHO');
+Irssi::signal_add('redir err_nosuchnick', 'ERR_NOSUCHNICK');
+Irssi::signal_add('redir err_nosuchchannel', 'ERR_NOSUCHCHANNEL');
+Irssi::signal_add('redir rpl_banlist', sub { my($server,$data) = @_; RPL_BANLIST($server, "Ban $data"); });
+Irssi::signal_add('redir rpl_endofbanlist', sub { my($server,$data) = @_; RPL_ENDOFBANLIST($server, "Ban $data"); });
+Irssi::signal_add('redir rpl_quietlist', sub { my($server,$data) = @_; RPL_BANLIST($server, "Quiet $data"); });
+Irssi::signal_add('redir rpl_endofquietlist', sub { my($server,$data) = @_; RPL_ENDOFBANLIST($server, "Quiet $data"); });
+Irssi::signal_add('redir rpl_channelmodeis', 'RPL_CHANNELMODEIS');
+
+sub EMPTY {
+ my($server, $data) = @_;
+
+ return if(!$running);
+
+ Irssi::print("\x02EMPTY\x02: $data");
+}
+
+sub RPL_BANLIST {
+ my($server, $data) = @_;
+
+ return if(!$running);
+
+ my($type, $mask, $setby, $banchannel, $jchannel);
+ if($data=~m/^Ban/) {
+ ($type, undef, $banchannel, $mask, $setby, undef) = split(/ /, $data, 6);
+ }
+ elsif($data=~m/^Quiet/) {
+ ($type, undef, $banchannel, undef, $mask, $setby, undef) = split(/ /, $data, 7);
+ }
+ my $maskreg = $mask;
+ $maskreg=~s/\$\#.*$//; #Support matching ban-forwards
+ $maskreg=~s/\./\\./g;
+ $maskreg=~s/\//\\\//g;
+ $maskreg=~s/\@/\\@/g;
+ $maskreg=~s/\[/\\[/g;
+ $maskreg=~s/\]/\\]/g;
+ $maskreg=~s/\|/\\|/g;
+ $maskreg=~s/\?/\./g;
+ $maskreg=~s/\*/\.\*\?/g;
+
+ #We only want to display who set the ban/quiet if it is listed as a person
+ if($setby!~m/!/) {
+ $setby='';
+ }
+ else {
+ $setby=" (Set by $setby)";
+ }
+
+ if($maskreg=~m/^\$/) { #extban
+ # account
+ if($maskreg=~m/^\$a:(.*?)$/i) {
+ if($account=~m/^$1$/i && $account!~m/^0$/) {
+ Irssi::active_win()->print("$type against \x02$mask\x02 in $banchannel matches $account" . $setby);
+ $issues++;
+ }
+ else {
+ Irssi::active_win()->print("$type against \x02$mask\x02 in $banchannel does NOT match $account" . $setby) if $debug;
+ }
+ }
+ # cannot join other channel
+ if($channel == $banchannel) {
+ if($maskreg=~m/^\$j:(.*?)$/i) {
+ $jchannel = $1;
+ if(!(grep {$jchannel eq $_} @jchannels)) {
+ push(@jchannels, $jchannel);
+ push(@jchannelstocheck, $jchannel);
+ Irssi::active_win()->print("Following bans in "
+ . $jchannel . " will " . $type . " " . $person . " in " . $channel . $setby);
+ }
+ }
+ }
+ # any logged-in user
+ if($maskreg=~m/^\$a$/i) {
+ if($account!~m/^0$/) {
+ Irssi::active_win()->print(
+ "$type against \x02$mask\x02 in $banchannel matches identified user" . $setby);
+ $issues++;
+ }
+ else {
+ Irssi::active_win()->print("$type against \x02$mask\x02 in $banchannel does NOT match unidentified user" . $setby) if $debug;
+ }
+ }
+ # any unidentified user
+ if($maskreg=~m/^\$\~a$/i) {
+ if($account=~m/^0$/) {
+ Irssi::active_win()->print(
+ "$type against \x02$mask\x02 in $banchannel matches unidentified user" . $setby);
+ $issues++;
+ }
+ else {
+ Irssi::active_win()->print("$type against \x02$mask\x02 in $banchannel does NOT match identified user" . $setby) if $debug;
+ }
+ }
+ # ircname
+ if($maskreg=~m/^\$r:(.*?)$/i) {
+ if($real=~m/^$1$/i) {
+ Irssi::active_win()->print(
+ "$type against \x02$mask\x02 in $banchannel matches real name of $real" . $setby);
+ $issues++;
+ }
+ else {
+ Irssi::active_win()->print("$type against \x02$mask\x02 in $banchannel does NOT match real name of $real" . $setby) if $debug;
+ }
+ }
+ # full match
+ if($maskreg=~m/^\$x:(.*?)$/i) {
+ my $full = "$nick!$user\@$host\#$real";
+ if($full=~m/^$1$/i) {
+ Irssi::active_win()->print(
+ "$type against \x02$mask\x02 in $banchannel matches $full" . $setby);
+ $issues++;
+ }
+ else {
+ Irssi::active_win()->print("$type against \x02$mask\x02 in $banchannel does NOT match $full" . $setby) if $debug;
+ }
+ }
+ }
+ else { #Normal Ban
+ if($string=~m/^$maskreg$/i) {
+ Irssi::active_win()->print("$type against \x02$mask\x02 in $banchannel matches $string" . $setby);
+ $issues++;
+ }
+ else {
+ Irssi::active_win()->print("$type against \x02$mask\x02 in $banchannel does NOT match $string" . $setby) if $debug;
+ }
+ }
+}
+
+sub RPL_ENDOFBANLIST {
+ my($server, $data) = @_;
+
+ return if(!$running);
+
+# Irssi::active_win()->print("End of Ban List");
+ if($data=~m/^Ban/) {
+ $server->redirect_event('mode q',1, $channel, 0, undef,
+ {
+ 'event 728' => 'redir rpl_quietlist',
+ 'event 729' => 'redir rpl_endofquietlist',
+ '' => 'event empty',
+ }
+ );
+ $server->send_raw("MODE $channel q");
+ }
+ elsif($data=~m/^Quiet/) {
+ if (@jchannelstocheck) {
+ my $nextchannel = pop(@jchannelstocheck);
+ $server->redirect_event('mode b',1, $nextchannel, 0, undef,
+ {
+ 'event 367' => 'redir rpl_banlist',
+ 'event 368' => 'redir rpl_endofbanlist',
+ 'event 403' => 'redir err_nosuchchannel',
+ '' => 'event empty',
+ }
+ );
+ $server->send_raw("MODE $nextchannel b");
+ } else {
+ $server->redirect_event('mode channel',1, $channel, 0, undef,
+ {
+ 'event 324' => 'redir rpl_channelmodeis',
+ '' => 'event empty',
+ }
+ );
+ $server->send_raw("MODE $channel");
+ }
+ }
+}
+
+sub RPL_WHOREPLY {
+ my($server, $data) = @_;
+
+ return if(!$running);
+
+ # 0 1 2 3 4 5 6 7 8
+ # bw2 * ~pi rpi1.my irc.example.net rpi1 H :0 real name
+ (undef, undef, $user, $host, undef, $nick, undef, undef, $real) = split(/ /, $data,9);
+ $account='';
+ $real=~s/^://;
+ Irssi::active_win()->print("\x02User\x02: $nick [$account] ($real) $user\@$host");
+}
+
+sub RPL_WHOSPCRPL {
+ my($server, $data) = @_;
+
+ return if(!$running);
+
+ # $server->send_raw("WHO $person %uhnar");
+ # 0 1 2 3 4 5
+ # bw2 ~bw1 irc.example.net bw1 bw2 :real name
+ (undef, $user, $host, $nick, $account, $real) = split(/ /, $data,6);
+ $real=~s/^://;
+ Irssi::active_win()->print("\x02User\x02: $nick [$account] ($real) $user\@$host");
+}
+
+sub RPL_ENDOFWHO {
+ my($server, $data) = @_;
+
+ return if(!$running);
+
+ if($nick=~m/^$/ && $user=~m/^$/ && $host=~m/^$/) {
+ Irssi::active_win()->print("$person is currently offline.");
+ return;
+ }
+ $string="$nick!$user\@$host";
+ $server->redirect_event('mode b',1, $channel, 0, undef,
+ {
+ 'event 367' => 'redir rpl_banlist',
+ 'event 368' => 'redir rpl_endofbanlist',
+ 'event 403' => 'redir err_nosuchchannel',
+ '' => 'event empty',
+ }
+ );
+ $server->send_raw("MODE $channel b");
+}
+
+sub ERR_NOSUCHNICK {
+ my($server, $data) = @_;
+
+ return if(!$running);
+
+ Irssi::active_win()->print("$person is currently offline.");
+ $running=0;
+}
+
+sub ERR_NOSUCHCHANNEL {
+ my($server, $data) = @_;
+
+ return if(!$running);
+
+ Irssi::active_win()->print("$channel does not exist.");
+ $running=0;
+}
+
+sub RPL_CHANNELMODEIS {
+ my($server, $data) = @_;
+
+ return if(!$running);
+
+ my(undef, undef, $modes, $args) = split(/ /, $data, 4);
+ Irssi::active_win()->print("\x02Channel Modes\x02: $modes");
+ if($modes=~m/i/) {
+ Irssi::active_win()->print("Channel is \x02invite-only\x02 (+i)");
+ $issues++;
+ }
+ if($modes=~m/k/) {
+ Irssi::active_win()->print("Channel has a \x02password\x02 (+k)");
+ $issues++;
+ }
+ if($modes=~m/r/) {
+ if($account=~m/^0$/) {
+ Irssi::active_win()->print("Channel is \x02blocking unidentified users\x02 (+r) and user is not identified");
+ $issues++;
+ }
+ }
+ if($modes=~m/m/) {
+ if($server->channel_find("$channel")) {
+ my $n = $server->channel_find("$channel")->nick_find("$nick");
+ if($n->{voice} == 0 && $n->{op} == 0) {
+ Irssi::active_win()->print("Channel is \x02moderated\x02 (+m) and user is not voiced or oped");
+ $issues++;
+ }
+ }
+ else {
+ Irssi::active_win()->print("Channel is \x02moderated\x02 (+m) and user might not be voiced or oped");
+ $issues++;
+ }
+ }
+
+ if($issues == 0) {
+ Irssi::active_win()->print("There does not appear to be anything preventing $person from joining/talking in $channel");
+ }
+ elsif ($issues == 1) {
+ Irssi::active_win()->print("There is \x02$issues issue\x02 that might be preventing $person from joining/talking in $channel");
+ }
+ else {
+ Irssi::active_win()->print("There are \x02$issues issues\x02 that might be preventing $person from joining/talking in $channel");
+ }
+ $running=0;
+}
+
+sub reset {
+
+ return if(!$running);
+
+ $channel='';
+ $person='';
+ $nick='';
+ $user='';
+ $host='';
+ $real='';
+ $account='';
+ $string='';
+ $issues=0;
+
+ &register_redirects();
+}
+
+sub register_redirects {
+
+ return if(!$running);
+
+ #who
+ Irssi::Irc::Server::redirect_register('who', 0, 0,
+ { "event 352" => 1, # start events
+ "event 354" => -1,
+ },
+ { # stop events
+ "event 315" => 1, # End of Who List
+ "event 401" => 1, # No Such Nick
+ },
+ undef, # optional events
+ );
+
+ #mode b
+ Irssi::Irc::Server::redirect_register('mode b', 0, 0,
+ { "event 367" => 1 }, # start events
+ { # stop events
+ "event 368" => 1, # End of channel ban list
+ "event 403" => 1, # no such channel
+ "event 442" => 1, # "you're not on that channel"
+ "event 479" => 1 # "Cannot join channel (illegal name)"
+ },
+ undef, # optional events
+ );
+
+ #mode q
+ Irssi::Irc::Server::redirect_register('mode q', 0, 0,
+ { "event 728" => 1 }, # start events
+ { # stop events
+ "event 729" => 1, # End of channel quiet list
+ "event 403" => 1, # no such channel
+ "event 442" => 1, # "you're not on that channel"
+ "event 479" => 1, # "Cannot join channel (illegal name)"
+ },
+ undef, # optional events
+ );
+
+ #mode channel
+ Irssi::Irc::Server::redirect_register('mode channel', 0, 0, undef,
+ { # stop events
+ "event 324" => 1, # MODE-reply
+ "event 403" => 1, # no such channel
+ "event 442" => 1, # "you're not on that channel"
+ "event 479" => 1 # "Cannot join channel (illegal name)"
+ },
+ { "event 329" => 1 } # Channel create time
+ );
+}
+
+Irssi::command_bind('bansearch', 'bansearch');
+Irssi::settings_add_bool('bansearch', 'bansearch_debug', 0);
+
+# vim:set ts=8 sw=4:
diff --git a/scripts/bantime.pl b/scripts/bantime.pl
new file mode 100644
index 0000000..bebb63a
--- /dev/null
+++ b/scripts/bantime.pl
@@ -0,0 +1,110 @@
+use strict;
+use Irssi; # developed using irssi 0.8.9.CVS
+
+# I recommend rebinding irssi's default 'BAN' to 'bantimes' (/alias BAN BANTIME)
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '1.03';
+%IRSSI = (
+ authors => "David O\'Rourke",
+ contact => "phyber [at] #irssi",
+ name => "bantime",
+ description => "Print time when ban was set in a nicer way. eg. 23m, 40s ago.",
+ license => "GPLv2",
+ changed => "02/03/2009",
+);
+
+sub duration {
+ my ($when) = @_;
+
+ my $diff = (time - $when);
+ my $day = int($diff / 86400); $diff -= ($day * 86400);
+ my $hrs = int($diff / 3600); $diff -= ($hrs * 3600);
+ my $min = int($diff / 60); $diff -= ($min * 60);
+ my $sec = $diff;
+
+ my $str;
+ $str .= "${day}d " if $day;
+ $str .= "${hrs}h " if $day or $hrs;
+ $str .= "${min}m " if $day or $hrs or $min;
+ $str .= "${sec}s"; # seconds should always be shown
+
+ return $str;
+}
+
+sub cmd_bans {
+ my ($args, $server, $witem) = @_;
+ return if not ($witem && $witem->{type} eq "CHANNEL");
+ my $channel = $witem->{name};
+
+ if (!$witem->bans()) {
+ $witem->printformat(
+ MSGLEVEL_CLIENTCRAP,
+ 'bantime_nobans',
+ $channel);
+ return;
+ }
+
+ my $count = 1;
+ foreach my $ban ($witem->bans()) {
+ if (!$ban->{setby} || !$ban->{time}) {
+ $witem->printformat(
+ MSGLEVEL_CLIENTCRAP,
+ 'bantime',
+ $count,
+ $channel,
+ $ban->{ban});
+ }
+ else {
+ my $bantime;
+ if (Irssi::settings_get_bool('bantime_show_date')) {
+ $bantime = localtime($ban->{time}) . ": ";
+ $bantime =~ s/\s+/ /g;
+ }
+ $bantime .= duration($ban->{time});
+ $witem->printformat(
+ MSGLEVEL_CLIENTCRAP,
+ 'bantime_long',
+ $count,
+ $channel,
+ $ban->{ban},
+ $ban->{setby},
+ $bantime);
+ }
+ $count++;
+ }
+}
+
+Irssi::theme_register([
+ 'bantime', '{line_start}$0 - {channel $1}: ban {ban $2}',
+ 'bantime_long', '{line_start}$0 - {channel $1}: ban {ban $2} {comment by {nick $3}, $4 ago}',
+ 'bantime_nobans', '{line_start}{hilight Irssi:} No bans in channel {channel $0}'
+]);
+Irssi::command_bind('bantime', 'cmd_bans');
+Irssi::print("Loaded $IRSSI{name} $VERSION");
+Irssi::settings_add_bool('bantime', 'bantime_show_date' => 0);
+
+#############
+# ChangeLog #
+#############
+# 02.03.2009: 1.03
+# Minor cosmetic changes to the script.
+# 28.02.2007: 1.03
+# duration() now returns a nicer string. Fields arn't visible if they're zero.
+# Random bits cleaned up.
+# 28.04.2005: 1.01
+# Removed redundant '$bantime2' variable, left over from a setting that was removed earlier.
+# 19.03.2005: 1.0
+# Removed dependancy on Time::Duration by using duration().
+# Removed obsolete 'bantime_short_format' setting.
+# Increased version to 1.0
+# 11.01.2004: Jan 11 2004: 04:30
+# Added new bantime_show_date setting. Displays the date the ban was set along with the time info.
+# 11.01.2004: Jan 11 2004: 04:05
+# Added new bantime_short_format setting. Displays the time in a nice short format. (#irssi: ban *!*@test.testing [by phyber, 3d 5h 54m 59s ago])
+# 11.01.2004: Jan 11 2004: 03:49
+# Changed handling bans without setby/time information closer to how irssi does.
+# 08.01.2004: Jan 08 2004: 02:46
+# Fixed a bug which occured if the IRCd didn't tell us who set the bans at which time. eg. IRCNet if a user doesn't have +o.
+# 08.01.2004: Jan 08 2004: 01:52
+# Initial Release. Many thanks to coekie for helping me with my scripting.
diff --git a/scripts/beep.pl b/scripts/beep.pl
new file mode 100644
index 0000000..0bc5c53
--- /dev/null
+++ b/scripts/beep.pl
@@ -0,0 +1,50 @@
+# $Id: beep.pl,v 1.9 2002/07/04 13:18:02 jylefort Exp $
+
+use strict;
+use Irssi 20020121.2020 ();
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.01";
+%IRSSI = (
+ authors => 'Jean-Yves Lefort',
+ contact => 'jylefort\@brutele.be, decadix on IRCNet',
+ name => 'beep',
+ description => 'Replaces your terminal bell by a command specified via /set; adds a beep_when_not_away setting',
+ license => 'BSD',
+ url => 'http://void.adminz.be/irssi.shtml',
+ changed => '$Date: 2002/07/04 13:18:02 $ ',
+);
+
+# /set's:
+#
+# beep_when_not_away opposite of builtin beep_when_away
+#
+# beep_command if not empty, the specified command will be
+# executed instead of the normal terminal bell
+# changes:
+#
+# 2002-07-04 release 1.01
+# * signal_add's uses a reference instead of a string
+#
+# 2002-04-25 release 1.00
+# * increased version number
+#
+# 2002-01-24 initial release
+
+sub beep {
+ my $server = Irssi::active_server;
+ if ($server && ! $server->{usermode_away}
+ && ! Irssi::settings_get_bool("beep_when_not_away")) {
+ Irssi::signal_stop();
+ } else {
+ if (my $command = Irssi::settings_get_str("beep_command")) {
+ system($command);
+ Irssi::signal_stop();
+ }
+ }
+}
+
+Irssi::settings_add_bool("lookandfeel", "beep_when_not_away", 0);
+Irssi::settings_add_str("misc", "beep_command",
+ "esdplay ~/sound/events/beep.wav &");
+
+Irssi::signal_add("beep", \&beep);
diff --git a/scripts/beep_beep.pl b/scripts/beep_beep.pl
new file mode 100644
index 0000000..2c139ab
--- /dev/null
+++ b/scripts/beep_beep.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/irssi
+#
+# irssi beep replace script (tested with irssi v0.8.8.CVS (20030126-1726))
+# (C) 2002-2004 Ge0rG@IRCnet (Georg Lukas <georg@op-co.de>)
+# inspired and tested by Macrotron@IRCnet (macrotron@president.eu.org)
+
+# added beep_flood to irssi settings: beep_cmd will be run not more often
+# then every $beep_flood milliseconds
+
+# fixed memory leak with timeout_add (made irssi waste 80mb and more after a day of IRC)
+# added > /dev/null, thx to Luis Oliveira
+# fixed timeout handling bug, thx to frizop@charter.net
+
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.10";
+%IRSSI = (
+ authors => "Georg Lukas",
+ contact => "georg\@op-co.de",
+ name => "beep_beep",
+ description => "runs arbitrary command instead of system beep, includes flood protection",
+ license => "Public Domain",
+ url => "http://op-co.de/irssi/",
+);
+
+use Irssi;
+
+my $might_beep = 1;
+my $to_tag;
+
+sub beep_overflow_timeout() {
+ $might_beep = 1;
+ Irssi::timeout_remove($to_tag);
+}
+
+sub beep_beep() {
+ my $beep_cmd = Irssi::settings_get_str("beep_cmd");
+ if ($beep_cmd) {
+ if ($might_beep) {
+ my $beep_flood = Irssi::settings_get_int('beep_flood');
+ $beep_flood = 1000 if $beep_flood < 0;
+ Irssi::timeout_remove($to_tag);
+ $to_tag = Irssi::timeout_add($beep_flood, 'beep_overflow_timeout', undef);
+ system($beep_cmd);
+ $might_beep = 0;
+ }
+ Irssi::signal_stop();
+ }
+}
+
+Irssi::settings_add_str("lookandfeel", "beep_cmd", "play ~/.irssi/scripts/beep_beep.wav > /dev/null &");
+Irssi::settings_add_int("lookandfeel", "beep_flood", 250);
+Irssi::signal_add("beep", "beep_beep");
+
diff --git a/scripts/beepaway.pl b/scripts/beepaway.pl
new file mode 100644
index 0000000..ade6e7b
--- /dev/null
+++ b/scripts/beepaway.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+#
+# by Simon 'corecode' Schuberty <corecode@corecode.ath.cx>
+
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "2018122301";
+%IRSSI = (
+ authors => "Simon 'corecode' Schubert",
+ contact => "corecode\@corecode.ath.cx",
+ name => "beepaway",
+ description => "Only beep when you are away",
+ license => "BSD",
+ changed => "$VERSION",
+);
+use Irssi 20020324;
+
+sub catch_away {
+ my $level;
+ my $server;
+ ($server) = @_;
+
+ if ($server->{usermode_away}) {
+ $level = Irssi::settings_get_str("beep_away_msg_level")
+ } else {
+ $level = Irssi::settings_get_str("beep_back_msg_level")
+ }
+# Irssi::print "%R>>%n setting levels ``$level''";
+ if ($level eq '' || $level =~ m/NONE/) {
+ $server->command("/^set -clear beep_msg_level ");
+ } else {
+ $server->command("/^set beep_msg_level ".$level);
+ }
+}
+
+Irssi::settings_add_str($IRSSI{name}, "beep_away_msg_level", "MSGS NOTICES DCC DCCMSGS HILIGHT");
+Irssi::settings_add_str($IRSSI{name}, "beep_back_msg_level", "NONE");
+
+Irssi::signal_add("away mode changed", "catch_away");
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' (c) '.$IRSSI{authors}.' loaded';
diff --git a/scripts/bestoiber.pl b/scripts/bestoiber.pl
new file mode 100644
index 0000000..7d9f68f
--- /dev/null
+++ b/scripts/bestoiber.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+#
+# by Stefan 'tommie' Tomanek
+
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "2003020801";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "BeStoiber",
+ description => "stoibers your messages",
+ license => "GPLv2",
+ url => "",
+ modules => "",
+ changed => "$VERSION",
+ commands => "bestoiber"
+);
+
+
+use Irssi 20020324;
+
+sub stoibern ($) {
+ my ($text) = @_;
+ my $result;
+ my $buffer;
+ foreach (split / /, $text) {
+ if (int(rand(4)) == 1) {
+ $result .= ' eehh, ';
+ } else {
+ $result .= ' ';
+ }
+ if (substr($_, 0,1) =~ /[A-Z]+/ && int(rand(2)) == 1) {
+ my @buzzwords = split(/,/, Irssi::settings_get_str('bestoiber_buzzwords'));
+ $result .= $buzzwords[rand(scalar(@buzzwords))].", ";
+ }
+ if (int(rand(6)) == 1) {
+ $result =~ s/,?\ $//;
+ $result .= ", ".$buffer." " if $buffer;
+ }
+
+ $result .= $_;
+ $buffer = $_;
+ }
+ $result =~ s/^ //;
+ return $result;
+}
+
+sub cmd_bestoiber ($$$) {
+ my ($arg, $server, $witem) = @_;
+ if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) {
+ $witem->command('MSG '.$witem->{name}.' '.stoibern($arg));
+ } else {
+ print CLIENTCRAP "%B>>%n ".stoibern($arg);
+ }
+}
+
+Irssi::settings_add_str($IRSSI{name}, 'bestoiber_buzzwords', 'Arbeitslose,Fr. Merkel,Schröder');
+
+Irssi::command_bind('bestoiber', \&cmd_bestoiber);
diff --git a/scripts/bgta.pl b/scripts/bgta.pl
new file mode 100644
index 0000000..3b388e3
--- /dev/null
+++ b/scripts/bgta.pl
@@ -0,0 +1,284 @@
+#!/usr/local/bin/perl
+
+# BgTA SCRIPT
+
+use strict;
+use vars qw($VERSION %IRSSI %FEATURES);
+
+use Irssi;
+
+# Define Script Version
+$VERSION = '0.0.1';
+%IRSSI = (
+ authors => '[^BgTA^]',
+ contact => 'raul@bgta.net',
+ name => 'BgTA Script',
+ description => 'Byte\'s Gallery of the TAilor Script',
+ license => 'Public Domain',
+);
+
+# /bgversion command
+
+sub cmd_bgversion {
+ my ($data, $server, $witem) = @_;
+
+ print("\cC4BgTA Script v. ".$VERSION);
+ foreach my $key (sort keys %IRSSI) {
+ print("\cC4$key: \cC0".$IRSSI{$key}) unless $key =~ /name/i;
+ }
+ return 1;
+}
+
+Irssi::command_bind bgversion => \&cmd_bgversion;
+
+# /bghelp command
+$FEATURES{'help'} = "/bghelp \c0 List the BgTA Script FEATURES";
+
+sub cmd_bghelp {
+ my ($data, $server, $witem) = @_;
+
+ print("\cC4BgTA Script v. ".$VERSION);
+ foreach my $key (sort keys %FEATURES) {
+ print("\cC4$key: \cC0".$FEATURES{$key}) unless $key =~ /name/i;
+ }
+ return 1;
+}
+
+Irssi::command_bind bghelp => \&cmd_bghelp;
+# GOOGLE
+$FEATURES{'google'} = "/bggoogle \cC7search_string \t \cC5Search one result in Google.com";
+
+sub cmd_bggoogle {
+ my ($data, $server, $witem) = @_;
+
+ return unless $witem;
+
+
+ use Net::Google;
+
+ # Put here the Google Key. See Google->Tools & Services
+ use constant LOCAL_GOOGLE_KEY => "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX";
+
+ $witem->command("me Google Searching [$data]...");
+ my $google = Net::Google->new(key=>LOCAL_GOOGLE_KEY);
+
+ my $search = $google->search(max_results => 100);
+
+ $search->query($data);
+
+ my @tresults = @{$search->results()};
+
+ if(!defined($tresults[0])) {
+ $witem->command("me NO RESULTS");
+ return;
+ }
+ my $title = $tresults[0]->title();
+ $title =~ s/<[^<]*>//ig;
+ $witem->command("me ".$title."\cC2: ".$tresults[0]->URL());
+ return;
+}
+
+Irssi::command_bind bggoogle => \&cmd_bggoogle;
+
+# PHP Documentation
+$FEATURES{'php'} = "/bgphp \cC7function_name \t \cC5Search a PHP Function URL and Definition";
+$FEATURES{'phpwb'} = "/bgphpwb \cC7function_name \t \cC5Search a PHP Function URL and Definition AND Kick BAN With the URL";
+sub cmd_bgphp {
+
+ my ($data, $server, $witem) = @_;
+
+ return unless $witem;
+
+
+ use LWP;
+
+ my $Navigator = new LWP::UserAgent({
+ "agent" => "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)",
+ "timeout" => "180",
+ });
+
+ $data =~ s/\_/\-/ig;
+
+ my $Page = $Navigator->get('http://www.php.net/manual/es/function.'.$data.'.php');
+
+ my $content = $Page->content if $Page->is_success;
+ if($Page->is_success && $content =~ /([^<]*)<B\nCLASS=\"methodname\"\n>([^<]*)<\/B\n> ([^<]*)/i) {
+ $witem->command("me PHP Function $data:");
+ $witem->command("me Location: \cC5 http://www.php.net/manual/es/function.".$data.'.php');
+ if($content =~ /<td><a href=\"ref.([^\.]*).php\">/i) {
+ $witem->command("me Reference: \cC6 http://www.php.net/manual/es/ref.$1.php");
+ }
+ if($content =~ />([^<]*)<B\nCLASS=\"methodname\"\n>([^<]*)<\/B\n> ([^<]*)/i) {
+ $witem->command("me $1\cC0$2\cC $3");
+ }
+ if($content =~ /--\&nbsp;([A-Za-z0-9\ áéíóú\n]+)/i) {
+ my $sal = $1;
+ $sal =~ s/\ \ /\ /gi;
+ $sal =~ s/\n/\ /gi;
+ chomp($sal);
+ $witem->command("me Description: $sal");
+ }
+ } else {
+ $witem->command("me \cC5PHP Function $data: No Results.");
+ }
+
+ return;
+
+}
+
+sub cmd_bgphpwb {
+
+ my ($data, $server, $witem) = @_;
+
+ return unless $witem;
+
+
+ use LWP;
+
+ my $Navigator = new LWP::UserAgent({
+ "agent" => "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)",
+ "timeout" => "180",
+ });
+
+ $data =~ /^([^\ ]*) (.*)$/i;
+ my $nick = $1;
+ $data = $2;
+ $data =~ s/\_/\-/ig;
+
+ my $Page = $Navigator->get('http://www.php.net/manual/es/function.'.$data.'.php');
+
+ my $content = $Page->content if $Page->is_success;
+ if($Page->is_success && $content =~ /([^<]*)<B\nCLASS=\"methodname\"\n>([^<]*)<\/B\n> ([^<]*)/i) {
+ $witem->command("kickban $nick Mira el Jodido Manual: \cC5 http://www.php.net/manual/es/function.".$data.'.php');
+ }
+
+ return;
+
+}
+sub bgphpevent {
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $text) = $data =~ /^(\S*)\s:(.*)/;
+
+ #if($text =~ /bgphp:(.*)$/) {
+ #}
+
+}
+Irssi::signal_add("event notice", "bgphpevent");
+Irssi::command_bind bgphp => \&cmd_bgphp;
+Irssi::command_bind bgphpwb => \&cmd_bgphpwb;
+
+
+# WEB SEARCH TITLE
+$FEATURES{'wwwd'} = "/bgwwwd \cC7http://some.web.com/ \t \cC5Look for title and Description of Web";
+sub cmd_bgwwwd {
+
+ my ($data, $server, $witem) = @_;
+
+ return unless $witem;
+
+
+ use LWP;
+
+ my $Navigator = new LWP::UserAgent({
+ "agent" => "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)",
+ "timeout" => "180",
+ });
+
+ my $Page = $Navigator->get($data);
+
+ if($Page->is_success) {
+ my $content = $Page->content;
+ my $title = "No Title";
+ my $description = "No Description Page";
+
+ if($content =~ /TITLE>([^<]*)<\/TITLE>/i) {
+ $title = $1;
+ }
+
+ if($content =~ /META NAME=\"DESCRIPTION\" CONTENT=\"([^\"]*)\"/i) {
+ $description = $1;
+ }
+ $witem->command("me [ $data ]: ".$title);
+ $witem->command("me \cC5 $description");
+ } else {
+ $witem->command("me [ $data ] Page Not Found");
+ }
+}
+
+Irssi::command_bind bgwwwd => \&cmd_bgwwwd;
+
+
+# Perl Documentation
+$FEATURES{'perl'} = "/bgperl \cC7function_name \t \cC5Search a Perl Function URL and Definition";
+sub cmd_bgperl {
+
+ my ($data, $server, $witem) = @_;
+
+ return unless $witem;
+
+
+ use LWP;
+
+ my $Navigator = new LWP::UserAgent({
+ "agent" => "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)",
+ "timeout" => "180",
+ });
+
+ my $Page = $Navigator->get('http://www.perldoc.com/perl5.8.0/pod/func/'.$data.'.html');
+
+ my $content = $Page->content if $Page->is_success;
+ if($Page->is_success && $content =~ /<span class=\"docTitle\">([^<]*)<\/span>/i) {
+ $witem->command("me Perl Function $data:");
+ $witem->command("me Location: \cC5 http://www.perldoc.com/perl5.8.0/pod/func/".$data.'.html');
+ if($content =~ /<DL><DT><A NAME=\"[^\"]*\">(.*)\n/i) {
+ $witem->command("me \cC0$1");
+ }
+ if($content =~ /<DT><A NAME=\"$data\">$data\n\n<\/A><\/DT>\n<DD>\n([^\n]*)/i) {
+ $witem->command("me $1");
+ }
+ } else {
+ $witem->command("me \cC5Perl Function $data: No Results.");
+ }
+
+ return;
+
+}
+Irssi::command_bind bgperl => \&cmd_bgperl;
+
+# Debian Search Packages
+$FEATURES{'debian'} = "/bgdebian \cC7package name | \cC5Search a package in a Debian stable distribution";
+sub cmd_bgdebian {
+
+ my ($data, $server, $witem) = @_;
+
+ return unless $witem;
+
+
+ use LWP;
+
+ my $Navigator = new LWP::UserAgent({
+ "agent" => "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)",
+ "timeout" => "180",
+ });
+
+ $data =~ s/\ /\+/;
+ my $Page = $Navigator->get('http://packages.debian.org/cgi-bin/search_packages.pl?keywords='.$data.'&searchon=names&subword=1&version=stable&release=all');
+
+ my $content = $Page->content if $Page->is_success;
+ if($Page->is_success && $content =~ /<TD><B><A HREF=\"http:\/\/packages\.debian\.org\/stable\/misc\/([^\.]*).html\"> $data/i) {
+ $witem->command("me Debian \cC2$data\cC package:");
+ $witem->command("me Location: \cC5 http://packages.debian.org/stable/misc/$1.html");
+ if($content =~ /<TD COLSPAN=2>([^<]*)</i) {
+ $witem->command("me Description: $1");
+ }
+ } else {
+ $witem->command("me \cC5Debian $data package: No Results.");
+ }
+
+ return;
+
+}
+Irssi::command_bind bgdebian => \&cmd_bgdebian;
+1;
+
+
diff --git a/scripts/binary.pl b/scripts/binary.pl
new file mode 100644
index 0000000..1eb374a
--- /dev/null
+++ b/scripts/binary.pl
@@ -0,0 +1,114 @@
+# /binary huora
+# tuolostaa k.o. ikkunaan huora:n sijaan 01101001 ....
+#
+# and modified by carl 2004-03-09
+
+# Changelog
+# Version 1: original version by nchip
+# Version 1.1: added unbinary function
+# Verison 1.2: added server truncate detection (requested by André, thanks for spotting the problem) and choice to have spaces in the binary or not (reqested by Tapio)
+
+
+use strict;
+use Irssi;
+use Irssi qw(command_bind command signal_add_last signal_stop settings_get_bool settings_add_bool);
+
+use vars qw($VERSION %IRSSI);
+
+#%IRSSI = (
+# authors => "Riku Voipio",
+# contact => "riku.voipio\@iki.fi",
+# name => "binary",
+# description => "adds /binary command that converts what you type into 2-base string representation",
+# license => "GPLv2",
+# url => "http://nchip.ukkosenjyly.mine.nu/irssiscripts/",
+# );
+
+$VERSION = "1.2";
+%IRSSI = (
+ authors => "Carl Fischer",
+ contact => "carl.fischer\@netcourrier.com",
+ name => "binary",
+ description => "adds /binary command that converts what you type into 2-base string representation, also decodes other peoples binary automatically",
+ license => "GPLv2",
+ );
+
+
+sub cmd_binary {
+ $_=join(" ",$_[0]);
+ $_=reverse;
+ my (@r);
+ if (settings_get_bool('binary_spaces')) {
+ $r[0]="/say";
+ } else {
+ $r[0]="/say ";
+ }
+ while ($a = chop($_)) {
+ push (@r,unpack ("B*", $a));}
+
+ my $window = Irssi::active_win();
+ if (settings_get_bool('binary_spaces')) {
+ $window->command(join (" ",@r));
+ } else {
+ $window->command(join ("",@r));
+ }
+ }
+
+# here ends the original code
+# some of the following was strongly inspired by the kenny script
+
+sub cmd_unbinary {
+ pop @_;
+ pop @_;
+ my $window = Irssi::active_win();
+ $window->print(unbinary($_[0]));
+}
+
+sub unbinary {
+ my $r;
+ if (settings_get_bool('binary_spaces')) {
+ $r=pack("B*", join ("", split(" ", @_[0])));
+ } else {
+ $r=pack("B*", @_[0]);
+ }
+ return $r;
+}
+
+sub sig_binary {
+ my ($server, $msg, $nick, $address, $target) = @_;
+ if (($msg=~m/^([01]{8}( [01]{8})*)( [01]{1,7})*$/ and settings_get_bool('binary_spaces')) or ($msg=~m/^([01]{8}([01]{8})*)([01]{1,7})*$/ and not settings_get_bool('binary_spaces'))) {
+ my $leftover="";
+ $leftover="* (truncated by server)" if $3;
+ $target=$nick if $target eq "";
+ # the address may _never_ be emtpy, if it is its own_public
+ $nick=$server->{'nick'} if $address eq "";
+ $server->window_item_find($target)->print("[binary] <$nick> " .
+ unbinary($1) . $leftover, 'MSGLEVEL_CRAP');
+ signal_stop() if not settings_get_bool('show_binary_too');
+ }
+}
+
+signal_add_last('message own_public', 'sig_binary');
+signal_add_last('message public', 'sig_binary');
+signal_add_last('message own_private', 'sig_binary');
+signal_add_last('message private', 'sig_binary');
+
+settings_add_bool('lookandfeel', 'show_binary_too', 0);
+settings_add_bool('lookandfeel', 'binary_spaces', 1);
+
+Irssi::command_bind('binary', 'cmd_binary');
+Irssi::command_bind('unbinary', 'cmd_unbinary');
+
+Irssi::print("binary obfuscator vanity script loaded");
+Irssi::print("written by nchip and updated by carl");
+Irssi::print("--------------------------------------");
+Irssi::print("/binary message");
+Irssi::print("will send binary text to the current channel");
+Irssi::print("");
+Irssi::print("/unbinary obfuscated_text");
+Irssi::print("will print the unobfuscated equivalent to your window (and not to the channel)");
+Irssi::print("");
+Irssi::print("/set show_binary_too on");
+Irssi::print("will make this script print the binary equivalent as well as the translation to your screen whenever someone uses binary on the channel");
+Irssi::print("/set binary_spaces off");
+Irssi::print("will make the binary be printed as a single word with no spaces");
diff --git a/scripts/bitlbee_blist.pl b/scripts/bitlbee_blist.pl
new file mode 100644
index 0000000..864001f
--- /dev/null
+++ b/scripts/bitlbee_blist.pl
@@ -0,0 +1,77 @@
+# Changelog
+#
+# 2008-09-13 (v 0.5)
+# Thanks to Olof Johansson the first parm can just be a regexp.
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '0.5';
+%IRSSI = (
+ authors => 'Tijmen "timing" Ruizendaal',
+ contact => 'tijmen.ruizendaal@gmail.com',
+ name => 'bitlbee_blist',
+ description => '/blist <all|online|offline|away|word> <word>, greps <word> from blist for bitlbee',
+ license => 'GPLv2',
+ url => 'http://the-timing.nl/stuff/irssi-bitlbee',
+ changed => '2008-09-13',
+);
+
+my $bitlbee_server_tag = "localhost";
+my $bitlbee_channel = "&bitlbee";
+my ($list, $word);
+
+get_channel();
+
+Irssi::signal_add_last 'channel sync' => sub {
+ my( $channel ) = @_;
+ if( $channel->{topic} eq "Welcome to the control channel. Type \x02help\x02 for help information." ){
+ $bitlbee_server_tag = $channel->{server}->{tag};
+ $bitlbee_channel = $channel->{name};
+ }
+};
+
+sub get_channel {
+ my @channels = Irssi::channels();
+ foreach my $channel(@channels) {
+ if ($channel->{topic} eq "Welcome to the control channel. Type \x02help\x02 for help information.") {
+ $bitlbee_channel = $channel->{name};
+ $bitlbee_server_tag = $channel->{server}->{tag};
+ return 1;
+ }
+ }
+ return 0;
+}
+
+sub blist {
+ my ($args, $server, $winit) = @_;
+ ($list, $word) = split(/ /, $args, 2);
+ ($word, $list) = ($list, $word) unless $word;
+ $list=lc $list;
+ $word=lc $word;
+ if($list ne "all" && $list ne "online" && $list ne "offline" &&
+ $list ne "away" && $list ne "") {
+ $word=$list;
+ $list="";
+ }
+ if (Irssi::active_win->{'active'}->{'name'} eq $bitlbee_channel) {
+ print "blist $list";
+ Irssi::active_win()->command("msg $bitlbee_channel blist $list");
+ Irssi::signal_add('event privmsg', 'grep');
+ } else {
+ print "Only use in $bitlbee_channel.";
+ }
+}
+
+sub grep {
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $text) = split(/ :/, $data, 2);
+ $text=lc $text;
+ if ($text =~ /$word/ && $target =~ /$bitlbee_channel/){
+ ##do nothing
+ } else {Irssi::signal_stop();}
+ if ($text =~ /buddies/ && $target =~/$bitlbee_channel/){Irssi::signal_remove('event privmsg', 'grep');}
+}
+
+Irssi::command_bind('blist','blist');
diff --git a/scripts/bitlbee_join_notice.pl b/scripts/bitlbee_join_notice.pl
new file mode 100644
index 0000000..53bfdfc
--- /dev/null
+++ b/scripts/bitlbee_join_notice.pl
@@ -0,0 +1,109 @@
+# CHANGELOG:
+#
+# 2010-08-10 (version 1.3)
+# * new bitlbee server detection
+#
+# 2004-11-28:
+# * adds join message to query
+#
+# /statusbar window add join_notice
+# use Data::Dumper;
+
+use strict;
+use Irssi::TextUI;
+#use Irssi::Themes;
+use Data::Dumper;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.3';
+%IRSSI = (
+ authors => 'Tijmen "timing" Ruizendaal',
+ contact => 'tijmen.ruizendaal@gmail.com',
+ name => 'BitlBee_join_notice',
+ description => '1. Adds an item to the status bar wich shows [joined: <nicks>] when someone is joining &bitlbee. 2. Shows join messages in the query. (For bitlbee v3.0+)',
+ sbitems => 'join_notice',
+ license => 'GPLv2',
+ url => 'http://the-timing.nl/stuff/irssi-bitlbee',
+ changed => '2010-08-10'
+);
+my %timers;
+my $bitlbee_server; # server object
+my @control_channels; # mostly: &bitlbee, &facebook etc.
+init();
+
+sub init { # if script is loaded after connect
+ my @servers = Irssi::servers();
+ foreach my $server(@servers) {
+ if( $server->isupport('NETWORK') eq 'BitlBee' ){
+ $bitlbee_server = $server;
+ my @channels = $server->channels();
+ foreach my $channel(@channels) {
+ if( $channel->{mode} =~ /C/ ){
+ push @control_channels, $channel->{name} unless (grep $_ eq $channel->{name}, @control_channels);
+ }
+ }
+ }
+ }
+}
+# if connect after script is loaded
+Irssi::signal_add_last('event 005' => sub {
+ my( $server ) = @_;
+ if( $server->isupport('NETWORK') eq 'BitlBee' ){
+ $bitlbee_server = $server;
+ }
+});
+# if new control channel is synced after script is loaded
+Irssi::signal_add_last('channel sync' => sub {
+ my( $channel ) = @_;
+ if( $channel->{mode} =~ /C/ && $channel->{server}->{tag} eq $bitlbee_server->{tag} ){
+ push @control_channels, $channel->{name} unless (grep $_ eq $channel->{name}, @control_channels);
+ }
+});
+
+# BEGIN bitlbee_join_notice.pl
+
+my %online;
+
+sub event_join {
+ my ($server, $channel, $nick, $address) = @_;
+ $channel =~ s/^://g;
+ if ( (grep $_ eq $channel, @control_channels) && $server->{tag} eq $bitlbee_server->{tag}){
+ $online{$nick} = 1;
+ Irssi::timeout_remove($timers{$nick});
+ delete($timers{$nick});
+ $timers{$nick} = Irssi::timeout_add_once(7000, 'empty', $nick);
+ Irssi::statusbar_items_redraw('join_notice');
+ my $window = Irssi::window_find_item($nick);
+ if($window){
+ $window->printformat(Irssi::MSGLEVEL_JOINS, 'join', $nick, $address, $channel);
+ }
+ }
+}
+sub join_notice {
+ my ($item, $get_size_only) = @_;
+ my $line;
+ foreach my $key (keys(%online) ){
+ $line = $line." ".$key;
+ }
+ if ($line ne "" ){
+ $item->default_handler($get_size_only, "{sb joined:$line}", undef, 1);
+ $line = "";
+ } else {
+ $item->default_handler($get_size_only, "", undef, 1);
+ }
+}
+sub empty {
+ my $nick = shift;
+ delete($online{$nick});
+ Irssi::timeout_remove($timers{$nick});
+ delete($timers{$nick});
+ Irssi::statusbar_items_redraw('join_notice');
+}
+
+Irssi::signal_add('event join', 'event_join' );
+Irssi::statusbar_item_register('join_notice', undef, 'join_notice');
+Irssi::statusbars_recreate_items();
+Irssi::theme_register([ 'join', '{channick_hilight $0} {chanhost $1} has joined {channel $2}', ]);
+
+# END bitlbee_join_notice.pl
diff --git a/scripts/bitlbee_nick_change.pl b/scripts/bitlbee_nick_change.pl
new file mode 100644
index 0000000..93a01b9
--- /dev/null
+++ b/scripts/bitlbee_nick_change.pl
@@ -0,0 +1,72 @@
+use strict;
+use Data::Dumper;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.3';
+%IRSSI = (
+ authors => 'Tijmen "timing" Ruizendaal',
+ contact => 'tijmen.ruizendaal@gmail.com',
+ name => 'BitlBee_nick_change',
+ description => 'Shows an IM nickchange in an Irssi way. (in a query and in the bitlbee channel). (For bitlbee 3.0+)',
+ license => 'GPLv2',
+ url => 'http://the-timing.nl/stuff/irssi-bitlbee',
+ changed => '2010-07-28'
+);
+
+my $bitlbee_server; # server object
+my @control_channels; # mostly: &bitlbee, &facebook etc.
+init();
+
+sub init { # if script is loaded after connect
+ my @servers = Irssi::servers();
+ foreach my $server(@servers) {
+ if( $server->isupport('NETWORK') eq 'BitlBee' ){
+ $bitlbee_server = $server;
+ my @channels = $server->channels();
+ foreach my $channel(@channels) {
+ if( $channel->{mode} =~ /C/ ){
+ push @control_channels, $channel->{name} unless (grep $_ eq $channel->{name}, @control_channels);
+ }
+ }
+ }
+ }
+}
+# if connect after script is loaded
+Irssi::signal_add_last('event 005' => sub {
+ my( $server ) = @_;
+ if( $server->isupport('NETWORK') eq 'BitlBee' ){
+ $bitlbee_server = $server;
+ }
+});
+# if new control channel is synced after script is loaded
+Irssi::signal_add_last('channel sync' => sub {
+ my( $channel ) = @_;
+ if( $channel->{mode} =~ /C/ && $channel->{server}->{tag} eq $bitlbee_server->{tag} ){
+ push @control_channels, $channel->{name} unless (grep $_ eq $channel->{name}, @control_channels);
+ }
+});
+
+# BEGIN bitlbee_nick_change.pl
+
+sub event_notice {
+ my ($server, $msg, $nick, $address, $target) = @_;
+ if( $server->{tag} eq $bitlbee_server->{tag} && $msg =~ /.*Changed name to.*/ ){
+ my $friendly_name = $msg;
+ $friendly_name =~ s/.*Changed name to `(.*)'.*/$1/;
+ my $window = $server->window_find_item($nick);
+ if ($window) {
+ $window->printformat(MSGLEVEL_CRAP, 'nick_change', $nick, $address, 'changed name to `'.$friendly_name.'`');
+ Irssi::signal_stop();
+ } else {
+ # TODO find control channel where this user is located and display the notice there
+ #my $window = $server->window_find_item($bitlbee_channel);
+ #$window->printformat(MSGLEVEL_CRAP, 'nick_change', $nick, $address, 'changed name to `'.$friendly_name.'`');
+ #Irssi::signal_stop();
+ }
+ }
+};
+
+Irssi::signal_add_last('message irc notice', 'event_notice');
+Irssi::theme_register(['nick_change', '{channick_hilight $0} [$1] $2']);
+
+# END bitbee_nick_change.pl
diff --git a/scripts/bitlbee_tab_completion.pl b/scripts/bitlbee_tab_completion.pl
new file mode 100644
index 0000000..8d19128
--- /dev/null
+++ b/scripts/bitlbee_tab_completion.pl
@@ -0,0 +1,88 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.3';
+
+%IRSSI = (
+ authors => 'Tijmen "timing" Ruizendaal & Wilmer van der Gaast',
+ contact => 'tijmen.ruizendaal@gmail.com',
+ name => 'BitlBee_tab_completion',
+ description => 'Intelligent Tab-completion for BitlBee commands.',
+ license => 'GPLv2',
+ url => 'http://the-timing.nl/stuff/irssi-bitlbee',
+ changed => '2009-08-11',
+);
+
+my $root_nick = 'root';
+my $bitlbee_channel = '&bitlbee';
+my $bitlbee_server_tag = 'localhost';
+my $get_completions = 0;
+
+my @commands;
+
+Irssi::signal_add_last 'channel sync' => sub {
+ my( $channel ) = @_;
+ if( $channel->{topic} eq "Welcome to the control channel. Type \x02help\x02 for help information." ){
+ $bitlbee_server_tag = $channel->{server}->{tag};
+ $bitlbee_channel = $channel->{name};
+ request_completions();
+ }
+};
+
+if (get_channel()) {
+ request_completions();
+}
+
+sub request_completions {
+ $get_completions = 1;
+ Irssi::server_find_tag($bitlbee_server_tag)->send_raw( 'COMPLETIONS' );
+}
+
+sub get_channel {
+ my @channels = Irssi::channels();
+ foreach my $channel(@channels) {
+ if ($channel->{topic} eq "Welcome to the control channel. Type \x02help\x02 for help information.") {
+ $bitlbee_channel = $channel->{name};
+ $bitlbee_server_tag = $channel->{server}->{tag};
+ return 1;
+ }
+ }
+ return 0;
+}
+
+sub irc_notice {
+ return unless $get_completions;
+ my( $server, $msg, $from, $address, $target ) = @_;
+
+ if( $msg =~ s/^COMPLETIONS // ) {
+ $root_nick = $from;
+ if( $msg eq 'OK' ) {
+ @commands = ();
+ }
+ elsif( $msg eq 'END' ) {
+ $get_completions = 0;
+ }
+ @commands = ( @commands, $msg );
+
+ Irssi::signal_stop();
+ }
+}
+
+sub complete_word {
+ my ($complist, $window, $word, $linestart, $want_space) = @_;
+ my $channel = $window->get_active_name();
+ if ($channel eq $bitlbee_channel or $channel eq $root_nick or $linestart =~ /^\/(msg|query) \Q$root_nick\E */i){
+ $linestart =~ s/^\/(msg|query) \Q$root_nick\E *//i;
+ $linestart =~ s/^\Q$root_nick\E[:,] *//i;
+ foreach my $command(@commands) {
+ if ($command =~ /^$word/i) {
+ push @$complist, $command;
+ }
+ }
+ }
+}
+
+
+Irssi::signal_add_last('complete word', 'complete_word');
+Irssi::signal_add_first('message irc notice', 'irc_notice');
+
diff --git a/scripts/bitlbee_typing_notice.pl b/scripts/bitlbee_typing_notice.pl
new file mode 100644
index 0000000..10cd746
--- /dev/null
+++ b/scripts/bitlbee_typing_notice.pl
@@ -0,0 +1,349 @@
+# INSTALLATION
+# [&bitlbee] set typing_notice true
+# <@root> typing_notice = `true'
+# AND
+# /statusbar window add typing_notice
+#
+# SETTINGS
+# [bitlbee]
+# bitlbee_send_typing = ON
+# -> send typing messages to buddies
+# bitlbee_typing_allwin = OFF
+# -> show typing notifications in all windows
+#
+#
+# Changelog:
+#
+# 2016-01-01 (version 1.7.2)
+# * Fix crash in Irssi during disconnect
+#
+# 2010-08-09 (version 1.7.1)
+# * Multiple control channels supported by checking chanmodes
+#
+# 2010-07-27 (version 1.7)
+# * Using new server detection for latest BitlBee support
+#
+# 2010-07-26 (version 1.6.3)
+# * Removed checking if nicks exists in &bitlbee channel, this because BitlBee
+# can be used without control channel from this date
+#
+# 2007-03-03 (version 1.6.2)
+# * Fix: timers weren't deleted correctly. This resulted in huge mem usage.
+#
+# 2006-11-02 (version 1.6.1)
+# * Sending typing works again.
+#
+# 2006-10-27 (version 1.6)
+# * 'channel sync' re-implemented.
+# * bitlbee_send_typing was a string setting, It's a boolean now, like it should.
+#
+# 2006-10-24 (version 1.5)
+# * Sending notices to online users only. ( removed this again at 2010-07-26, see above )
+# * Using the new get_channel function;
+#
+# 2005-12-15 (version 1.42):
+# * Fixed small bug with typing notices disappearing under certain circumstances
+# in channels
+# * Fixed bug that caused outgoing notifications not to work
+# * root cares not about our typing status.
+#
+# 2005-12-04 (version 1.41):
+# * Implemented stale states in statusbar (shows "(stale)" for OSCAR connections)
+# * Introduced bitlbee_typing_allwin (default OFF). Set this to ON to make
+# typing notifications visible in all windows.
+#
+# 2005-12-03 (version 1.4):
+# * Major code cleanups and rewrites for bitlbee 1.0 with the updated typing
+# scheme. TYPING 0, TYPING 1, and TYPING 2 are now supported from the server.
+# * Stale states (where user has typed in text but has stopped typing) are now
+# recognized.
+# * Bug where user thinks you are still typing if you close the window after
+# typing something and then erasing it quickly.. fixed.
+# * If a user signs off while they are still typing, the notification is removed
+# This update by Matt "f0rked" Sparks
+#
+# 2005-08-26:
+# Some fixes for AIM, Thanks to Dracula.
+#
+# 2005-08-16:
+# AIM supported, for sending notices, using CTCP TYPING 0. (Use the AIM patch from Hanji http://get.bitlbee.org/patches/)
+#
+# 2004-10-31:
+# Sends typing notice to the bitlbee server when typing a message in irssi. bitlbee > 0.92
+#
+# 2004-06-11:
+# shows [typing: ] in &bitlbee with multiple users.
+#
+use strict;
+use Irssi::TextUI;
+use Data::Dumper;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.7.3';
+%IRSSI = (
+ authors => 'Tijmen "timing" Ruizendaal, Matt "f0rked" Sparks',
+ contact => 'tijmen.ruizendaal@gmail.com, root@f0rked.com',
+ name => 'BitlBee_typing_notice',
+ description => '1. Adds an item to the status bar wich shows [typing] when someone is typing a message on the supported IM-networks 2. Sends typing notices to the supported IM networks (the other way arround). (For bitlbee 3.0+)',
+ sbitems => 'typing_notice',
+ license => 'GPLv2',
+ url => 'http://the-timing.nl/stuff/irssi-bitlbee, http://f0rked.com',
+);
+
+my %bitlbee_tag; # server object
+my %control_channels; # mostly: &bitlbee, &facebook etc.
+init();
+
+sub init { # if script is loaded after connect
+ my @servers = Irssi::servers();
+ foreach my $server(@servers) {
+ if( $server->isupport('NETWORK') eq 'BitlBee' ){
+ my $T = $server->{tag};
+ $bitlbee_tag{$T} = 1;
+ my @channels = $server->channels();
+ foreach my $channel(@channels) {
+ if( $channel->{mode} =~ /C/ ){
+ push @{ $control_channels{$T} }, $channel->{name} unless (grep $_ eq $channel->{name}, @{ $control_channels{$T} // [] });
+ }
+ }
+ }
+ }
+}
+# if connect after script is loaded
+Irssi::signal_add_last('event 005' => sub {
+ my( $server ) = @_;
+ if( $server->isupport('NETWORK') eq 'BitlBee' ){
+ $bitlbee_tag{ $server->{tag} } = 1;
+ }
+});
+# if new control channel is synced after script is loaded
+Irssi::signal_add_last('channel sync' => sub {
+ my( $channel ) = @_;
+ my $T = $channel->{server}->{tag};
+ if( $channel->{mode} =~ /C/ && $bitlbee_tag{$T} ){
+ push @{ $control_channels{$T} }, $channel->{name} unless (grep $_ eq $channel->{name}, @{ $control_channels{$T} // [] });
+ }
+});
+
+# How often to check if we are typing, or on msn,
+# how long to keep the typing notice up, or check
+# if the other user is still typing...
+my $KEEP_TYPING_TIMEOUT = 1;
+my $STOP_TYPING_TIMEOUT = 7;
+
+my %timer_tag;
+
+my %typing;
+my %tag;
+my $line;
+my %out_typing;
+my $lastkey;
+my $keylog_active = 1;
+my $command_char = Irssi::settings_get_str('cmdchars'); # mostly: /
+my $to_char = Irssi::settings_get_str("completion_char"); # mostly: :
+
+sub event_ctcp_msg {
+ my ($server, $msg, $from, $address) = @_;
+ my $tag = $server->{tag};
+ return unless $bitlbee_tag{ $tag };
+ if ( my($type) = $msg =~ "TYPING ([0-9])" ){
+ Irssi::signal_stop();
+ if( $type == 0 ){
+ unset_typing($tag, $from);
+ } elsif( $type == 1 ){
+ my $k = "$tag/$from";
+ $typing{$k}=1;
+ if( $address !~ /\@login\.oscar\.aol\.com/ and $address !~ /\@YAHOO/ and $address !~ /\@login\.icq\.com/ ){
+ Irssi::timeout_remove($tag{$k});
+ delete($tag{$k});
+ $tag{$k}=Irssi::timeout_add_once($STOP_TYPING_TIMEOUT*1000,"unset_typing",[$tag,$from]);
+ }
+ redraw($tag, $from);
+ } elsif( $type == 2 ){
+ stale_typing($tag, $from);
+ }
+ }
+}
+
+sub unset_typing {
+ my($tag,$from,$no_redraw)=@_;
+ my $k = "$tag/$from";
+ delete $typing{$k} if $typing{$k};
+ Irssi::timeout_remove($tag{$k});
+ delete($tag{$k});
+ redraw($tag, $from) if !$no_redraw;
+}
+
+sub stale_typing {
+ my($tag,$from)=@_;
+ my $k = "$tag/$from";
+ $typing{$k}=2;
+ redraw($tag, $from);
+}
+
+sub redraw {
+ my($tag,$from)=@_;
+ my $window = Irssi::active_win();
+ my $name = $window->get_active_name();
+
+ # only redraw if current window equals to the typing person, is a control channel or if allwin is set
+ if( $from eq $name || (grep $_ eq $name, @{ $control_channels{$tag} // [] }) || Irssi::settings_get_bool("bitlbee_typing_allwin") ){
+ Irssi::statusbar_items_redraw('typing_notice');
+ }
+}
+
+sub event_msg {
+ my ($server,$data,$from,$address,$target) = @_;
+ my $tag = $server->{tag};
+ return unless $bitlbee_tag{ $tag };
+ my $channel=Irssi::active_win()->get_active_name();
+ unset_typing $tag, $from, "no redraw";
+ unset_typing $tag, $channel;
+}
+
+sub event_quit {
+ my $server = shift;
+ my $tag = $server->{tag};
+ return unless $bitlbee_tag{ $tag };
+ my $nick = shift;
+ unset_typing $tag, $nick;
+}
+
+sub typing_notice {
+ my ($item, $get_size_only) = @_;
+ my $window = Irssi::active_win();
+ my $tag = $window->{active}{server}{tag} // "";
+ my $channel = $window->get_active_name();
+ my $k = "$tag/$channel";
+
+ if (exists($typing{$k})) {
+ my $append=$typing{$k}==2 ? " (stale)" : "";
+ $item->default_handler($get_size_only, "{sb typing$append}", 0, 1);
+ } else {
+ $item->default_handler($get_size_only, "", 0, 1);
+ Irssi::timeout_remove($tag{$k});
+ delete($tag{$k});
+ }
+ # we check for correct windows again, because the statusbar item is redrawn after window change too.
+ if( (grep $_ eq $channel, @{ $control_channels{$tag} // [] }) || Irssi::settings_get_bool("bitlbee_typing_allwin")) {
+ foreach my $key (sort keys(%typing)) {
+ $line .= " ".$key;
+ if ($typing{$key}==2) { $line .= " (stale)"; }
+ }
+ if ($line ne "") {
+ $item->default_handler($get_size_only, "{sb typing:$line}", 0, 1);
+ $line = "";
+ }
+ }
+}
+
+sub window_change {
+ Irssi::statusbar_items_redraw('typing_notice');
+ my $win = !Irssi::active_win() ? undef : Irssi::active_win()->{active};
+ if (ref $win && defined $win->{server}->{tag} && $bitlbee_tag{ $win->{server}->{tag} }) {
+ if (!$keylog_active) {
+ $keylog_active = 1;
+ Irssi::signal_add_last('gui key pressed', 'key_pressed');
+ }
+ } else {
+ if ($keylog_active) {
+ $keylog_active = 0;
+ Irssi::signal_remove('gui key pressed', 'key_pressed');
+ }
+ }
+}
+
+sub key_pressed {
+ return if !Irssi::settings_get_bool("bitlbee_send_typing");
+ my $key = shift;
+ if ($key != 9 && $key != 10 && $key != 13 && $lastkey != 27 && $key != 27
+ && $lastkey != 91 && $key != 126 && $key != 127)
+ {
+ my $window = Irssi::active_win();
+ my $nick = $window->get_active_name();
+ my $tag = $window->{active}{server}{tag};
+ if (defined $tag && $bitlbee_tag{ $tag } && $nick ne "(status)" && $nick ne "root") {
+ if( grep $_ eq $nick, @{ $control_channels{$tag} // [] } ){ # send typing if in control channel
+ my $input = Irssi::parse_special("\$L");
+ my ($first_word) = split(/ /,$input);
+ if ($input !~ /^$command_char.*/ && $first_word =~ s/$to_char$//){
+ send_typing($tag, $first_word);
+ }
+ } else { # or any other channels / query
+ my $input = Irssi::parse_special("\$L");
+ if ($input !~ /^$command_char.*/ && length($input) > 0){
+ send_typing($tag, $nick);
+ }
+ }
+ }
+ }
+ $lastkey = $key;
+}
+
+sub delete_server {
+ my $tag = shift;
+ delete $bitlbee_tag{$tag};
+ delete $control_channels{$tag};
+ undef;
+}
+
+sub out_empty {
+ my ($a) = @_;
+ my($nick,$tag)=@{$a};
+ my $k = "$tag/$nick";
+ delete($out_typing{$k});
+ Irssi::timeout_remove($timer_tag{$k});
+ delete($timer_tag{$k});
+ if (my $bitlbee_server = Irssi::server_find_tag($tag)) {
+ $bitlbee_server->command("^CTCP $nick TYPING 0");
+ } else {
+ delete_server($tag);
+ }
+}
+
+sub send_typing {
+ my ($tag, $nick) = @_;
+ my $k = "$tag/$nick";
+ if (!exists($out_typing{$k}) || time - $out_typing{$k} > $KEEP_TYPING_TIMEOUT) {
+ if (my $bitlbee_server = Irssi::server_find_tag($tag)) {
+ $bitlbee_server->command("^CTCP $nick TYPING 1");
+ } else {
+ delete_server($tag);
+ }
+ $out_typing{$k} = time;
+ ### Reset 'stop-typing' timer
+ Irssi::timeout_remove($timer_tag{$k});
+ delete($timer_tag{$k});
+
+ ### create new timer
+ $timer_tag{$k} = Irssi::timeout_add_once($STOP_TYPING_TIMEOUT*1000, 'out_empty', ["$nick", $tag]);
+ }
+}
+
+#README: Delete the old bitlbee_send_typing string from ~/.irssi/config. A boolean is better.
+
+sub db_typing {
+ local $Data::Dumper::Sortkeys = 1;
+ print "Detected channels: ";
+ print Dumper(%control_channels);
+ print "Detected server tag: ".join ", ", sort keys %bitlbee_tag;
+ print "Tag: ".Dumper(%tag);
+ print "Timer Tag: ".Dumper(%timer_tag);
+ print "Typing: ".Dumper(%typing);
+ print "Out Typing: ".Dumper(%out_typing);
+}
+
+Irssi::command_bind('db_typing','db_typing');
+
+Irssi::settings_add_bool("bitlbee","bitlbee_send_typing",1);
+Irssi::settings_add_bool("bitlbee","bitlbee_typing_allwin",0);
+
+Irssi::signal_add("ctcp msg", "event_ctcp_msg");
+Irssi::signal_add("message private", "event_msg");
+Irssi::signal_add("message public", "event_msg");
+Irssi::signal_add("message quit", "event_quit");
+Irssi::signal_add_last('window changed', 'window_change');
+Irssi::signal_add_last('gui key pressed', 'key_pressed');
+Irssi::statusbar_item_register('typing_notice', undef, 'typing_notice');
+Irssi::statusbars_recreate_items();
diff --git a/scripts/blowjob.pl b/scripts/blowjob.pl
new file mode 100644
index 0000000..072703c
--- /dev/null
+++ b/scripts/blowjob.pl
@@ -0,0 +1,555 @@
+#!/usr/bin/perl -w
+use strict;
+
+# BlowJob 0.9.1, a crypto script - ported from xchat
+# was based on rodney mulraney's crypt
+# changed crypting method to Blowfish+Base64+randomness+Z-compression
+# needs :
+# Crypt::CBC,
+# Crypt::Blowfish,
+# MIME::Base64,
+# Compress::Zlib
+#
+# crypted format is :
+# HEX(Base64((paranoia-factor)*(blowfish(RANDOM+Zcomp(string))+RANDOM)))
+#
+# 04-22-2015 Updated for compatibility with current Crypt::CBC
+# 10-03-2004 Removed seecrypt, fixed two minor bugs
+# 09-03-2004 Supporting multiline messages now.
+# 08-03-2004 Lots of bugfixes on the irssi version by Thomas Reifferscheid
+# 08-03-2004 CONF FILE FORMAT CHANGED
+#
+# from server:channel:key:paranoia
+# to server:channel:paranoia:key
+#
+# /perm /bconf /setkey /showkey working now
+# keys may contain colons ":" now.
+#
+#
+# 06-12-2001 Added default umask for blowjob.keys
+# 05-12-2001 Added paranoia support for each key
+# 05-12-2001 Added conf file support
+# 05-12-2001 Added delkey and now can handle multi-server/channel keys
+# 05-12-2001 permanent crypting to a channel added
+# 05-12-2001 Can now handle multi-channel keys
+# just /setkey <key> on the channel you are to associate a channel with a key
+#
+# --- conf file format ---
+#
+# # the generic key ( when /setkey has not been used )
+# key: generic key value
+# # header that marks a crypted sentance
+# header: {header}
+# # enable wildcards for multiserver entries ( useful for OPN for example )
+# wildcardserver: yes
+#
+# --- end of conf file ---
+#
+# iMil <imil@gcu-squad.org>
+# skid <skid@gcu-squad.org>
+# Foxmask <odemah@gcu-squad.org>
+# Thomas Reifferscheid <blowjob@reifferscheid.org>
+
+use Crypt::CBC;
+use Crypt::Blowfish;
+use MIME::Base64;
+use Compress::Zlib;
+
+use Irssi::Irc;
+use Irssi;
+use vars qw($VERSION %IRSSI $cipher);
+
+$VERSION = "0.9.0";
+%IRSSI = (
+ authors => 'iMil,Skid,Foxmask,reiffert',
+ contact => 'imil@gcu-squad.org,blowjob@reifferscheid.org,#blowtest@freenode',
+ name => 'blowjob',
+ description => 'Crypt IRC communication with blowfish encryption. Supports public #channels, !channels, +channel, querys and dcc chat. Roadmap for Version 1.0.0 is to get some feedback and cleanup. Join #blowtest on freenode (irc.debian.org) to get latest stuff available. Note to users upgrading from versions prior to 0.8.5: The blowjob.keys format has changed.',
+ license => 'GNU GPL',
+ url => 'http://ftp.gcu-squad.org/misc/',
+);
+
+
+############# IRSSI README AREA #################################
+#To install this script just do
+#/script load ~/blowjob-irssi.pl
+# and
+#/blowhelp
+# to read all the complete feature of the script :)
+#To uninstall it do
+#/script unload blowjob-irssi
+################################################################
+
+
+my $key = 'very poor key' ; # the default key
+my $header = "{blow}";
+# Crypt loops, 1 should be enough for everyone imho ;)
+# please note with a value of 4, a single 4-letter word can generate
+# a 4 line crypted sentance
+my $paranoia = 1;
+# add a server mask by default ?
+my $enableWildcard="yes";
+
+my $alnum = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
+
+my $gkey;
+sub loadconf
+{
+ my $fconf =Irssi::get_irssi_dir()."/blowjob.conf";
+ my @conf;
+ open (CONF, q{<}, $fconf);
+
+ if (!( -f CONF)) {
+ Irssi::print("\00305> $fconf not found, setting to defaults\n");
+ Irssi::print("\00305> creating $fconf with default values\n\n");
+ close(CONF);
+ open(CONF, q{>}, $fconf);
+ print CONF "key: $key\n";
+ print CONF "header: $header\n";
+ print CONF "wildcardserver: $enableWildcard\n";
+ close(CONF);
+ return 1;
+ }
+
+ @conf=<CONF>;
+ close(CONF);
+
+ my $current;
+ foreach(@conf) {
+ $current = $_;
+ $current =~ s/\n//g;
+ if ($current =~ m/key/) {
+ $current =~ s/.*\:[\ \t]*//;
+ $key = $current;
+ $gkey = $key;
+ }
+ if ($current =~ m/header/) {
+ $current =~ s/.*\:[\s\t]*\{(.*)\}.*/{$1}/;
+ $header = $current;
+ }
+ if ($current =~ m/wildcardserver/) {
+ $current =~ s/.*\:[\ \t]*//;
+ $enableWildcard = $current;
+ }
+ }
+ Irssi::print("\00314- configuration file loaded\n");
+ return 1;
+}
+loadconf;
+
+my $kfile ="$ENV{HOME}/.irssi/blowjob.keys";
+my @keys;
+$gkey=$key;
+my $gparanoia=$paranoia;
+
+sub loadkeys
+{
+ if ( -e "$kfile" ) {
+ open (KEYF, q{<}, $kfile);
+ @keys = <KEYF>;
+ close (KEYF);
+ }
+ Irssi::print("\00314- keys reloaded (Total:\00315 ".scalar @keys."\00314)\n");
+ return 1;
+}
+loadkeys;
+
+sub getkey
+{
+ my ($curserv, $curchan) = @_;
+
+ my $gotkey=0;
+ my $serv;
+ my $chan;
+ my $fkey;
+
+ foreach(@keys) {
+ chomp; # keys can contain ":" now. Note:
+ my ($serv,$chan,$fparanoia,$fkey)=split /:/,$_,4; # place of paranoia has changed!
+ if ( $curserv =~ /$serv/ and $curchan eq $chan ) {
+ $key= $fkey;
+ $paranoia=$fparanoia;
+ $gotkey=1;
+ }
+ }
+ if (!$gotkey) {
+ $key=$gkey;
+ $paranoia=$gparanoia;
+ }
+ $cipher=new Crypt::CBC(-key=> $key, -cipher=> 'Blowfish', -header => 'randomiv');
+}
+
+sub setkey
+{
+ my (undef,$server, $channel) = @_;
+ if (! $channel) { return 1; }
+ my $curchan = $channel->{name};
+ my $curserv = $server->{address};
+ # my $key = $data;
+
+ my $fparanoia;
+
+ my $newchan=1;
+ umask(0077);
+ unless ($_[0] =~ /( +\d$)/) {
+ $_[0].= " $gparanoia";
+ }
+ ($key, $fparanoia) = ($_[0] =~ /(.*) +(\d)/);
+
+ if($enableWildcard =~ /[Yy][Ee][Ss]/) {
+ $curserv =~ s/(.*?)\./(.*?)\./;
+ Irssi::print("\00314IRC server wildcards enabled\n");
+ }
+
+ # Note, place of paranoia has changed!
+ my $line="$curserv:$curchan:$fparanoia:$key";
+
+ open (KEYF, q{>}, $kfile);
+ foreach(@keys) {
+ s/\n//g;
+ if (/^$curserv\:$curchan\:/) {
+ print KEYF "$line\n";
+ $newchan=0;
+ } else {
+ print KEYF "$_\n";
+ }
+ }
+ if ($newchan) {
+ print KEYF "$line\n";
+ }
+ close (KEYF);
+ loadkeys;
+ Irssi::active_win()->print("\00314key set to \00315$key\00314 for channel \00315$curchan");
+ return 1 ;
+}
+
+sub delkey
+{
+ my ($data, $server, $channel) = @_;
+ my $curchan = $channel->{name};
+ my $curserv = $server->{address};
+
+ my $serv;
+ my $chan;
+
+ open (KEYF, q{>}, $kfile);
+ foreach(@keys) {
+ s/\n//g;
+ ($serv,$chan)=/^(.*?)\:(.*?)\:/;
+ unless ($curserv =~ /$serv/ and $curchan=~/^$chan$/) {
+ print KEYF "$_\n";
+ }
+ }
+ close (KEYF);
+ Irssi::active_win()->print("\00314key for channel \00315$curchan\00314 deleted");
+ loadkeys;
+ return 1 ;
+}
+
+sub showkey {
+ my (undef, $server, $channel) = @_;
+ if (! $channel) { return 1; }
+ my $curchan = $channel->{name};
+ my $curserv = $server->{address};
+
+ getkey($curserv,$curchan);
+
+ Irssi::active_win()->print("\00314current key is : \00315$key");
+ return 1 ;
+}
+
+sub enc
+{
+ my ($curserv,$curchan, $in) = @_;
+ my $prng1="";
+ my $prng2="";
+
+ # copy & paste from former sub blow()
+
+ for (my $i=0;$i<4;$i++) {
+ $prng1.=substr($alnum,int(rand(61)),1);
+ $prng2.=substr($alnum,int(rand(61)),1);
+ }
+
+
+ getkey($curserv,$curchan);
+
+ $cipher->start('encrypting');
+
+ my $tbout = compress($in);
+ my $i;
+ for ($i=0;$i<$paranoia;$i++) {
+ $tbout = $prng1.$tbout;
+ $tbout = $cipher->encrypt($tbout);
+ $tbout .= $prng2;
+ }
+
+ $tbout = encode_base64($tbout);
+ $tbout = unpack("H*",$tbout);
+ $tbout = $header." ".$tbout;
+ $tbout =~ s/=+$//;
+
+ $cipher->finish();
+
+ return (length($tbout),$tbout);
+
+}
+
+sub irclen
+{
+ my ($len,$curchan,$nick,$userhost) = @_;
+
+ # calculate length of "PRIVMSG #blowtest :{blow} 4b7257724a ..." does not exceed
+ # it may not exceed 511 bytes
+ # result gets handled by caller.
+
+ return ($len + length($curchan) + length("PRIVMSG : ") + length($userhost) + 1 + length($nick) );
+}
+sub recurs
+{
+ my ($server,$curchan,$in) = @_;
+
+ # 1. devide input line by 2. <--|
+ # into two halfes, called $first and $second. |
+ # 2. try to decrease $first to a delimiting " " |
+ # but only try on the last 8 bytes ^
+ # 3. encrypt $first |
+ # if result too long, call sub recurs($first)----
+ # 4. encrypt $second ^
+ # if result too long, call sub recurs($second)--|
+ # 5. pass back encrypted halfes as reference
+ # to an array.
+
+
+ my $half = length($in)/2-1;
+ my $first = substr($in,0,$half);
+ my $second = substr($in,$half,$half+3);
+ if ( (my $pos = rindex($first," ",length($first)-8) ) != -1)
+ {
+ $second = substr($first,$pos+1,length($first)-$pos) . $second;
+ $first = substr($first,0,$pos);
+ }
+
+ my @a;
+
+ my ($len,$probablyout);
+
+ ($len,$probablyout) = enc($server->{address},$curchan,$first);
+
+ if ( irclen($len,$curchan,$server->{nick},$server->{userhost}) > 510)
+ {
+ my @b=recurs($server,$curchan,$first);
+ push(@a,@{$b[0]});
+ } else {
+ push(@a,$probablyout);
+ }
+
+ ($len,$probablyout) = enc($server->{address},$curchan,$second);
+ if ( irclen($len,$curchan,$server->{nick},$server->{userhost}) > 510)
+ {
+ my @b = recurs($server,$curchan,$second);
+ push(@a,@{$b[0]});
+ } else {
+ push(@a,$probablyout);
+ }
+ return \@a;
+
+}
+
+
+sub printout
+{
+ my ($aref,$server,$curchan) = @_;
+
+ # encrypted lines get stored [ '{blow} yxcvasfd', '{blow} qewrdf', ... ];
+ # in an arrayref
+
+ foreach(@{$aref})
+ {
+ $server->command("/^msg -$server->{tag} $curchan ".$_);
+ }
+}
+
+sub enhanced_printing
+{
+ my ($server,$curchan,$in) = @_;
+
+ # calls the recursing sub recurs ... and
+ my $arref = recurs($server,$curchan,$in);
+ # print out.
+ printout($arref,$server,$curchan);
+
+}
+
+sub blow
+{
+ my ($data, $server, $channel) = @_;
+ if (! $channel) { return 1;}
+ my $in = $data ;
+ my $nick = $server->{nick};
+ my $curchan = $channel->{name};
+ my $curserv = $server->{address};
+
+ my ($len,$encrypted_message) = enc($curserv,$curchan,$in);
+
+ $server->print($channel->{name}, "<$nick|{crypted}> \00311$in",MSGLEVEL_CLIENTCRAP);
+
+ $len = length($encrypted_message); # kept for debugging
+
+ if ( irclen($len,$curchan,$server->{nick},$server->{userhost}) > 510)
+ {
+ # if complete message too long .. see sub irclen
+ enhanced_printing($server,$curchan,$data);
+ } else {
+ # everything is fine, just print out
+ $server->command("/^msg -$server->{tag} $curchan $encrypted_message");
+ }
+
+ return 1 ;
+}
+
+sub infoline
+{
+ my ($server, $data, $nick, $address) = @_;
+
+ my ($channel,$text,$msgline,$msgnick,$curchan,$curserv);
+
+ if ( ! defined($address) ) # dcc chat
+ {
+ $msgline = $data;
+ $curserv = $server->{server}->{address};
+ $channel = $curchan = "=".$nick;
+ $msgnick = $nick;
+ $server = $server->{server};
+ } else
+ {
+ ($channel, $text) = $data =~ /^(\S*)\s:(.*)/;
+ $msgline = $text;
+ $msgnick = $server->{nick};
+ $curchan = $channel;
+ $curserv = $server->{address};
+ }
+
+ if ($msgline =~ m/^$header/) {
+ my $out = $msgline;
+ $out =~ s/\0030[0-9]//g;
+ $out =~ s/^$header\s*(.*)/$1/;
+
+ if ($msgnick eq $channel)
+ {
+ $curchan = $channel = $nick;
+ }
+
+ getkey($curserv,$curchan);
+
+ $cipher->start('decrypting');
+ $out = pack("H*",$out);
+ $out = decode_base64($out);
+
+ my $i;
+ for ($i=0;$i<$paranoia;$i++) {
+ $out = substr($out,0,(length($out)-4));
+ $out = $cipher->decrypt($out);
+ $out = substr($out,4);
+ }
+ $out = uncompress($out);
+
+ $cipher->finish;
+
+ if(length($out))
+ {
+ $server->print($channel, "<$nick|{uncrypted}> \00311$out", MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop();
+ }
+ return 1;
+
+ }
+ return 0 ;
+}
+
+sub dccinfoline
+{
+ my ($server, $data) = @_;
+ infoline($server,$data,$server->{nick},undef);
+}
+my %permchans={};
+sub perm
+{
+ my ($data, $server, $channel) = @_;
+ if (! $channel) { return 1; }
+ my $curchan = $channel->{name};
+ my $curserv = $server->{address};
+
+ if ( exists($permchans{$curserv}{$curchan}) && $permchans{$curserv}{$curchan} == 1) {
+ delete $permchans{$curserv}{$curchan};
+ Irssi::active_win()->print("\00314not crypting to \00315$curchan\00314 on \00315$curserv\00314 anymore");
+ } else {
+ $permchans{$curserv}{$curchan} = 1;
+ Irssi::active_win()->print("\00314crypting to \00315$curchan on \00315$curserv");
+ }
+ return 1;
+}
+sub myline
+{
+ my ($data, $server, $channel) = @_;
+ if (! $channel) { return 1; }
+ my $curchan = $channel->{name};
+ my $curserv = $server->{address};
+ my $line = shift;
+ chomp($line);
+ if (length($line) == 0)
+ {
+ return;
+ }
+ my $gotchan = 0;
+ foreach(@keys) {
+ s/\n//g;
+ my ($serv,$chan,undef,undef)=split /:/;
+ if ( ($curserv =~ /$serv/ && $curchan =~ /^$chan$/ && exists($permchans{$curserv}{$curchan}) && $permchans{$curserv}{$curchan} == 1) || (exists($permchans{$curserv}{$curchan}) && $permchans{$curserv}{$curchan} == 1))
+ {
+ $gotchan = 1;
+ }
+ }
+ if ($gotchan)
+ {
+
+ blow($line,$server,$channel);
+ Irssi::signal_stop();
+ return 1;
+ }
+}
+
+sub reloadconf
+{
+ loadconf;
+ loadkeys;
+}
+sub help
+{
+ Irssi::print("\00314[\00303bl\003090\00303wjob\00314]\00315 script :\n");
+ Irssi::print("\00315/setkey <newkey> [<paranoia>] :\00314 new key for current channel\n") ;
+ Irssi::print("\00315/delkey :\00314 delete key for current channel");
+ Irssi::print("\00315/showkey :\00314 show your current key\n") ;
+ Irssi::print("\00315/blow <line> :\00314 send crypted line\n") ;
+ Irssi::print("\00315/perm :\00314 flag current channel as permanently crypted\n") ;
+ Irssi::print("\00315/bconf :\00314 reload blowjob.conf\n") ;
+
+ return 1 ;
+}
+
+Irssi::print("blowjob script $VERSION") ;
+Irssi::print("\n\00314[\00303bl\003090\00303wjob\00314] v$VERSION\00315 script loaded\n\n");
+Irssi::print("\00314- type \00315/blowhelp\00314 for options\n") ;
+Irssi::print("\00314- paranoia level is : \00315$paranoia\n") ;
+Irssi::print("\00314- generic key is : \00315$key\n") ;
+Irssi::print("\n\00314* please read script itself for documentation\n");
+Irssi::signal_add("event privmsg","infoline") ;
+Irssi::signal_add("dcc chat message","dccinfoline");
+Irssi::command_bind("blowhelp","help") ;
+Irssi::command_bind("setkey","setkey") ;
+Irssi::command_bind("delkey","delkey");
+Irssi::command_bind("blow","blow") ;
+Irssi::command_bind("showkey","showkey") ;
+Irssi::command_bind("perm","perm") ;
+Irssi::command_bind("bconf","reloadconf") ;
+Irssi::signal_add("send text","myline") ;
diff --git a/scripts/bmi.pl b/scripts/bmi.pl
new file mode 100644
index 0000000..a8a729d
--- /dev/null
+++ b/scripts/bmi.pl
@@ -0,0 +1,45 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi qw(command_bind command_runsub);
+
+$VERSION = '2002121801';
+%IRSSI = (
+ authors => 'Daniel K. Gebhart, Marcus Rückert',
+ contact => 'dkg@con-fuse.org, darix@irssi.org',
+ name => 'BMI Calculator',
+ description => 'a simple body mass index calculator for depression ;)',
+ license => 'GPLv2',
+ url => 'http://dkg.con-fuse.org/irssi/scripts/',
+ changed => $VERSION,
+);
+
+sub bmi_help () {
+ print ( CLIENTCRAP "\nBMI <weigth_in_kg> <height_in_cm> [<precision>]\n" );
+ print ( CLIENTCRAP "please specify weight in kilograms (10-999kg) and height in cm (10-999cm). you can use decimal places. output precision (0-9).\n" );
+ print ( CLIENTCRAP "The optimal BMI is 19-24 for women and 20-25 for men.\n" );
+}
+
+command_bind 'bmi help' => sub { bmi_help(); };
+
+command_bind 'bmi' => sub {
+ my ($data, $server, $item) = @_;
+ $data =~ s/\s+$//g;
+ $data =~ s/,/./g;
+ if ($data eq '') {
+ bmi_help();
+ }
+ elsif ( $data =~ m/^help/i ) {
+ command_runsub ( 'bmi', $data, $server, $item );
+ }
+ else {
+ if ( $data =~ m/^(\d{2,3}(\.\d+)?)\s+(\d{2,3}(\.\d+)?)(\s+(\d))?$/ ) {
+ my ($kg, $cm) = ($1, $3);
+ my $precision = ( defined ($6) ) ? $6 : 2;
+ print ( CRAP "with $kg kg at $cm cm you have a bmi of " . sprintf("%." . $precision . "f", ( ( $kg/$cm**2 ) *10000 ) ) );
+ }
+ else {
+ print ( CRAP "please specify weight in kilograms (10-999kg) and height in cm (10-999cm). you can use decimal places. output precision (0-9)." );
+ print ( CRAP "params were: $data" );
+ }
+ }
+};
diff --git a/scripts/calc.pl b/scripts/calc.pl
new file mode 100644
index 0000000..21aa7de
--- /dev/null
+++ b/scripts/calc.pl
@@ -0,0 +1,30 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi qw(command_bind active_win);
+$VERSION = '1.10';
+%IRSSI = (
+ authors => 'Juerd',
+ contact => 'juerd@juerd.nl',
+ name => 'Calculator',
+ description => 'Simple /calc mechanism',
+ license => 'Public Domain',
+ url => 'http://juerd.nl/irssi/',
+ changed => 'Thu Mar 19 11:00 CET 2002',
+);
+
+command_bind(
+ calc => sub {
+ my ($msg) = @_;
+ for ($msg) {
+ s/,/./g;
+ s/[^*.+0-9&|)(x\/^-]//g;
+ s/\*\*/^/g;
+ s/([*+\\.\/x-])\1*/$1/g;
+ s/\^/**/g;
+ s/(?<!0)x//g;
+ }
+ my $answer = eval("($msg) || 0");
+ active_win->print($@ ? "$msg = ERROR (${\ (split / at/, $@, 2)[0]})" : "$msg = $answer");
+ }
+);
diff --git a/scripts/callerid.pl b/scripts/callerid.pl
new file mode 100644
index 0000000..8931f6c
--- /dev/null
+++ b/scripts/callerid.pl
@@ -0,0 +1,135 @@
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.0";
+%IRSSI = (
+ authors => 'Daniel "dubkat" Reidy',
+ contact => 'dubkat@dubkat.org (www.dubkat.org)',
+ name => 'callerid',
+ description => 'Reformats CallerID (+g) Messages
+ (Also known as Server-Side Ignore)
+ on Hybrid & Ratbox IRCDs (EFnet)
+ to be Easier on the Eyes',
+ license => 'GPL',
+ url => 'http://scripts.irssi.org/',
+);
+
+#########################################################################################
+# Thanks to Geert and Senneth for helping me out with my first irssi script! #
+# Hopefully someone will find this useful. #
+# #
+# Callerid is used to block messages from users at the server. #
+# Callerid mode is activated by usermode +g on Hybrid and Ratbox servers (EFnet) #
+# The ircd maintains a list of users that may message you. #
+# To add users to the list, do /quote accept NICK #
+# The IRCD will *NOT* inform you that the user has been added. #
+# To remove a user from the list do /quote accept -NICK #
+# The IRCD will *NOT* inform you that the user has been removed. #
+# To see a list of users on your accept list do /quote accept * #
+# #
+# The following alias may make life easier: #
+# alias accept quote accept #
+#########################################################################################
+
+Irssi::signal_add('event 716', 'callerid_them');
+ sub callerid_them {
+ my ($server, $data) = @_;
+ my (undef, $nick, undef) = split(/ +/, $data, 3);
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'callerid_them', $nick);
+ Irssi::signal_stop();
+ }
+
+Irssi::signal_add('event 717', 'callerid_them_notified');
+ sub callerid_them_notified {
+ my ($server, $data) = @_;
+ my (undef, $nick, undef) = split(/ +/, $data, 3);
+ $server->printformat($nick, MSGLEVEL_CLIENTCRAP, 'callerid_them_notified', $nick);
+ Irssi::signal_stop();
+ }
+
+Irssi::signal_add('event 282', 'callerid_accept_eof');
+ sub callerid_accept_eof { Irssi::signal_stop(); }
+
+Irssi::signal_add('event 718', 'callerid_you');
+ sub callerid_you {
+ my ($server, $data) = @_;
+ my (undef, $nick, $host, undef) = split(/ +/, $data, 4);
+ $server->printformat($nick, MSGLEVEL_CLIENTCRAP, 'callerid_you', $nick, $host);
+ Irssi::signal_stop();
+ }
+
+Irssi::signal_add('event 281', 'callerid_accept_list');
+ sub callerid_accept_list {
+ my ($server, $data) = @_;
+ my (undef, $list, undef) = split(/ +/, $data, 3);
+ $data =~ s/^\S+\s//;
+ $data =~ s/\s+:$//;
+ $server->printformat($data, MSGLEVEL_CLIENTCRAP, 'callerid_accept_list', $data);
+ Irssi::signal_stop();
+ }
+
+
+Irssi::signal_add('event 457', 'callerid_accept_exsists');
+ sub callerid_accept_exsists {
+ my ($server, $data) = @_;
+ my (undef, $nick, undef) = split(/ +/, $data, 3);
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'callerid_accept_exsists', $nick);
+ Irssi::signal_stop();
+ }
+
+
+Irssi::signal_add('event 458', 'callerid_not_on_list');
+ sub callerid_not_on_list {
+ my ($server, $data) = @_;
+ my (undef, $info, undef) = split(/ +/, $data, 3);
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'callerid_not_on_list', $info);
+ Irssi::signal_stop();
+ }
+
+Irssi::signal_add('event 456', 'callerid_full');
+ sub callerid_full {
+ my ($server, $data) = @_;
+ my (undef, $info) = split(/ +/, $data, 2);
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'callerid_full', $info);
+ Irssi::signal_stop();
+ }
+
+Irssi::signal_add('event 401', 'callerid_invalid_nick');
+ sub callerid_invalid_nick{
+ my ($server, $data) = @_;
+ my (undef, $info, undef) = split(/ +/, $data, 3);
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'callerid_invalid_nick', $info);
+ Irssi::signal_stop();
+ }
+
+
+Irssi::theme_register
+ (
+ [
+ 'callerid_them',
+ '%_[%_%RCALLERID%n%_]%_ %W$0%n is in server-side ignore.',
+
+ 'callerid_you',
+ '%_[%_%yCALLERID%n%_]%_ %W$0%n ($1) is attempting to message you.',
+
+ 'callerid_accept_list',
+ '%_[%_%gACCEPTED%n%_]%_ %W$0%n',
+
+ 'callerid_accept_exsists',
+ '%_[%_%BCALLERID%n%_]%_ %W$0%n Is Already On Your Accept List. Do %_/quote accept *%_ for a list :)',
+
+ 'callerid_full',
+ '%_[%_%pCALLERID%n%_]%_ List is full. Do %_/quote accept *%_ for a list',
+
+ 'callerid_not_on_list',
+ '%_[%_%pCALLERID%n%_]%_ $0 is not a user on your accept list.',
+
+ 'callerid_invalid_nick',
+ '%_[%_%pCALLERID%n%_]%_ Cannot add/remove $0. That nick does not exist.',
+
+ 'callerid_them_notified',
+ '%_[%_%rCALLERID%n%_]%_ %_$0%_ has been notified that you attempted to message them. (They will not notified of further messages for 60sec).',
+
+ ]
+ );
diff --git a/scripts/cap_sasl.pl b/scripts/cap_sasl.pl
new file mode 100644
index 0000000..7a0b742
--- /dev/null
+++ b/scripts/cap_sasl.pl
@@ -0,0 +1,437 @@
+use strict;
+use Irssi;
+use MIME::Base64;
+use vars qw($VERSION %IRSSI);
+use constant CHALLENGE_SIZE => 32;
+
+$VERSION = "1.11";
+%IRSSI = (
+ authors => 'Michael Tharp (gxti), Jilles Tjoelker (jilles), Mantas MikulÄ—nas (grawity)',
+ contact => 'grawity@gmail.com',
+ name => 'cap_sasl.pl',
+ description => 'Implements SASL authentication and enables CAP "multi-prefix"',
+ license => 'GPLv2',
+ url => 'http://ircv3.atheme.org/extensions/sasl-3.1',
+);
+
+my %sasl_auth = ();
+my %mech = ();
+
+sub irssi_abspath {
+ my $f = shift;
+ $f =~ s!^~/!$ENV{HOME}/!;
+ if ($f !~ m!^/!) {
+ $f = Irssi::get_irssi_dir()."/".$f;
+ }
+ return $f;
+}
+
+sub timeout;
+
+sub server_connected {
+ my $server = shift;
+ if (uc $server->{chat_type} eq 'IRC') {
+ $server->send_raw_now("CAP LS");
+ }
+}
+
+sub event_cap {
+ my ($server, $args, $nick, $address) = @_;
+ my ($subcmd, $caps, $tosend, $sasl);
+
+ $tosend = '';
+ $sasl = $sasl_auth{$server->{tag}};
+ if ($args =~ /^\S+ (\S+) :(.*)$/) {
+ $subcmd = uc $1;
+ $caps = ' '.$2.' ';
+ if ($subcmd eq 'LS') {
+ $tosend .= ' multi-prefix' if $caps =~ / multi-prefix /i;
+ $tosend .= ' sasl' if $caps =~ / sasl /i && defined($sasl);
+ $tosend =~ s/^ //;
+ $server->print('', "CLICAP: supported by server:$caps");
+ if (!$server->{connected}) {
+ if ($tosend eq '') {
+ $server->send_raw_now("CAP END");
+ } else {
+ $server->print('', "CLICAP: requesting: $tosend");
+ $server->send_raw_now("CAP REQ :$tosend");
+ }
+ }
+ Irssi::signal_stop();
+ } elsif ($subcmd eq 'ACK') {
+ $server->print('', "CLICAP: now enabled:$caps");
+ if ($caps =~ / sasl /i) {
+ $sasl->{buffer} = '';
+ $sasl->{step} = 0;
+ if ($mech{$sasl->{mech}}) {
+ $server->send_raw_now("AUTHENTICATE " . $sasl->{mech});
+ Irssi::timeout_add_once(7500, \&timeout, $server->{tag});
+ } else {
+ $server->print('', 'SASL: attempted to start unknown mechanism "' . $sasl->{mech} . '"');
+ }
+ }
+ elsif (!$server->{connected}) {
+ $server->send_raw_now("CAP END");
+ }
+ Irssi::signal_stop();
+ } elsif ($subcmd eq 'NAK') {
+ $server->print('', "CLICAP: refused:$caps");
+ if (!$server->{connected}) {
+ $server->send_raw_now("CAP END");
+ }
+ Irssi::signal_stop();
+ } elsif ($subcmd eq 'LIST') {
+ $server->print('', "CLICAP: currently enabled:$caps");
+ Irssi::signal_stop();
+ }
+ }
+}
+
+sub event_authenticate {
+ my ($server, $args, $nick, $address) = @_;
+ my $sasl = $sasl_auth{$server->{tag}};
+ return unless $sasl && $mech{$sasl->{mech}};
+
+ $sasl->{buffer} .= $args;
+ return if length($args) == 400;
+
+ my $data = ($sasl->{buffer} eq '+') ? '' : decode_base64($sasl->{buffer});
+ my $out = $mech{$sasl->{mech}}($sasl, $data);
+
+ if (defined $out) {
+ $out = ($out eq '') ? '+' : encode_base64($out, '');
+ while (length $out >= 400) {
+ my $subout = substr($out, 0, 400, '');
+ $server->send_raw_now("AUTHENTICATE $subout");
+ }
+ if (length $out) {
+ $server->send_raw_now("AUTHENTICATE $out");
+ } else {
+ # Last piece was exactly 400 bytes, we have to send
+ # some padding to indicate we're done.
+ $server->send_raw_now("AUTHENTICATE +");
+ }
+ } else {
+ $server->send_raw_now("AUTHENTICATE *");
+ }
+
+ $sasl->{buffer} = "";
+ Irssi::signal_stop();
+}
+
+sub event_saslend {
+ my ($server, $args, $nick, $address) = @_;
+
+ my $data = $args;
+ $data =~ s/^\S+ :?//;
+ # need this to see it, ?? -- jilles
+
+ $server->print('', $data);
+ if (!$server->{connected}) {
+ $server->send_raw_now("CAP END");
+ }
+}
+
+sub event_saslfail {
+ my ($server, $args, $nick, $address) = @_;
+
+ my $data = $args;
+ $data =~ s/^\S+ :?//;
+
+ if (Irssi::settings_get_bool('sasl_disconnect_on_fail')) {
+ $server->print('', "$data - disconnecting from server", MSGLEVEL_CLIENTERROR);
+ $server->disconnect();
+ } else {
+ $server->print('', "$data - continuing anyway");
+ if (!$server->{connected}) {
+ $server->send_raw_now("CAP END");
+ }
+ }
+}
+
+sub timeout {
+ my $tag = shift;
+ my $server = Irssi::server_find_tag($tag);
+ if ($server && !$server->{connected}) {
+ $server->print('', "SASL: authentication timed out", MSGLEVEL_CLIENTERROR);
+ $server->send_raw_now("CAP END");
+ }
+}
+
+sub cmd_sasl {
+ my ($data, $server, $item) = @_;
+
+ if ($data ne '') {
+ Irssi::command_runsub ('sasl', $data, $server, $item);
+ } else {
+ cmd_sasl_show(@_);
+ }
+}
+
+sub cmd_sasl_set {
+ my ($data, $server, $item) = @_;
+
+ if (my ($net, $u, $p, $m) = $data =~ /^(\S+) (\S+) (\S+) (\S+)$/) {
+ if ($mech{uc $m}) {
+ $sasl_auth{$net}{user} = $u;
+ $sasl_auth{$net}{password} = $p;
+ $sasl_auth{$net}{mech} = uc $m;
+ Irssi::print("SASL: added $net: [$m] $sasl_auth{$net}{user} *");
+ } else {
+ Irssi::print("SASL: unknown mechanism $m", MSGLEVEL_CLIENTERROR);
+ }
+ } elsif ($data =~ /^(\S+)$/) {
+ $net = $1;
+ if (defined($sasl_auth{$net})) {
+ delete $sasl_auth{$net};
+ Irssi::print("SASL: deleted $net");
+ } else {
+ Irssi::print("SASL: no entry for $net");
+ }
+ } else {
+ Irssi::print("SASL: usage: /sasl set <net> <user> <password or keyfile> <mechanism>");
+ }
+}
+
+sub cmd_sasl_show {
+ #my ($data, $server, $item) = @_;
+ my @nets = keys %sasl_auth;
+ for my $net (@nets) {
+ Irssi::print("SASL: $net: [$sasl_auth{$net}{mech}] $sasl_auth{$net}{user} *");
+ }
+ Irssi::print("SASL: no networks defined") if !@nets;
+}
+
+sub cmd_sasl_save {
+ #my ($data, $server, $item) = @_;
+ my $file = Irssi::get_irssi_dir()."/sasl.auth";
+ if (open(my $fh, ">", $file)) {
+ chmod(0600, $file);
+ for my $net (keys %sasl_auth) {
+ printf $fh ("%s\t%s\t%s\t%s\n",
+ $net,
+ $sasl_auth{$net}{user},
+ $sasl_auth{$net}{password},
+ $sasl_auth{$net}{mech});
+ }
+ close($fh);
+ Irssi::print("SASL: auth saved to '$file'");
+ } else {
+ Irssi::print("SASL: couldn't access '$file': $@");
+ }
+}
+
+sub cmd_sasl_load {
+ #my ($data, $server, $item) = @_;
+ my $file = Irssi::get_irssi_dir()."/sasl.auth";
+ if (open(my $fh, "<", $file)) {
+ %sasl_auth = ();
+ while (<$fh>) {
+ chomp;
+ my ($net, $u, $p, $m) = split(/\t/, $_, 4);
+ $m ||= "PLAIN";
+ if ($mech{uc $m}) {
+ $sasl_auth{$net}{user} = $u;
+ $sasl_auth{$net}{password} = $p;
+ $sasl_auth{$net}{mech} = uc $m;
+ } else {
+ Irssi::print("SASL: unknown mechanism $m", MSGLEVEL_CLIENTERROR);
+ }
+ }
+ close($fh);
+ Irssi::print("SASL: cap_sasl $VERSION, auth loaded from '$file'");
+ }
+}
+
+sub cmd_sasl_mechanisms {
+ Irssi::print("SASL: mechanisms supported: " . join(", ", sort keys %mech));
+}
+
+Irssi::settings_add_bool('server', 'sasl_disconnect_on_fail', 1);
+
+Irssi::signal_add_first('server connected', \&server_connected);
+Irssi::signal_add('event cap', \&event_cap);
+Irssi::signal_add('event authenticate', \&event_authenticate);
+Irssi::signal_add('event 903', \&event_saslend);
+Irssi::signal_add('event 904', \&event_saslfail);
+Irssi::signal_add('event 905', \&event_saslend);
+Irssi::signal_add('event 906', \&event_saslfail);
+Irssi::signal_add('event 907', \&event_saslend);
+
+Irssi::command_bind('sasl', \&cmd_sasl);
+Irssi::command_bind('sasl load', \&cmd_sasl_load);
+Irssi::command_bind('sasl save', \&cmd_sasl_save);
+Irssi::command_bind('sasl set', \&cmd_sasl_set);
+Irssi::command_bind('sasl show', \&cmd_sasl_show);
+Irssi::command_bind('sasl mechanisms', \&cmd_sasl_mechanisms);
+
+$mech{PLAIN} = sub {
+ my ($sasl, $data) = @_;
+ my $u = $sasl->{user};
+ my $p = $sasl->{password};
+ return join("\0", $u, $u, $p);
+};
+
+$mech{EXTERNAL} = sub {
+ my ($sasl, $data) = @_;
+ return $sasl->{user} // "";
+};
+
+if (eval {require Crypt::PK::ECC}) {
+ my $mech = "ECDSA-NIST256P-CHALLENGE";
+
+ $mech{'ECDSA-NIST256P-CHALLENGE'} = sub {
+ my ($sasl, $data) = @_;
+ my $u = $sasl->{user};
+ my $f = $sasl->{password};
+ $f = irssi_abspath($f);
+ if (!-f $f) {
+ Irssi::print("SASL: key file '$f' not found", MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ my $pk = eval {Crypt::PK::ECC->new($f)};
+ if ($@ || !$pk || !$pk->is_private) {
+ Irssi::print("SASL: no private key in file '$f'", MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ my $step = ++$sasl->{step};
+ if ($step == 1) {
+ if (length $data == CHALLENGE_SIZE) {
+ my $sig = $pk->sign_hash($data);
+ return $u."\0".$u."\0".$sig;
+ } elsif (length $data) {
+ return;
+ } else {
+ return $u."\0".$u;
+ }
+ }
+ elsif ($step == 2) {
+ if (length $data == CHALLENGE_SIZE) {
+ return $pk->sign_hash($data);
+ } else {
+ return;
+ }
+ }
+ };
+
+ Irssi::command_bind("sasl keygen" => sub {
+ my ($data, $server, $witem) = @_;
+
+ my $print = $server
+ ? sub { $server->print("", shift, shift // MSGLEVEL_CLIENTNOTICE) }
+ : sub { Irssi::print(shift, shift // MSGLEVEL_CLIENTNOTICE) };
+
+ my $net = $server ? $server->{tag} : $data;
+ if (!length $net) {
+ Irssi::print("SASL: please connect to a server first",
+ MSGLEVEL_CLIENTERROR);
+ return;
+ }
+
+ my $f_name = lc "sasl-ecdsa-$net";
+ $f_name =~ s![ /]+!_!g;
+ my $f_priv = Irssi::get_irssi_dir()."/$f_name.key";
+ my $f_pub = Irssi::get_irssi_dir()."/$f_name.pub";
+ if (-e $f_priv) {
+ $print->("SASL: refusing to overwrite '$f_priv'", MSGLEVEL_CLIENTERROR);
+ return;
+ }
+
+ $print->("SASL: generating keypair for '$net'...");
+ my $pk = Crypt::PK::ECC->new;
+ $pk->generate_key("prime256v1");
+
+ my $priv = $pk->export_key_pem("private");
+ my $pub = encode_base64($pk->export_key_raw("public_compressed"), "");
+
+ if (open(my $fh, ">", $f_priv)) {
+ chmod(0600, $f_priv);
+ print $fh $priv;
+ close($fh);
+ $print->("SASL: wrote private key to '$f_priv'");
+ } else {
+ $print->("SASL: could not write '$f_priv': $!", MSGLEVEL_CLIENTERROR);
+ return;
+ }
+
+ if (open(my $fh, ">", $f_pub)) {
+ print $fh $pub."\n";
+ close($fh);
+ } else {
+ $print->("SASL: could not write '$f_pub': $!", MSGLEVEL_CLIENTERROR);
+ }
+
+ my $cmdchar = substr(Irssi::settings_get_str("cmdchars"), 0, 1);
+ my $cmd = "msg NickServ SET PUBKEY $pub";
+
+ if ($server) {
+ $print->("SASL: updating your Irssi settings...");
+ $sasl_auth{$net}{user} //= $server->{nick};
+ $sasl_auth{$net}{password} = "$f_name.key";
+ $sasl_auth{$net}{mech} = $mech;
+ cmd_sasl_save(@_);
+ $print->("SASL: submitting pubkey to NickServ...");
+ $server->command($cmd);
+ } else {
+ $print->("SASL: update your Irssi settings:");
+ $print->("%P".$cmdchar."sasl set $net <nick> $f_name.key $mech");
+ $print->("SASL: submit your pubkey to $net:");
+ $print->("%P".$cmdchar.$cmd);
+ }
+ });
+
+ Irssi::command_bind("sasl pubkey" => sub {
+ my ($data, $server, $witem) = @_;
+
+ my $arg = $server ? $server->{tag} : $data;
+
+ my $f;
+ if (!length $arg) {
+ Irssi::print("SASL: please select a server or specify a keyfile path",
+ MSGLEVEL_CLIENTERROR);
+ return;
+ } elsif ($arg =~ m![/.]!) {
+ $f = $arg;
+ } else {
+ if ($sasl_auth{$arg}{mech} eq $mech) {
+ $f = $sasl_auth{$arg}{password};
+ } else {
+ $f = lc "sasl-ecdsa-$arg";
+ $f =~ s![ /]+!_!g;
+ $f = "$f.key";
+ }
+ }
+
+ $f = irssi_abspath($f);
+ if (!-e $f) {
+ Irssi::print("SASL: keyfile '$f' not found", MSGLEVEL_CLIENTERROR);
+ return;
+ }
+
+ my $pk = eval {Crypt::PK::ECC->new($f)};
+ if ($@ || !$pk || !$pk->is_private) {
+ Irssi::print("SASL: no private key in file '$f'", MSGLEVEL_CLIENTERROR);
+ Irssi::print("(keys using named parameters or PKCS#8 are not yet supported)",
+ MSGLEVEL_CLIENTERROR);
+ return;
+ }
+
+ my $pub = encode_base64($pk->export_key_raw("public_compressed"), "");
+ Irssi::print("SASL: loaded keyfile '$f'");
+ Irssi::print("SASL: your pubkey is $pub");
+ });
+} else {
+ Irssi::command_bind("sasl keygen" => sub {
+ Irssi::print("SASL: cannot '/sasl keygen' as the Perl 'CryptX' module is missing",
+ MSGLEVEL_CLIENTERROR);
+ });
+
+ Irssi::command_bind("sasl pubkey" => sub {
+ Irssi::print("SASL: cannot '/sasl pubkey' as the Perl 'CryptX' module is missing",
+ MSGLEVEL_CLIENTERROR);
+ });
+}
+
+cmd_sasl_load();
+
+# vim: ts=4:sw=4
diff --git a/scripts/centericq.pl b/scripts/centericq.pl
new file mode 100644
index 0000000..9b80170
--- /dev/null
+++ b/scripts/centericq.pl
@@ -0,0 +1,342 @@
+# $Id: centericq.pl,v 1.0.0 2002/10/19 13:15:49 Garion Exp $
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.0.0";
+%IRSSI = (
+ authors => "Joost \"Garion\" Vunderink",
+ contact => "joost\@carnique.nl",
+ name => "centericq",
+ description => "Staturbar item which indicates how many new messages you have in your centericq",
+ sbitems => "centericq",
+ license => "Public Domain",
+ url => "http://irssi.org, http://scripts.irssi.org",
+);
+
+# centericq new messages statusbar item
+# for irssi 0.8.4 by Timo Sirainen
+#
+# This statusbar item checks whether you have unread messages in
+# ~/.centericq/, and if so, displays a status in your statusbar.
+# Example status: [ICQ: JamesOff-1,Linn-3,Paul-4]
+#
+# Use:
+# /script load centericq
+# /statusbar <name> add centericq
+#
+# Known bugs:
+# - It only works for ICQ and MSN in centericq.
+# - The refreshing is not optimal. You'll need to swap windows to make
+# the statusbar item disappear if you've read the messages.
+# - You have to reload the script if you add new people in centericq.
+# - Works only with centericq in ~/.centericq/
+#
+# TODO:
+# - Use only the first N letters of the nickname instead of the full
+# nickname.
+
+use Irssi;
+use Irssi::TextUI;
+
+my $icqdir = $ENV{'HOME'} . "/.centericq";
+my ($last_refresh_time, $refresh_tag);
+my $statusbar_item;
+
+# The following vars are all hashes with key the name of the dir in
+# ~/.centericq/ of that person
+
+my %lastreads; # Timestamp of the last read message, per nick
+my %numunreads; # Number of unread messages, per nick
+my %historyts; # Timestamp of the history file of each nick
+my %lastreadts; # Timestamp of the lastread file of each nick
+my %friendnicks; # The nicknames of the friends
+
+
+#######################################################################
+# This is the function that will be called each N seconds, where
+# N is given by the centericq_refresh_time setting.
+
+sub refresh_centericq {
+ check_new_friends();
+
+ my @friends = keys(%lastreads);
+ my ($friend, $changed) = ("", 0);
+ foreach $friend (@friends) {
+ if (history_changed($friend) || lastread_changed($friend)) {
+ $changed = 1;
+ update_status($friend);
+ }
+ }
+
+ if ($changed) {
+ update_statusbar_item();
+ }
+
+ # Adding new timeout to make sure that this function will be called
+ # again
+ if ($refresh_tag) {
+ Irssi::timeout_remove($refresh_tag)
+ }
+ my $time = Irssi::settings_get_int('centericq_refresh_time');
+ $refresh_tag = Irssi::timeout_add($time*1000, 'refresh_centericq', undef);
+}
+
+
+#######################################################################
+# Checks if any new friends have been added. Not yet functional.
+
+sub check_new_friends {
+ #Irssi::print("Checking if there are any new friends...");
+}
+
+#######################################################################
+# Checks if the last modified date/time of the lastread file has changed.
+# A -lot- more efficient than reading and processing the whole file :)
+
+sub lastread_changed {
+ my ($friend) = @_;
+
+ my $lr = get_lastread($friend);
+ if ($lr != $lastreads{$friend}) {
+ #Irssi::print("Lastread of $friendnick{$friend} changed from $lastreads{$friend} to $lr.");
+ $lastreads{$friend} = $lr;
+ return 1;
+ }
+
+ return 0;
+}
+
+#######################################################################
+# Checks if the last modified date/time of the history file has changed.
+# A -lot- more efficient than reading and processing the whole file :)
+
+sub history_changed {
+ my ($friend) = @_;
+ my $ts = get_historyts($friend);
+ if ($ts != $historyts{$friend}) {
+ #Irssi::print("History ts of $friendnick{$friend} changed from $historyts{$friend} to $ts.");
+ $historyts{$friend} = $ts;
+ return 1;
+ }
+
+ return 0;
+}
+
+#######################################################################
+# Reads the last read message and determines the number of unread
+# messages of $friend.
+
+sub update_status {
+ my ($friend) = @_;
+ $lastreads{$friend} = get_lastread($friend);
+ $numunreads{$friend} = get_numunreads($friend);
+}
+
+#######################################################################
+# Gets the number of unread messages of all nicks and puts them together
+# in a nice statusbar string.
+# It then requests a statusbar item redraw.
+
+sub update_statusbar_item {
+ #Irssi::print("Updating statusbaritem...");
+ $statusbar_item = "";
+
+ my @keys = keys(%lastreads);
+ my ($key, $status);
+
+ foreach $key(@keys) {
+ if ($numunreads{$key} > 0) {
+ #Irssi::print("$friendnick{$key} has $numunreads{$key} unreads.");
+ $status .= $friendnicks{$key} . "-" . $numunreads{$key} . ",";
+ }
+ }
+ $status =~ s/,$//;
+ if (length($status) > 0) {
+ $statusbar_item = "ICQ: " . $status;
+ Irssi::statusbar_items_redraw('centericq');
+ }
+}
+
+
+#######################################################################
+# This is the function called by irssi to obtain the statusbar item
+# for centericq.
+
+sub centericq {
+ my ($item, $get_size_only) = @_;
+
+ if (length($statusbar_item) == 0) {
+ # no icq - don't print the [ICQ] at all
+ if ($get_size_only) {
+ $item->{min_size} = $item->{max_size} = 0;
+ }
+ } else {
+ $item->default_handler($get_size_only, undef, $statusbar_item, 1);
+ }
+}
+
+#######################################################################
+# Initialization of the hashes with the useful data.
+
+sub init {
+ if (!opendir(ICQDIR, $icqdir)) {
+ Irssi::print("There is no directory $icqdir, which is needed for this script.");
+ return 0;
+ }
+
+ my ($icqfriends, $msnfriends) = (0, 0);
+ while (my $filename = readdir(ICQDIR)) {
+ # ICQ friends
+ if ($filename =~ /^[0-9]+$/ && $filename !~ /^0$/) {
+ $icqfriends++;
+ init_friend($filename);
+ }
+ # MSN friends
+ if ($filename =~ /^m.+/ && $filename !~ /^modelist$/ ) {
+ $msnfriends++;
+ init_friend($filename);
+ }
+ }
+ Irssi::print("Watching $icqfriends ICQ friends and $msnfriends MSN friends.");
+
+ closedir(ICQDIR);
+ return 1;
+}
+
+#######################################################################
+# Initialises all data of $friend
+
+sub init_friend {
+ my ($friend) = @_;
+
+ $lastreads{$friend} = get_lastread($friend);
+ $numunreads{$friend} = get_numunreads($friend);
+ #$filesizes{$friend} = get_filesize($friend);
+ $friendnicks{$friend} = get_nickname($friend);
+ $historyts{$friend} = get_historyts($friend);
+ #Irssi::print("Initilialized $friendnick{$friend}.");
+}
+
+#######################################################################
+# Returns the last read message of $friend
+
+sub get_lastread {
+ my ($friend) = @_;
+ my $lastreadfile = $icqdir . "/" . $friend . "/lastread";
+
+ open(F, "<", $lastreadfile) || return 0; #die("Could not open $lastreadfile.");;
+ my $lastrd = <F>;
+ close(F);
+ chop($lastrd);
+ #Irssi::print("Found lastread $lastrd of $friend from $lastreadfile.");
+
+ return $lastrd;
+}
+
+#######################################################################
+# Returns the number of unread messages for $friend
+
+sub get_numunreads {
+ my ($friend) = @_;
+ my $lr = $lastreads{$friend};
+ # Unknown last read message - return 0.
+ if ($lr == 0) {
+ return 0;
+ }
+
+ my $msgfile = $icqdir . "/" . $friend . "/history";
+ open(F, "<", $msgfile) || return 0; #die("Could not open $msgfile.");
+ my @lines = <F>;
+ chop(@lines);
+ close(F);
+
+ my $numlines = @lines;
+
+ # read all lines up to the lastread message
+ my $line;
+ my $bla = 0;
+ do {
+ $line = shift(@lines);
+ $bla++;
+ } while ($line ne $lr);
+
+ # now count the number of times that "MSG" is found on a line below
+ # a line with "IN"
+ my $count = 0;
+ my $incoming = 0;
+ my $verify = 0;
+ my $bli = 0;
+
+ for (@lines) {
+ $bli++;
+ # Sometimes 2 messages get in at the same time. Remove this so-called
+ # new message if it has the same time as the last read message.
+ if ($verify == 1) {
+ if ($_ =~ /$lr/) {
+ $count--;
+ }
+ $verify = 0;
+ }
+ # A line with "IN" has been found; check if the next line is "MSG".
+ if ($incoming == 1) {
+ if ($_ =~ /^MSG/) {
+ $count++;
+ $verify = 1;
+ }
+ $incoming = 0;
+ }
+ # Check for "IN".
+ if ($_ =~ /^IN/) {
+ $incoming = 1;
+ }
+ }
+
+ return $count;
+}
+
+#######################################################################
+# Returns the nickname of a friend. This is taken from the 46th line
+# of the info file. Let's hope that centericq does not change its
+# config file format.
+
+sub get_nickname {
+ my ($friend) = @_;
+
+ my $infofile = $icqdir . "/" . $friend . "/info";
+ open(F, "<", $infofile) || return $friend; #die("Could not open $msgfile.");
+ my @lines = <F>;
+ chop(@lines);
+ close(F);
+
+ return $lines[45];
+}
+
+#######################################################################
+# Returns the timestamp of the history file of $friend.
+
+sub get_historyts {
+ my ($friend) = @_;
+ my $histfile = $icqdir . "/" . $friend . "/history";
+ my @stat = stat($histfile);
+ return $stat[9];
+}
+
+#######################################################################
+# Adding stuff to irssi
+
+Irssi::settings_add_int('misc', 'centericq_refresh_time', 120);
+#Irssi::settings_add_bool('misc', 'centericq_debug', 0);
+Irssi::statusbar_item_register('centericq', '{sb $0-}', 'centericq');
+
+#######################################################################
+# Startup functions
+
+if (init() == 0) {
+ Irssi::print("You need centericq for this script.");
+ return 0;
+}
+update_statusbar_item();
+refresh_centericq();
+
+Irssi::print("Centericq statusbar item loaded.");
+
+#######################################################################
diff --git a/scripts/cgrep.pl b/scripts/cgrep.pl
new file mode 100644
index 0000000..e7afc7c
--- /dev/null
+++ b/scripts/cgrep.pl
@@ -0,0 +1,192 @@
+################################################################################
+#
+# Usage: /cgrep <regexp>
+#
+# Shows all WHO records matching that regexp in a friendly yet complete format
+# Works on the active channel only
+#
+# This is a bit like c0ffee's ls command, except it matches ALL returned data.
+# Since IRSSI doe snot cache realnames properly, this script calls WHO once
+# and awaits the results.
+#
+# Also check out 'joininfo.pl' which shows lots of WHOIS info when a person
+# joins the channel.
+#
+# FORMAT SETTINGS:
+# cgrep_match Matching record
+# cgrep_line Start and end line format
+#
+################################################################################
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+use integer;
+
+$VERSION = "1.0.0";
+%IRSSI = (
+ authors => "Pieter-Bas IJdens",
+ contact => "irssi-scripts\@nospam.mi4.org.uk",
+ name => "cgrep",
+ description => "Lists users on the channel matching the specified regexp",
+ license => "GPLv2 or later",
+ url => "http://pieter-bas.ijdens.com/irssi/",
+ changed => "2005-03-10"
+);
+
+################################################################################
+
+my($busy) = 0;
+my($regexp) = "";
+my($results) = 0;
+my($debug) = 0;
+
+################################################################################
+
+sub run_who
+{
+ my($server, $channel) = @_;
+
+ $server->redirect_event(
+ "who",
+ 1,
+ $channel,
+ 0,
+ "redir who_default",
+ {
+ "event 352" => "redir cgrep_evt_who_result",
+ "event 315" => "redir cgrep_evt_who_end",
+ "" => "event empty"
+ }
+ );
+
+ $server->send_raw("WHO $channel");
+}
+
+################################################################################
+
+sub event_who_result
+{
+ my ($server, $data) = @_;
+
+ if ($busy)
+ {
+ my($start,$realname);
+ if ($data =~ /^(.*):([^:]{1,})$/)
+ {
+ $start = $1;
+ $realname = $2;
+ }
+ else
+ {
+ Irssi::print("$data can't be parsed");
+ }
+
+ # my($start,$realname) = split(":", $data);
+
+ my($me, $channel, $ident, $host, $server, $nick, $mode) =
+ split(" ", $start);
+ my($hops) = -1;
+
+ if ($realname =~ /^([0-9]{1,} )(.*$)$/i)
+ {
+ $hops = $1;
+ $realname = $2;
+
+ $hops =~ s/[ ]{1,}$//g;
+ }
+
+ my($string) = "$nick ($ident\@$host) \"$realname\" $channel "
+ . "($server, $hops)";
+
+ if ($string =~ /$regexp/i)
+ {
+ Irssi::printformat(
+ MSGLEVEL_CLIENTCRAP,
+ 'cgrep_match',
+ $nick,
+ "$ident\@$host",
+ "$realname",
+ $channel,
+ $server,
+ $hops
+ );
+
+ $results++;
+ }
+ }
+}
+
+################################################################################
+
+sub event_who_end
+{
+ my ($server, $data) = @_;
+
+ Irssi::printformat(
+ MSGLEVEL_CLIENTCRAP,
+ 'cgrep_line',
+ "End of list. Found $results matches."
+ );
+
+ $busy = 0;
+ $regexp = "";
+ $results = 0;
+}
+
+################################################################################
+
+sub cmd_cgrep
+{
+ my ($data, $server, $window) = @_;
+
+ if (!$server)
+ {
+ Irssi::print("Not connected to a server in this window.");
+ return;
+ }
+ elsif ($window->{type} ne "CHANNEL")
+ {
+ Irssi::print("Not a channel window.");
+ return;
+ }
+ elsif ($busy)
+ {
+ Irssi::print("A request seems to be in progress.");
+ Irssi::print("Reload script if I'm wrong.");
+ }
+
+ $busy = 1;
+ $regexp = $data;
+ $results = 0;
+
+ Irssi::printformat(
+ MSGLEVEL_CLIENTCRAP,
+ 'cgrep_line',
+ "WHO on " . $window->{name} . " filtered on '$regexp'"
+ );
+
+ run_who($server, $window->{name});
+}
+
+################################################################################
+
+Irssi::theme_register([
+ 'cgrep_match',
+ '%GWHO:%n {channick_hilight $0} [{hilight $1}] is "{hilight $2}"%n on {channel $3} [server: {hilight $4}, hops: {hilight $5}]',
+ 'cgrep_line',
+ '%R------------%n {hilight $0} %R------------%n'
+]);
+
+Irssi::signal_add(
+ {
+ 'redir cgrep_evt_who_result' => \&event_who_result,
+ 'redir cgrep_evt_who_end' => \&event_who_end
+ }
+);
+
+################################################################################
+
+Irssi::command_bind("cgrep", \&cmd_cgrep);
+
+################################################################################
diff --git a/scripts/challenge.pl b/scripts/challenge.pl
new file mode 100644
index 0000000..69cba77
--- /dev/null
+++ b/scripts/challenge.pl
@@ -0,0 +1,106 @@
+# Run a challenge response oper thingie
+#
+# (C) 2006 by Joerg Jaspert <joerg@debian.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+# This script needs "rsa_respond" out of the hybrid ircd to actually work.
+# (https://github.com/oftc/oftc-hybrid/tree/develop/tools)
+# And you need to have an rsa keypair in your oper block. Create one with
+# openssl genrsa -des3 1024 > oper-whatever.key
+# openssl rsa -pubout < oper-whatever.key > oper-whatever.pub
+# and send the .pub to your noc :)
+
+# The key length shouldn't be longer than 1024 to ensure that the entire
+# challenge will fit inside the limits of the ircd message (510+\r\n)
+
+# You have two settings to change after loading this script, just type
+# /set challenge to see them. Then you can use it in the future to oper by
+# typing /cr YOUROPERNICK
+
+use strict;
+use Irssi;
+
+use vars qw($VERSION %IRSSI);
+
+
+$VERSION = '0.0.0.0.1.alpha.0.3';
+%IRSSI = (
+ authors => 'Joerg Jaspert',
+ contact => 'joerg@debian.org',
+ name => 'challenge',
+ description => 'Performs challenge-response oper auth',
+ license => 'GPL v2 (and no later)',
+);
+
+
+# Gets called from user, $arg should only contain the oper name
+sub challenge_oper {
+ my ($arg, $server, $window) = @_;
+
+ if (length($arg) < 2) { # a one char oper name? not here
+ print CLIENTCRAP "%B>>%n call it like /cr YOUROPERNICK";
+ return;
+ } else {
+ $server->redirect_event('challenge', 1, "", -1, undef,
+ {
+ "" => "redir challenge received",
+ });
+ $server->send_raw("challenge $arg");
+ }
+}
+
+
+# This event now actually handles the challenge, the rest was just setup
+sub event_challenge_received{
+ my ($server, $data) = @_;
+ # Data contains "nick :challenge"
+ my (undef, $challenge) = split(/:/, $data);
+
+ my $key = Irssi::settings_get_str('challenge_oper_key');
+ my $respond = Irssi::settings_get_str('challenge_rsa_path');
+
+ my $irssi_tty=`stty -g`;
+ system("stty", "icrnl");
+ my $pid = open(RSA, "$respond $key $challenge |") or die "Damn, couldnt run $respond";
+ my $response = <RSA>;
+ close (RSA);
+ system("stty", "$irssi_tty");
+ $server->send_raw("challenge +$response");
+ my $window = Irssi::active_win();
+ $window->command("redraw");
+}
+
+
+# ---------- Do the startup tasks ----------
+
+Irssi::command_bind('cr', 'challenge_oper');
+
+# Add the settings
+Irssi::settings_add_str("challenge.pl", "challenge_oper_key", "$ENV{HOME}/.irssi/oper-$ENV{USER}.key");
+Irssi::settings_add_str("challenge.pl", "challenge_rsa_path", "respond");
+
+# Ok, setup the redirect event, so we can later handle the challenge thing.
+Irssi::Irc::Server::redirect_register("challenge",
+ 0, # not a remote one
+ 5, # wait at max 5 seconds for a reply
+ undef, # no start event
+ {
+ "event 386" => -1, # act on the 386, the rsa challenge
+ },
+ undef, # no optional event
+ );
+Irssi::signal_add({'redir challenge received' => \&event_challenge_received,});
diff --git a/scripts/chanact.pl b/scripts/chanact.pl
new file mode 100644
index 0000000..4a42364
--- /dev/null
+++ b/scripts/chanact.pl
@@ -0,0 +1,756 @@
+use Irssi 20020101.0001 ();
+
+use strict;
+use warnings;
+
+use Irssi::TextUI;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.6.0";
+%IRSSI = (
+ authors => 'BC-bd',
+ contact => 'bd@bc-bd.org',
+ name => 'chanact',
+ description => 'Adds new powerful and customizable [Act: ...] item (chanelnames,modes,alias). Lets you give alias characters to windows so that you can select those with meta-<char>',
+ license => 'GNU GPLv2 or later',
+ url => 'http://bc-bd.org/blog/irssi/'
+);
+
+# Please send patches / pull requests to the email listed unter contact above
+# and not to the irssi/scripts.irssi.org repository on github.
+
+# Adds new powerful and customizable [Act: ...] item (chanelnames,modes,alias).
+# Lets you give alias characters to windows so that you can select those with
+# meta-<char>.
+#
+# for irssi 0.8.2 by bd@bc-bd.org
+#
+# inspired by chanlist.pl by 'cumol@hammerhart.de'
+#
+#########
+# Contributors
+#########
+#
+# veli@piipiip.net original /window_alias code
+# qrczak@knm.org.pl chanact_abbreviate_names
+# qerub@home.se Extra chanact_show_mode and chanact_chop_status
+# madduck@madduck.net Better channel aliasing (case-sensitive, cross-network)
+# chanact_filter_windowlist basis
+# jast@heapsort.de Updated documentation
+# ivo@o2w.nl win->{hilight} patch
+# Bazerka base patch for sorting by level change
+# updated documentation
+# mrtnpaolo@gmail.com rename commands
+# tslocum@gmail.com Case-insensitive aliases
+#
+#########
+# USAGE
+###
+#
+# copy the script to ~/.irssi/scripts/
+#
+# In irssi:
+#
+# /script load chanact
+# /statusbar window add -after act chanact
+#
+# If you want the item to appear on another position read the help
+# for /statusbar.
+# To remove the [Act: 1,2,3] item type:
+#
+# /statusbar window remove act
+#
+# To see all chanact options type:
+#
+# / set chanact_
+#
+# After these steps you have your new statusbar item and you can start giving
+# aliases to your windows. Go to the window you want to give the alias to
+# and say:
+#
+# /chanact_window_alias <alias char>
+#
+# You can remove the aliases with from an aliased window:
+#
+# /chanact_window_unalias
+#
+# To see a list of your windows use:
+#
+# /window list
+#
+# To make your bindings permanent you will need to save the config and layout
+# before quiting irssi:
+#
+# /save
+# /layout save
+#
+#########
+# OPTIONS
+#########
+#
+# /set chanact_chop_status <ON|OFF>
+# * ON : shorten (Status) to S
+# * OFF : don't do it
+#
+# /set chanact_sort <refnum|activity|level+refnum|level+activity>
+# sort by ...
+# refnum : refnum
+# activity : last active window
+# level+refnum : data_level of window, then refnum
+# level+activity : data_level then activity
+#
+# /set chanact_display <string>
+# * string : Format String for one Channel. The following $'s are expanded:
+# $C : Channel
+# $N : Number of the Window
+# $M : Mode in that channel
+# $H : Start highlightning
+# $S : Stop highlightning
+# * example:
+#
+# /set chanact_display $H$N:$M.$S$C
+#
+# will give you on #irssi.de if you have voice
+#
+# [3:+.#irssi.de]
+#
+# with '3:+.' highlighted and the channel name printed in regular color
+#
+# /set chanact_case_sensitive <ON|OFF>
+# * ON : Aliases are case-sensitive
+# * OFF : Aliases are case-insensitive
+#
+# Existing aliases must be reapplied after changing this option
+#
+# Switching from OFF to ON _after_ aliases have been defined, and
+# then redefining or changing an existing alias will leave some
+# bindings behind, e.g.
+#
+# /set chanact_case_sensitive OFF
+# /chanact_window_alias x
+#
+# -> window reachable with meta-x/meta-X
+#
+# /set chanact_case_sensitive ON
+# /chanact_window_alias y
+#
+# -> window reachable with meta-y/meta-X
+#
+# /set chanact_display_alias <string>
+# as 'chanact_display' but is used if the window has an alias and
+# 'chanact_show_alias' is set to on.
+#
+# /set chanact_show_names <ON|OFF>
+# * ON : show the channelnames after the number/alias
+# * OFF : don't show the names
+#
+# /set chanact_abbreviate_names <int>
+# * 0 : don't abbreviate
+# * <int> : strip channel name prefix character and leave only
+# that many characters of the proper name
+#
+# /set chanact_show_alias <ON|OFF>
+# * ON : show the aliase instead of the refnum
+# * OFF : shot the refnum
+#
+# /set chanact_header <str>
+# * <str> : Characters to be displayed at the start of the item.
+# Defaults to: "Act: "
+#
+# /set chanact_separator <str>
+# * <str> : Charater to use between the channel entries
+#
+# /set chanact_autorenumber <ON|OFF>
+# * ON : Move the window automatically to first available slot
+# starting from "chanact_renumber_start" when assigning
+# an alias to window. Also moves the window back to a
+# first available slot from refnum 1 when the window
+# loses it's alias.
+# * OFF : Don't move the windows automatically
+#
+# /set chanact_renumber_start <int>
+# * <int> : Move the window to first available slot after this
+# num when "chanact_autorenumber" is ON.
+#
+# /set chanact_remove_hash <ON|OFF>
+# * ON : Remove &#+!= from channel names
+# * OFF : Don't touch channel names
+#
+# /set chanact_remove_prefix <string>
+# * <string> : Regular expression used to remove from the
+# beginning of the channel name.
+# * example :
+# To shorten a lot of debian channels:
+#
+# /set chanact_remove_prefix deb(ian.(devel-)?)?
+#
+# /set chanact_filter <int>
+# * 0 : show all channels
+# * 1 : hide channels without activity
+# * 2 : hide channels with only join/part/etc messages
+# * 3 : hide channels with text messages
+# * 4 : hide all channels (now why would you want to do that)
+#
+# /set chanact_filter_windowlist <string>
+# * <string> : space-separated list of windows for which to use
+# chanact_filter_windowlist_level instead of
+# chanact_filter.
+#
+# Alternatively, an entry can be postfixed with
+# a comma (',') and the level to use for that
+# window.
+#
+# The special string @QUERIES matches all queries.
+#
+# /set chanact_filter_windowlist_level <int>
+# Use this level to filter all windows listed in chanact_filter_windowlist.
+# You can use these two settings to apply different filter levels to different
+# windows. Defaults to 0.
+#
+#########
+# HINTS
+#########
+#
+# If you have trouble with wrong colored entries your 'default.theme' might
+# be too old. Try on a shell:
+#
+# $ mv ~/.irssi/default.theme /tmp/
+#
+# And in irssi:
+# /reload
+# /save
+#
+###
+#################
+
+my %show = (
+ 0 => "{%n ", # NOTHING
+ 1 => "{sb_act_text ", # TEXT
+ 2 => "{sb_act_msg ", # MSG
+ 3 => "{sb_act_hilight ", # HILIGHT
+);
+
+# comparison operators for our sort methods
+my %sort = (
+ 'refnum' => '$a->{refnum} <=> $b->{refnum};',
+ 'activity' => '$b->{last_line} <=> $a->{last_line};',
+ 'level+refnum' => '$b->{data_level} <=> $a->{data_level} ||
+ $a->{refnum} <=> $b->{refnum};',
+ 'level+activity'=> '$b->{data_level} <=> $a->{data_level} ||
+ $b->{last_line} <=> $a->{last_line};',
+);
+
+my ($actString,$needRemake);
+
+sub expand {
+ my ($string, %format) = @_;
+ my ($exp, $repl);
+ $string =~ s/\$$exp/$repl/g while (($exp, $repl) = each(%format));
+ return $string;
+}
+
+# method will get called every time the statusbar item will be displayed
+# but we dont need to recreate the item every time so we first
+# check if something has changed and only then we recreate the string
+# this might just save some cycles
+sub chanact {
+ my ($item, $get_size_only) = @_;
+
+ if ($needRemake) {
+ remake();
+ }
+
+ $item->default_handler($get_size_only, $actString, "", 1);
+}
+
+# build a hash to easily access special levels based on
+# chanact_filter_windowlist
+sub calculate_windowlist() {
+ my @matchlist = split ' ', Irssi::settings_get_str('chanact_filter_windowlist');
+ my $default = Irssi::settings_get_int('chanact_filter_windowlist_level');
+
+ my %windowlist;
+ foreach my $m (@matchlist) {
+ my ($name, $level) = split(/,/, $m);
+ $windowlist{$name} = $level ? $level : $default;
+ }
+
+ return %windowlist;
+}
+
+# calculate level per window
+sub calculate_levels(@) {
+ my (@windows) = @_;
+
+ my %matches = calculate_windowlist();
+ my $default = Irssi::settings_get_int('chanact_filter');
+
+ my %levels;
+
+ foreach my $win (@windows) {
+ !ref($win) && next;
+
+ my $name = $win->get_active_name;
+ # skip nameless windows
+ next unless $name;
+
+ if ($name && exists($matches{$name})) {
+ $levels{$name} = $matches{$name};
+ } else {
+ $levels{$name} = $default;
+ }
+ }
+
+ if (exists($matches{'@QUERIES'})) {
+ $levels{'@QUERIES'} = $matches{'@QUERIES'};
+ } else {
+ $levels{'@QUERIES'} = $default;
+ }
+
+ return %levels;
+}
+
+# this is the real creation method
+sub remake() {
+ my ($afternumber,$finish,$hilight,$mode,$number,$display,@windows);
+ my $separator = Irssi::settings_get_str('chanact_separator');
+ my $abbrev = Irssi::settings_get_int('chanact_abbreviate_names');
+ my $remove_prefix = Irssi::settings_get_str('chanact_remove_prefix');
+ my $remove_hash = Irssi::settings_get_bool('chanact_remove_hash');
+
+ my $method = $sort{Irssi::settings_get_str('chanact_sort')};
+ @windows = sort { eval $method } Irssi::windows();
+
+ my %levels = calculate_levels(@windows);
+
+ $actString = "";
+ foreach my $win (@windows) {
+ # since irssi is single threaded this shouldn't happen
+ !ref($win) && next;
+
+ my $active = $win->{active};
+
+ # define $type to emtpy string and overwrite if we do have an
+ # active item. we need this to display windows without active
+ # items e.g. '(status)'
+ my $type = "";
+ $type = $active->{type} if $active;
+
+ my $name = $win->get_active_name;
+ # skip windows without a name
+ next unless $name;
+
+ my $filter_level =
+ $type eq 'QUERY' ? $levels{'@QUERIES'} : $levels{$name};
+
+ # now, skip windows with data of level lower than the
+ # filter level
+ next if ($win->{data_level} < $filter_level);
+
+ # alright, the activity is important, let's show the window
+ # after a bit of additional processing.
+
+ # (status) is an awfull long name, so make it short to 'S'
+ # some people don't like it, so make it configurable
+ if (Irssi::settings_get_bool('chanact_chop_status')
+ && $name eq "(status)") {
+ $name = "S";
+ }
+
+ # check if we should show the mode
+ $mode = "";
+ if ($type eq "CHANNEL") {
+ my $server = $win->{active_server};
+ !ref($server) && next;
+
+ my $channel = $server->channel_find($name);
+ !ref($channel) && next;
+
+ my $nick = $channel->nick_find($server->{nick});
+ !ref($nick) && next;
+
+ if ($nick->{op}) {
+ $mode = "@";
+ } elsif ($nick->{voice}) {
+ $mode = "+";
+ } elsif ($nick->{halfop}) {
+ $mode = "%";
+ }
+ }
+
+ # in case we have a specific hilightcolor use it
+ if ($win->{hilight_color}) {
+ $hilight = "{sb_act_hilight_color $win->{hilight_color} ";
+ } else {
+ $hilight = $show{$win->{data_level}};
+ }
+
+ if ($remove_prefix) {
+ $name =~ s/^([&#+!=]?)$remove_prefix/$1/;
+ }
+ if ($abbrev) {
+ if ($name =~ /^[&#+!=]/) {
+ $name = substr($name, 1, $abbrev + 1);
+ } else {
+ $name = substr($name, 0, $abbrev);
+ }
+ }
+ if ($remove_hash) {
+ $name =~ s/^[&#+!=]//;
+ }
+
+ if (Irssi::settings_get_bool('chanact_show_alias') == 1 &&
+ $win->{name} =~ /^([a-zA-Z+]):(.+)$/) {
+ $number = "$1";
+ $display = Irssi::settings_get_str('chanact_display_alias');
+ } else {
+ $number = $win->{refnum};
+ $display = Irssi::settings_get_str('chanact_display');
+ }
+
+ # fixup { and } in nicks, those are used by irssi themes
+ $name =~ s/([{}])/%$1/g;
+
+ $actString .= expand($display,"C",$name,"N",$number,"M",$mode,"H",$hilight,"S","}{sb_background}").$separator;
+ }
+
+ # assemble the final string
+ if ($actString ne "") {
+ # Remove the last separator
+ $actString =~ s/$separator$//;
+
+ $actString = "{sb ".Irssi::settings_get_str('chanact_header').$actString."}";
+ }
+
+ # no remake needed any longer
+ $needRemake = 0;
+}
+
+# method called because of some events. here we dont remake the item but just
+# remember that we have to remake it the next time we are called
+sub chanactHasChanged()
+{
+ # if needRemake is already set, no need to trigger a redraw as we will
+ # be redrawing the item anyway.
+ return if $needRemake;
+
+ $needRemake = 1;
+
+ Irssi::statusbar_items_redraw('chanact');
+}
+
+sub setup_changed {
+ my $method = Irssi::settings_get_str('chanact_sort');
+
+ unless (exists($sort{$method})) {
+ Irssi::print("chanact: invalid sort method, setting to 'refnum'."
+ ." valid methods are: ".join(", ", sort(keys(%sort))));
+ my $method = Irssi::settings_set_str('chanact_sort', 'refnum');
+ }
+
+ chanactHasChanged();
+}
+
+# Remove key binding for current window
+sub unbind {
+ my ($name, $server) = @_;
+
+ # chanact'ified windows have a name like this: X:servertag/name. if we
+ # can't find anything like this we return and do not unbind nor renumber
+ # anything
+ my ($key, $tag) = split(/:/, $name);
+ return unless $tag;
+
+ ($tag, $name) = split('/', $tag);
+ return unless (length($key) == 1);
+
+ if (Irssi::settings_get_bool('chanact_case_sensitive')) {
+ $server->command("/bind -delete meta-$key");
+ } else {
+ $server->command("/bind -delete meta-" . lc($key));
+ $server->command("/bind -delete meta-" . uc($key));
+ }
+}
+
+# Remove alias
+sub cmd_window_unalias {
+ my ($data, $server, $witem) = @_;
+
+ if ($data ne '') {
+ Irssi::print("chanact: /chanact_window_unalias does not take any ".
+ "parameters, Run it in the window you want to unalias");
+ return;
+ }
+
+ my $win = Irssi::active_win();
+ my $name = Irssi::active_win()->{name};
+
+ unbind($name, $server);
+
+ # set the windowname back to it's old one. We don't bother checking
+ # for a vaild name here, as we want to remove the current one and if
+ # worse comes to wors set an empty one.
+ $win->set_name($name);
+
+ # if autorenumbering is off, we are done.
+ return unless (Irssi::settings_get_bool('chanact_autorenumber'));
+
+ # we are renumbering, so move the window to the lowest available
+ # refnum.
+ my $refnum = 1;
+ while (Irssi::window_find_refnum($refnum)) {
+ $refnum++;
+ }
+
+ $win->set_refnum($refnum);
+ Irssi::print("chanact: moved wintow to refnum $refnum");
+}
+
+# Make an alias
+sub cmd_window_alias {
+ my ($data, $server, $witem) = @_;
+ my $rn_start = Irssi::settings_get_int('chanact_renumber_start');
+
+ unless ($data =~ /^[a-zA-Z+]$/) {
+ Irssi::print("Usage: /chanact_window_alias <char>");
+ return;
+ }
+
+ # in case of an itemless window $witem is undef, thus future operations
+ # on it fail. to prevent this we pull in the current window.
+ #
+ # Also we need to initialize $winname, else we would get a broken name:
+ #
+ # 'name' => 'S:IRCnet/S:IRCnet/',
+ #
+ my $window;
+ my $winname = "";
+ if (defined($witem)) {
+ $window = $witem->window();
+ $winname = $witem->{name};
+ } else {
+ $window = Irssi::active_win();
+ $winname = $window->{name};
+ }
+
+ unbind($window->{name}, $server);
+
+ my $winnum = $window->{refnum};
+
+ if (Irssi::settings_get_bool('chanact_autorenumber') == 1 &&
+ $window->{refnum} < $rn_start) {
+ my $old_refnum = $window->{refnum};
+
+ $winnum = $rn_start;
+
+ # Find the first available slot and move the window
+ while (Irssi::window_find_refnum($winnum)) { $winnum++; }
+ $window->set_refnum($winnum);
+
+ Irssi::print("Moved the window from $old_refnum to $winnum");
+ }
+
+ my $winserver = $window->{active_server}->{tag};
+ my $winhandle = "$winserver/$winname";
+ # cmd_window_unalias relies on a certain format here
+ my $name = "$data:$winhandle";
+
+ $window->set_name($name);
+ if (Irssi::settings_get_bool('chanact_case_sensitive')) {
+ $server->command("/bind meta-$data change_window $name");
+ } else {
+ $server->command("/bind meta-" . lc($data) . " change_window $name");
+ $server->command("/bind meta-" . uc($data) . " change_window $name");
+ }
+ Irssi::print("Window $winhandle is now accessible with meta-$data");
+}
+
+$needRemake = 1;
+
+# Window alias command
+Irssi::command_bind('chanact_window_alias','cmd_window_alias');
+Irssi::command_bind('chanact_window_unalias','cmd_window_unalias');
+
+# our config item
+Irssi::settings_add_str('chanact', 'chanact_display', '$H$N:$M$C$S');
+Irssi::settings_add_str('chanact', 'chanact_display_alias', '$H$N$M$S');
+Irssi::settings_add_int('chanact', 'chanact_abbreviate_names', 0);
+Irssi::settings_add_bool('chanact', 'chanact_case_sensitive', 1);
+Irssi::settings_add_bool('chanact', 'chanact_show_alias', 1);
+Irssi::settings_add_str('chanact', 'chanact_separator', " ");
+Irssi::settings_add_bool('chanact', 'chanact_autorenumber', 0);
+Irssi::settings_add_bool('chanact', 'chanact_remove_hash', 0);
+Irssi::settings_add_str('chanact', 'chanact_remove_prefix', "");
+Irssi::settings_add_int('chanact', 'chanact_renumber_start', 50);
+Irssi::settings_add_str('chanact', 'chanact_header', "Act: ");
+Irssi::settings_add_bool('chanact', 'chanact_chop_status', 1);
+Irssi::settings_add_str('chanact', 'chanact_sort', 'refnum');
+Irssi::settings_add_int('chanact', 'chanact_filter', 0);
+Irssi::settings_add_str('chanact', 'chanact_filter_windowlist', "");
+Irssi::settings_add_int('chanact', 'chanact_filter_windowlist_level', 0);
+
+# register the statusbar item
+Irssi::statusbar_item_register('chanact', '$0', 'chanact');
+# according to cras we shall not call this
+# Irssi::statusbars_recreate_items();
+
+# register all that nifty callbacks on special events
+Irssi::signal_add_last('setup changed', 'setup_changed');
+Irssi::signal_add_last('window changed', 'chanactHasChanged');
+Irssi::signal_add_last('window item changed', 'chanactHasChanged');
+Irssi::signal_add_last('window hilight', 'chanactHasChanged');
+Irssi::signal_add_last('window item hilight', 'chanactHasChanged');
+Irssi::signal_add("window created", "chanactHasChanged");
+Irssi::signal_add("window destroyed", "chanactHasChanged");
+Irssi::signal_add("window name changed", "chanactHasChanged");
+Irssi::signal_add("window activity", "chanactHasChanged");
+Irssi::signal_add("print text", "chanactHasChanged");
+Irssi::signal_add('nick mode changed', 'chanactHasChanged');
+
+###############
+###
+#
+# Changelog
+#
+# 0.6.0
+# - fixed URL
+# - now with 'use warnings'
+# - fix cmd_window_unalias call from cmd_window_alias
+# - fix Use of uninitialized value $name in hash element warnings
+# - return from cmd_window_unalias if the window has no valid
+# chanact'ified name
+# - rename /window_(un)alias to /chanact_window_(un)alias
+# - fix refnum renumber race
+# - added setting to allow case-insensitive window aliases
+#
+# 0.5.14
+# - fix itemless window handling, thx Bazerka
+# - fix /window_alias for itemless windows
+# - fix /window_unalias. Also longer takes an argument
+# - added sorting by level, based on patch by Bazerka
+# + retired chanact_sort_by_activity, integrated in chanact_sort
+#
+# 0.5.13
+# - trivial cleanup in cmd_window_alias()
+# - updated documentation regarding /layout save, thx Bazerka
+# - removed cmd_rebuild_aliases(), no longer working since we use channel
+# names to select windows and not refnums
+# - removed refnum_changed(), see cmd_rebuild_aliases() above
+#
+# 0.5.12
+# - Use comma instead of colon as windowlist separator, patch by martin f.
+# krafft, reported by James Vega
+#
+# 0.5.11
+# - added chanact_filter_windowlist based on a patch by madduck@madduck.net
+# - fixed display error for nicks/channels with { or } in them
+# - fixed chanact_header, was hidden behind chanact_filter
+# - fixed documentation
+# + removed chanact_show_mode, long gone
+#
+# 0.5.10
+# - fixed irssi crash when using Irssi::print from within remake()
+# - added option to filter out some data levels, based on a patch by
+# Juergen Jung <juergen@Winterkaelte.de>, see
+# https://bc-bd.org/trac/irssi/ticket/15
+# + retired chanact_show_all in favour of chanact_filter
+#
+# 0.5.9
+# - changes by stefan voelkel
+# + sort channels by activity, see
+# https://bc-bd.org/trac/irssi/ticket/5, based on a patch by jan
+# krueger
+# + fixed chrash on /exec -interactive, see
+# https://bc-bd.org/trac/irssi/ticket/7
+#
+# - changes by Jan 'jast' Krueger <jast@heapsort.de>, 2004-06-22
+# + updated documentation in script's comments
+#
+# - changes by Ivo Timmermans <ivo@o2w.nl>
+# + honor actcolor /hilight setting if present
+#
+# 0.5.8
+# - made aliases case-sensitive and include network in channel names by madduck
+#
+# 0.5.7
+# - integrated remove patch by Christoph Berg <myon@debian.org>
+#
+# 0.5.6
+# - fixed a bug (#1) reported by Wouter Coekaert
+#
+# 0.5.5
+# - some speedups from David Leadbeater <dgl@dgl.cx>
+#
+#
+# 0.5.4
+# - added help for chanact_display_alias
+#
+# 0.5.3
+# - added '+' to the available chars of aliase's
+# - added chanact_display_alias to allow different display modes if the window
+# has an alias
+#
+# 0.5.2
+# - removed unused chanact_show_name settings (thx to Qerub)
+# - fixed $mode display
+# - guarded reference operations to (hopefully) fix errors on server disconnect
+#
+# 0.5.1
+# - small typo fixed
+#
+# 0.5.0
+# - changed chanact_show_mode to chanact_display. reversed changes from
+# Qerub through that, but kept funcionality.
+# - removed chanact_color_all since it is no longer needed
+#
+# 0.4.3
+# - changes by Qerub
+# + added chanact_show_mode to show the mode just before the channel name
+# + added chanact_chop_status to be able to control the (status) chopping
+# [bd] minor implementation changes
+# - moved Changelog to the end of the file since it is getting pretty big
+#
+# 0.4.2
+# - changed back to old version numbering sheme
+# - added '=' to Qrczak's chanact_abbreviate_names stuff :)
+# - added chanact_header
+#
+# 0.41q
+# - changes by Qrczak
+# + added setting 'chanact_abbreviate_names'
+# + windows are sorted by refnum; I didn't understand the old
+# logic and it broke sorting for numbers above 9
+#
+# 0.41
+# - minor updates
+# + fixed channel sort [veli]
+# + removed few typos and added some documentation [veli]
+#
+# 0.4
+# - merge with window_alias.pl
+# + added /window_alias from window_alias.pl by veli@piipiip.net
+# + added setting 'chanact_show_alias'
+# + added setting 'chanact_show_names'
+# + changed setting 'chanact_show_mode' to int
+# + added setting 'chanact_separator' [veli]
+# + added setting 'chanact_autorenumber' [veli]
+# + added setting 'chanact_renumber_start' [veli]
+# + added /window_unalias [veli]
+# + moved setting to their own group 'chanact' [veli]
+#
+# 0.3
+# - merge with chanlist.pl
+# + added setting 'chanact_show_mode'
+# + added setting 'chanact_show_all'
+#
+# 0.2
+# - added 'Act' to the item
+# - added setting 'chanact_color_all'
+# - finally found format for statusbar hilight
+#
+# 0.1
+# - Initial Release
+#
+###
+################
diff --git a/scripts/chanfull.pl b/scripts/chanfull.pl
new file mode 100644
index 0000000..f0e6d5a
--- /dev/null
+++ b/scripts/chanfull.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "2003011700";
+%IRSSI = (
+ authors => "Joern 'Wulf' Heissler",
+ contact => "wulf\@wulf.eu.org",
+ name => "chanfull",
+ description => "Notifies the user when some channel limit is reached",
+ license => "GPLv2",
+ url => "",
+ changed => "$VERSION"
+);
+
+use Irssi;
+
+# draws a nice box, author is Stefan 'tommie' Tomanek
+sub draw_box ($$$) {
+ my ($title, $text, $footer) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ return $box;
+}
+
+sub event_message_join ($$$$) {
+ my ($server, $channel, $nick, $address) = @_;
+ my $c=Irssi::channel_find($channel);
+ my $users=scalar @{[$c->nicks]};
+ return if($c->{limit} == 0);
+ my $left = $c->{limit} - $users;
+ if($left < 4) {
+ if($left<=0) {
+ $c->print(draw_box('warning', 'Channel is full!!', 'chanfull'), MSGLEVEL_CLIENTCRAP);
+ } else {
+ $c->print(draw_box('warning', 'Channel is nearly full! ('.$left.' client'.(($left==1)?'':'s').' left)', 'chanfull'), MSGLEVEL_CLIENTCRAP);
+ }
+ }
+}
+
+Irssi::signal_add('message join', 'event_message_join');
+
+Irssi::print '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded.', MSGLEVEL_CLIENTCRAP;
diff --git a/scripts/chanfull_duden.pl b/scripts/chanfull_duden.pl
new file mode 100644
index 0000000..7492568
--- /dev/null
+++ b/scripts/chanfull_duden.pl
@@ -0,0 +1,47 @@
+# by Uwe 'duden' Dudenhoeffer
+#
+# chansync.pl
+
+
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '0.1';
+%IRSSI = (
+ authors => 'Uwe \'duden\' Dudenhoeffer',
+ contact => 'script@duden.eu.org',
+ name => 'chanfull',
+ description => 'Notify if Channellimit is reached',
+ license => 'GPLv2',
+ url => '',
+ changed => 'Sat Feb 8 18:08:54 CET 2003',
+);
+
+# Changelog
+#
+# 0.1
+# - first working version
+
+use Irssi;
+
+sub event_message_join ($$$$) {
+ my ($server, $channel, $nick, $address) = @_;
+ my $c=Irssi::channel_find($channel);
+ my $users=scalar @{[$c->nicks]};
+ return if($c->{limit} == 0);
+ my $left = $c->{limit} - $users;
+ if($left < 3) {
+ if($left<=0) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'chanfull_full', $channel);
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, 'chanfull_left', $left, $channel);
+ }
+ }
+}
+
+Irssi::signal_add('message join', 'event_message_join');
+
+Irssi::theme_register([
+ 'chanfull_left' => 'Only $0 client(s) left in {channel $1} till limit is reached',
+ 'chanfull_full' => '{channel $0} is full'
+]);
diff --git a/scripts/chankeys.pl b/scripts/chankeys.pl
new file mode 100644
index 0000000..0dfb782
--- /dev/null
+++ b/scripts/chankeys.pl
@@ -0,0 +1,570 @@
+# chankeys.pl — Irssi script for associating key shortcuts with channels
+#
+# © 2021–22 martin f. krafft <madduck@madduck.net>
+# Released under the MIT licence.
+#
+### Usage:
+#
+# /script load chankeys
+#
+# This plugin serves to simplify the assignment of keyboard shortcuts that
+# take you to channels or queries (so-called "window items").
+#
+# Let's assume you're in the #irssi channel, then you could issue the command
+#
+# /chankeys add meta-s-meta-i
+#
+# and thenceforth, hitting that key combination will take you to the channel.
+# It's smart enough to check whether a mapping is already in use by chankey,
+# or whether a key combination won't work, for instance because meta-s was
+# already assigned elsewhere in the above.
+#
+# You can also explicitly specify the name (and chatnet) if you'd like to
+# set up a mapping for another item:
+#
+# /chankeys add F12 &bitlbee
+#
+# Key bindings are removed when you leave a channel or a query is closed, and
+# reinstated when the channel or query is reinstated. They are saved to
+# ~/.irssi/chankeys on /save, and loaded from there on startup and /reload.
+#
+### To-do:
+#
+# * Mappings for {01..99} and associated hook to renumber windows with named
+# mappings
+# * Handle queries better, i.e. they should be created if not found, probably
+# just use /query instead of /window goto
+# * When adding a keymap from /chankey add, if the keymap is already assigned
+# to another channel, we need to handle this better
+# * check_for_existing_bind really hurts and causes a bit of lag in Irssi that
+# it doesn't recover from for a few seconds after load. Better to read /bind
+# output once into a hash and use that.
+#
+use strict;
+use warnings;
+use Irssi;
+use version;
+
+our %IRSSI = (
+ authors => 'martin f. krafft',
+ contact => 'madduck@madduck.net',
+ name => 'chankeys',
+ description => 'manage channel keyboard shortcuts',
+ license => 'MIT',
+ version => '0.4.1',
+ changed => '2022-11-18'
+);
+
+our $VERSION = $IRSSI{version};
+my $_VERSION = version->parse($VERSION);
+
+### DEFAULTS AND SETTINGS ######################################################
+
+my $map_file = Irssi::get_irssi_dir()."/chankeys";
+my $go_command = 'window goto $C';
+my $autosave = 1;
+my $overwrite_binds = 0;
+my $clear_composites = 0;
+my $debug = 0;
+
+Irssi::settings_add_str('chankeys', 'chankeys_go_command', $go_command);
+Irssi::settings_add_bool('chankeys', 'chankeys_autosave', $autosave);
+Irssi::settings_add_bool('chankeys', 'chankeys_overwrite_binds', $overwrite_binds);
+Irssi::settings_add_bool('chankeys', 'chankeys_clear_composites', $clear_composites);
+Irssi::settings_add_bool('chankeys', 'chankeys_debug', $debug);
+
+sub sig_setup_changed {
+ $debug = Irssi::settings_get_bool('chankeys_debug');
+ $clear_composites = Irssi::settings_get_bool('chankeys_clear_composites');
+ $overwrite_binds = Irssi::settings_get_bool('chankeys_overwrite_binds');
+ $autosave = Irssi::settings_get_bool('chankeys_autosave');
+ $go_command = Irssi::settings_get_str('chankeys_go_command');
+}
+Irssi::signal_add('setup changed', \&sig_setup_changed);
+Irssi::signal_add('setup reread', \&sig_setup_changed);
+sig_setup_changed();
+
+my $changed_since_last_save = 0;
+
+my %itemmap;
+my %leadkeys;
+
+### HELPERS ####################################################################
+
+sub say {
+ my ($msg, $level, $inwin) = @_;
+ $level = $level // MSGLEVEL_CLIENTCRAP;
+ if ($inwin) {
+ Irssi::active_win->print("chankeys: $msg", $level);
+ }
+ else {
+ Irssi::print("chankeys: $msg", $level);
+ }
+}
+
+sub debug {
+ return unless $debug;
+ my ($msg, $inwin) = @_;
+ $msg = $msg // "";
+ say("DEBUG: ".$msg, MSGLEVEL_CRAP + MSGLEVEL_NO_ACT, $inwin);
+}
+
+sub info {
+ my ($msg, $inwin) = @_;
+ say($msg, MSGLEVEL_CLIENTCRAP, $inwin);
+}
+
+use Data::Dumper;
+sub dumper {
+ debug(scalar Dumper(@_), 1);
+}
+
+sub warning {
+ my ($msg, $inwin) = @_;
+ $msg = $msg // "";
+ say("WARNING: ".$msg, MSGLEVEL_CLIENTERROR, $inwin);
+}
+
+sub error {
+ my ($msg, $inwin) = @_;
+ $msg = $msg // "";
+ say("ERROR: ".$msg, MSGLEVEL_CLIENTERROR, $inwin);
+}
+
+sub channet_pair_to_string {
+ my ($name, $chatnet) = @_;
+ my $ret = $chatnet ? "$chatnet/" : '';
+ return $ret . $name;
+}
+
+sub string_to_channet_pair {
+ my ($str) = @_;
+ return reverse(split(/\//, $str));
+}
+
+sub get_keymap_for_channet_pair {
+ my ($name, $chatnet) = @_;
+ foreach my $cn ($chatnet, undef) {
+ # if not found with $chatnet, fallback to no chatnet
+ my $item = channet_pair_to_string($name, $cn);
+ my $keys = $itemmap{$item};
+ return ($keys, $name, $cn) if $keys;
+ }
+ return ();
+}
+
+sub get_go_command {
+ my ($name, $chatnet) = @_;
+ my $cmd = $go_command;
+ $cmd =~ s/\$C/$name/;
+ $cmd =~ s/\$chatnet/$chatnet/;
+ $cmd =~ s/\s+$//;
+ return $cmd;
+}
+
+my $keybind_to_check;
+my $existing_binding;
+sub check_existing_binds {
+ my ($rec, undef, $text) = @_;
+ if ($rec->{level} == 524288 and $rec->{target} eq '' and !defined $rec->{server}) {
+ if ($text =~ /^\Q${keybind_to_check}\E\s+(.+?)\s*$/) {
+ $existing_binding = $1;
+ }
+ Irssi::signal_stop();
+ }
+}
+
+sub check_for_existing_bind {
+ my ($keys) = @_;
+ $keybind_to_check = $keys;
+ $existing_binding = undef;
+ Irssi::signal_add_first('print text' => \&check_existing_binds);
+ Irssi::command("bind $keybind_to_check");
+ Irssi::signal_remove('print text' => \&check_existing_binds);
+ return $existing_binding;
+}
+
+## KEYMAP HANDLERS #############################################################
+
+sub create_keymapping {
+ my ($keys, $name, $chatnet) = @_;
+ my $cmd = 'command ' . get_go_command($name, $chatnet);
+ if ($keys =~ /(meta-.)-.+/ and !exists($leadkeys{$1})) {
+ if (my $bind = check_for_existing_bind($1)) {
+ if ($clear_composites) {
+ warning("Removing bind from $1 to '$bind' as instructed");
+ Irssi::command("^bind -delete $1");
+ $leadkeys{$1} = $bind;
+ }
+ else {
+ error("$1 is bound to '$bind' and cannot be used in composite keybinding", 1);
+ return 0;
+ }
+ }
+ }
+ Irssi::command("^bind $keys $cmd");
+ return 1;
+}
+
+sub check_create_keymapping {
+ my ($keys, $name, $chatnet) = @_;
+ my $cmd = 'command ' . get_go_command($name, $chatnet);
+ my $bind = check_for_existing_bind($keys);
+ if ($bind and $bind ne $cmd) {
+ if ($overwrite_binds) {
+ warning("Overwriting bind from $keys to '$bind' as instructed");
+ }
+ else {
+ error("Key $keys already bound to '$bind', please remove first.", 1);
+ return 0;
+ }
+ }
+ return create_keymapping($keys, $name, $chatnet);
+}
+
+sub add_keymapping {
+ my ($keys, $name, $chatnet) = @_;
+ if (check_create_keymapping($keys, $name, $chatnet)) {
+ $name = channet_pair_to_string($name, $chatnet);
+ debug("Key binding created: $keys → $name", 1);
+ return 1;
+ }
+ return 0;
+}
+
+sub remove_keymapping {
+ my ($keys) = @_;
+ my $bind = check_for_existing_bind($keys);
+ if (!$bind) {
+ error("No chankey mapping for $keys");
+ return;
+ }
+ my $item = lookup_item_by_keys($keys);
+ if ($item) {
+ Irssi::command("^bind -delete $keys");
+ return $bind;
+ }
+ else {
+ error("The key binding for '$keys' is not a chankeys binding: $bind");
+ return;
+ }
+}
+
+sub lookup_item_by_keys {
+ my ($data) = @_;
+ my $ret;
+ while (my ($item, $keys) = each %itemmap) {
+ $ret = $item if ($keys eq $data);
+ # do not call last or the iterator won't be reset
+ }
+ return $ret;
+}
+
+sub remove_existing_binds {
+ while (my ($item, $keys) = each %itemmap) {
+ Irssi::command("^bind -delete $keys");
+ }
+ %leadkeys = ();
+}
+
+### SAVING AND LOADING #########################################################
+
+sub get_mappings_fh {
+ my ($filename) = @_;
+ my $fh;
+ if (! -e $filename) {
+ save_mappings($filename);
+ info("Created new/empty mappings file: $filename");
+ }
+ open($fh, '<', $filename) || error("Cannot open mappings file: $!");
+ return $fh;
+}
+
+sub load_mappings {
+ my ($filename) = @_;
+ %itemmap = ();
+ my $fh = get_mappings_fh($filename);
+ my $firstline = <$fh> || error("Cannot read from $filename.");;
+ my $version;
+ if ($firstline =~ m/^;+\s+chankeys keymap file \(version: *([\d.]+)\)/) {
+ $version = $1;
+ }
+ else {
+ error("First line of $filename is not a chankey header.");
+ }
+
+ my $l = 1;
+ while (<$fh>) {
+ $l++;
+ next if m/^\s*(?:;|$)/;
+ my ($item, $keys, $rest) = split;
+ if ($rest) {
+ error("Cannot parse $filename:$l: $_");
+ return;
+ }
+ $itemmap{$item} = $keys;
+ }
+ close($fh) || error("Cannot close mappings file: $!");
+}
+
+sub save_mappings {
+ my ($filename) = @_;
+ open(FH, '+>', $filename) || error("Cannot create mappings file: $!");
+ print FH <<"EOF";
+; chankeys keymap file (version: $_VERSION)
+;
+; WARNING: this file will be overwritten on /save,
+; use "/set chankey_autosave off" to avoid.
+;
+; item: channel name (optionally chatnet/#channel) or query partner
+; keys: key combination
+;
+; item keys
+
+EOF
+ foreach my $name (sort keys(%itemmap)) {
+ my $keys = $itemmap{$name};
+ print FH "$name\t$keys\n";
+ }
+ print FH <<"EOF";
+
+; EXAMPLES
+;
+;;; associate meta-s-meta-i with the #irssi channel
+; libera/#irssi meta-s-meta-i
+;
+;;; associate F12 with the bitlbee control window
+; &bitlbee F12
+;
+;;; associate meta-\ with a query
+; bitlbee/sgs7e meta-\\
+
+; vim:noet:tw=0:ts=48:com=b\\:;
+EOF
+ close(FH);
+}
+
+## COMMAND HANDLERS ############################################################
+
+sub chankey_add {
+ my ($data, $server, $witem) = @_;
+ my ($keys, $name, $chatnet) = split /\s+/, $data;
+ if ($name) {
+ ($name, $chatnet) = string_to_channet_pair($name) unless $chatnet;
+ }
+ else {
+ if (!$witem) {
+ error("No active window item to add a channel key for", 1);
+ return;
+ }
+ $name = $witem->{name};
+ $chatnet = $server->{chatnet};
+ }
+ if (add_keymapping($keys, $name, $chatnet)) {
+ $itemmap{channet_pair_to_string($name, $chatnet)} = $keys;
+ $changed_since_last_save = 1;
+ }
+}
+
+sub chankey_remove {
+ my ($data) = @_;
+ return unless $data;
+ my $bind = remove_keymapping($data);
+ if ($bind) {
+ debug("Key binding removed: $data (was: $bind)");
+ my $item = lookup_item_by_keys($data);
+ delete($itemmap{$item});
+ $changed_since_last_save = 1;
+ }
+}
+
+sub chankey_list {
+ return unless %itemmap;
+ info("Key bindings I know about:", 1);
+ foreach my $item (sort keys %itemmap) {
+ my $keys = $itemmap{$item};
+ my $active;
+ if (my $bind = check_for_existing_bind($keys)) {
+ my ($name, $chatnet) = string_to_channet_pair($item);
+ $active = $bind eq ('command ' . get_go_command($name, $chatnet));
+ }
+ my $out = sprintf("%13s %1s %s", $keys, $active ? '→' : '', $item);
+ info($out, 1);
+ }
+}
+
+sub chankey_load {
+ remove_existing_binds();
+ load_mappings($map_file);
+ my $cnt = scalar(keys %itemmap);
+ foreach my $channel (Irssi::channels, Irssi::queries) {
+ my $name = $channel->{name};
+ my $chatnet = $channel->{server}->{chatnet};
+ if (my @keymap = get_keymap_for_channet_pair($name, $chatnet)) {
+ create_keymapping(@keymap);
+ }
+ }
+ $changed_since_last_save = 0;
+ info("Loaded $cnt mappings from $map_file");
+}
+
+sub chankey_save {
+ my ($args) = @_;
+ if (!$changed_since_last_save and $args ne '-force') {
+ info("Not saving unchanged mappings without -force");
+ return;
+ }
+ autosave(1);
+}
+
+sub chankey_goto {
+ my ($args) = @_;
+ my ($name, $chatnet) = split /\s+/, $args;
+ my $cmd = get_go_command($name, $chatnet);
+ Irssi::command("^$cmd");
+}
+
+Irssi::command_bind('chankeys add', \&chankey_add);
+Irssi::command_bind('chankeys remove', \&chankey_remove);
+Irssi::command_bind('chankeys list', \&chankey_list);
+Irssi::command_bind('chankeys reload', \&chankey_load);
+Irssi::command_bind('chankeys save', \&chankey_save);
+Irssi::command_bind('chankeys goto', \&chankey_goto);
+Irssi::command_bind('chankeys help', \&chankey_help);
+Irssi::command_bind('chankeys', sub {
+ my ( $data, $server, $item ) = @_;
+ $data =~ s/\s+$//g;
+ if ($data) {
+ Irssi::command_runsub('chankeys', $data, $server, $item);
+ }
+ else {
+ chankey_help();
+ }
+ }
+);
+Irssi::command_bind('help', sub {
+ $_[0] =~ s/\s+$//g;
+ return unless $_[0] eq 'chankeys';
+ chankey_help();
+ Irssi::signal_stop();
+ }
+);
+
+sub chankey_help {
+ my ($data, $server, $item) = @_;
+ Irssi::print (<<"SCRIPTHELP_EOF", MSGLEVEL_CLIENTCRAP);
+%_chankeys $_VERSION - associate key shortcuts with channels
+
+%U%_Synopsis%_%U
+
+%_CHANKEYS ADD%_ <%Ukeybinding%U> [<%Uchannel%U>] [<%Uchatnet%U>]
+%_CHANKEYS REMOVE%_ <%Ukeybinding%U>
+%_CHANKEYS LIST%_
+%_CHANKEYS [RE]LOAD%_
+%_CHANKEYS SAVE%_ [-force]
+%_CHANKEYS GOTO%_ <%Uchannel%U> [<%Uchatnet%U>]
+%_CHANKEYS HELP%_
+
+<%Ukeybinding%U> %| Key(s) to bind. Refer to %_/HELP BIND%_ for format
+<%Uchannel%U> %| Channel name to associate. Can include %_/chatnet%.
+<%Uchatnet%U> %| The chatnet of the channel. Not generally supported.
+
+%U%_Settings%_%U
+
+/set %_chankeys_go_command%_ [$go_command]
+ %| The command to use to switch to a matching window item. The only reason
+ %| you might need to set this is if you have channels with the same name
+ %| across different chatnets. In this case, you need to load the go2.pl
+ %| module, and set this to "go \$C \$chatnet", because "window goto" cannot
+ %| incorporate the chatnet (yet). Beware that this will prevent
+ %| adv_windowlist.pl from reading out the keybinding to use for the
+ %| statusbar.
+
+/set %_chankeys_overwrite_binds%_ [$overwrite_binds]
+ %| When chankey encounters an existing key mapping, it refuses to overwrite
+ %| it unless this is switched on.
+
+/set %_chankeys_clear_composites%_ [$clear_composites]
+ %| A mapping like meta-s-meta-i will not work if meta-s is bound to something
+ %| already, and chankey will check and fail in such a case. Setting this
+ %| to on will make chankeys remove the existing mapping, such that the
+ %| composite mapping works.
+
+/set %_chankeys_autosave%_ [$autosave]
+ %| Skip saving/overwriting the chankeys setup to file if you prefer to
+ %| maintain the mappings outside of irssi.
+
+/set %_chankeys_debug%_ [$debug]
+ %| Turns on debug output. Not that this may itself be buggy, so please don't
+ %| use it unless you really need it.
+
+%U%_Examples%_%U
+
+Associate %_meta-d-meta-d%_ with the current channel
+ %|%#/%_CHANKEYS ADD%_ meta-d-meta-d
+
+Associate F12 with the &bitlbee window
+ %|%#/%_BIND%_ ^[[24~ key F12
+ %|%#/%_CHANKEYS ADD%_ F12 &bitlbee
+
+Associate %_meta-m-meta-m%_ with the #matrix channel on LiberaChat
+ %|%#/%_CHANKEYS ADD%_ meta-m-meta-m #matrix LiberaChat
+
+Alternative form to specify chatnet
+ %|%#/%_CHANKEYS ADD%_ meta-m-meta-m #matrix/LiberaChat
+
+Save mappings to file ($map_file), using -force to write even if nothing has changed:
+ %|%#/%_CHANKEYS SAVE%_ -force
+
+Load mappings from file ($map_file):
+ %|%#/%_CHANKEYS LOAD%_
+
+List all known key associations
+ %|%#/%_CHANKEYS LIST%_
+SCRIPTHELP_EOF
+}
+
+## SIGNAL HANDLERS #############################################################
+
+sub on_channel_created {
+ my ($chanrec, $auto) = @_;
+ my $name = $chanrec->{name};
+ my $chatnet = $chanrec->{server}->{chatnet};
+ my @keymap = get_keymap_for_channet_pair($name, $chatnet);
+ add_keymapping(@keymap) if @keymap;
+}
+Irssi::signal_add('channel created' => \&on_channel_created);
+Irssi::signal_add('query created' => \&on_channel_created);
+
+sub on_channel_destroyed {
+ my ($chanrec) = @_;
+ my $name = $chanrec->{name};
+ my $chatnet = $chanrec->{server}->{chatnet};
+ my ($keys, undef, undef) = get_keymap_for_channet_pair($name, $chatnet);
+ remove_keymapping($keys) if $keys;
+}
+Irssi::signal_add('channel destroyed' => \&on_channel_destroyed);
+Irssi::signal_add('query destroyed' => \&on_channel_destroyed);
+
+sub autosave {
+ my ($force) = @_;
+ return unless $changed_since_last_save or $force;
+ if (!$autosave) {
+ info("Not saving mappings due to chankeys_autosave setting");
+ return;
+ }
+ info("Saving mappings to $map_file");
+ save_mappings($map_file);
+ $changed_since_last_save = 0;
+}
+
+sub UNLOAD {
+ autosave();
+}
+
+Irssi::signal_add('setup saved', \&autosave);
+Irssi::signal_add('setup reread', \&chankey_load);
+
+## INIT ########################################################################
+
+chankey_load();
diff --git a/scripts/chanpeak.pl b/scripts/chanpeak.pl
new file mode 100644
index 0000000..7cc90a9
--- /dev/null
+++ b/scripts/chanpeak.pl
@@ -0,0 +1,182 @@
+#####
+# chanpeak.pl (last update 05/09/2001)
+#
+# by Bjoern 'fuchs' Krombholz
+# for irssi v0.7.99
+#
+# History:
+# * 0.2.1 remove spaces from /chanpeak arg's end
+# * 0.2.0 !-channel support
+# * 0.1.3 bug fix args evaluation
+# * 0.1.2 bad bug with delimiters in file
+# * 0.1.1 automatically choose active channel; use strict
+# * 0.1.0 initial release
+#
+# TODO:
+# * delete records
+#####
+
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi;
+
+$VERSION = "0.2.2";
+%IRSSI = (
+ authors => "Bjoern \'fuchs\' Krombholz",
+ contact => "bjkro\@gmx.de",
+ name => "chanpeak",
+ license => "Public Domain",
+ description => "Log maximum number of people ever been in a channel",
+ changed => "Wed Jun 2 17:00:00 CET 2002",
+ changes => "added header, removed debugging outputs"
+ );
+
+
+# path to peak data file
+my $peakfile = "$ENV{HOME}/.irssi/peak.data";
+# automatically save peak data file on every new peak
+my $peak_autosave = 1;
+# just for debugging purposes
+my $peak_DEBUG = 0;
+
+#################################################
+
+my %chanpeak;
+
+
+###
+# Remove channel ID for !-channels
+sub sub_chan {
+ my $chan = @_[0];
+ $chan =~ s/^\!\w{5}?/\!/;
+ return $chan;
+}
+
+###
+# Print some help
+sub help_chanpeak {
+ Irssi::print("No peak record found");
+ Irssi::print("\nCHANPEAK [<channel>[@<chatnet>]]\n", MSGLEVEL_CLIENTCRAP);
+ Irssi::print("Shows user peak for <channel>.\n", MSGLEVEL_CLIENTCRAP);
+ Irssi::print("If your current window is a channel window,\n".
+ "print this channel's peak if <channel>\nomitted.",
+ MSGLEVEL_CLIENTCRAP);
+ Irssi::print("Prints matching <channel> peaks of all\n".
+ "ChatNets if <chatnet> omitted.\n", MSGLEVEL_CLIENTCRAP);
+}
+
+
+###
+# Output requested peak
+sub cmd_chanpeak {
+ my ($data, $server, $channel) = @_;
+ my ($chan, $tag) = split(/@/, lc($data));
+ $chan =~ s/ *$//;
+ my $key;
+
+ $chan = sub_chan($chan);
+ if ($chan eq "" && Irssi::active_win()->{active}->{type} eq "CHANNEL") {
+ $chan = sub_chan( lc(Irssi::active_win()->{active}->{name}) );
+ $tag = lc(Irssi::active_win()->{active}->{server}->{tag});
+ Irssi::active_win()->{active}->print("Peak for ".$chan."@".$tag.": ".
+ $chanpeak{$chan}{$tag}{peak}." (".
+ localtime($chanpeak{$chan}{$tag}{date}).")");
+ return 0;
+ } elsif (exists $chanpeak{$chan}) {
+ foreach $key (keys %{$chanpeak{$chan}}) {
+ if ($key eq $tag || $tag eq "") {
+ Irssi::print("Peak for ".$chan."@".$key.": ".
+ $chanpeak{$chan}{$key}{peak}." (".
+ localtime($chanpeak{$chan}{$key}{date}).")");
+ }
+ }
+ return 0;
+ } else {
+ help_chanpeak();
+ return 0;
+ }
+}
+
+###
+# Save peak records to file
+sub cmd_savepeak {
+ my ($chan, $key, $tag);
+
+ if ( !open(PEAKDATA, '>', $peakfile) ) {
+ Irssi::print("Chanpeak: Could not create datafile ".$peakfile);
+ return 1;
+ }
+ foreach $chan (keys %chanpeak) {
+ foreach $tag (keys %{$chanpeak{$chan}}) {
+ print (PEAKDATA $chan." ".$tag." ".$chanpeak{$chan}{$tag}{peak}." ".
+ $chanpeak{$chan}{$tag}{date}."\n");
+ }
+ }
+ Irssi::print("Chanpeak: Saved peak data to ".$peakfile) if ( $peak_DEBUG );
+ close PEAKDATA;
+}
+
+###
+# Update peak record
+sub update_peakrec {
+ my $channel = @_[0];
+ my $chan = lc($channel->{name});
+ my $tag = lc($channel->{server}->{tag});
+ my @nicks = $channel->nicks();
+ my $peak = @nicks;
+
+ $chan = sub_chan($chan);
+ if (!exists $chanpeak{$chan}{$tag}{peak}
+ || $peak > $chanpeak{$chan}{$tag}{peak}) {
+ $chanpeak{$chan}{$tag}{peak} = $peak;
+ $chanpeak{$chan}{$tag}{date} = time();
+ Irssi::print("New peak in ".$chan."@".$tag." : ".$peak);
+ if ($peak_autosave) {
+ cmd_savepeak();
+ }
+ }
+}
+
+###
+# Read data file and initialize already joined channels
+sub init_chanpeak {
+ my ($chan, $channel, $date, $line, $peak, $tag);
+
+ if ( !open(PEAKDATA, '<', $peakfile) ) {
+ Irssi::print('Chanpeak: datafile not found, creating...');
+ if ( !open(PEAKDATA, '>', $peakfile) ) {
+ Irssi::print('Chanpeak: Couldn\'t create datafile `'.$peakfile.'\'!');
+ return 1;
+ }
+ close PEAKDATA;
+ } else {
+ my @lines = <PEAKDATA>;
+ foreach $line (@lines) {
+ if ($line eq "\n") {
+ next;
+ }
+ $line =~ s/\n//;
+ ($chan, $tag, $peak, $date) = split(/ /, $line, 4);
+ $chanpeak{$chan}{$tag}{peak} = $peak;
+ $chanpeak{$chan}{$tag}{date} = $date;
+ }
+ close PEAKDATA;
+ }
+
+ foreach $channel (Irssi::channels()) {
+ $chan = lc($channel->{name});
+ update_peakrec($channel);
+ }
+}
+
+init_chanpeak();
+
+Irssi::signal_add('channel sync', 'update_peakrec');
+Irssi::signal_add_last('massjoin', 'update_peakrec');
+
+Irssi::command_bind('chanpeak', 'cmd_chanpeak', 'chanpeak commands');
+Irssi::command_bind('savepeak', 'cmd_savepeak', 'chanpeak commands');
+Irssi::command_bind('quit', 'cmd_savepeak');
+Irssi::command_bind('save', 'cmd_savepeak');
+
+Irssi::print("chanpeak.pl loaded...");
diff --git a/scripts/chansearch.pl b/scripts/chansearch.pl
new file mode 100644
index 0000000..13831c2
--- /dev/null
+++ b/scripts/chansearch.pl
@@ -0,0 +1,300 @@
+#!/usr/bin/perl
+#
+# by Stefan 'tommie' Tomanek <stefan@pico.ruhr.de>
+
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '2.3';
+%IRSSI = (
+ authors => 'Stefan \'tommie\' Tomanek, bw1',
+ contact => 'bw1@aol.at',
+ name => 'ChanSearch',
+ description => 'searches for specific channels',
+ license => 'GPLv2',
+ url => 'http://scripts.irssi.org/',
+ changed => $VERSION,
+ selfcheckcmd=> '/chansearch -check',
+);
+
+my $help = << "END";
+%9Name%9
+ $IRSSI{name}
+%9Version%9
+ $VERSION
+%9Description%9
+ $IRSSI{description}
+%9Usage%9
+ /chansearch [-network|-n <networkname>] [searchstring]
+ /chansearch -help|-h
+ /chansearch -check
+%9Settings%9
+ /set ChanSearch_default_network freenode
+ /set ChanSearch_max_results 50
+ /set ChanSearch_max_columns 0
+%9See also%9
+ https://netsplit.de/
+END
+
+use utf8;
+use Irssi 20020324;
+use open qw/:std :utf8/;
+use LWP::UserAgent;
+use LWP::Protocol::https;
+use HTML::Entities;
+use JSON::PP;
+use Getopt::Long qw(GetOptionsFromString);
+use POSIX;
+
+use vars qw($forked);
+
+$forked = 0;
+my $footer;
+my ($default_network, $max_results, $max_columns);
+my ($max_columns2);
+my (@results, $resultcount);
+
+# ! for the fork
+my (@clist, $t, $rcount);
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub dehtml {
+ my ($text) =@_;
+ $text =decode_entities($text);
+ $text =~ s/<.*?>//g;
+ return $text;
+}
+
+sub get_entries_count {
+ $t =~ m/(\d+) matching results/;
+ return $1;
+}
+
+sub html_to_list {
+ utf8::decode($t);
+ while (length($t) > 0) {
+ my %h;
+ if ($t =~ m#<span class="cs-channel">(.*?)</span>#p) {
+ $h{channel}= dehtml($1);
+ $' =~ m#<span class="cs-network">(.*?)</span>#p;
+ $h{network}= dehtml($1);
+ #$' =~ m#<span class="cs-users">(.*?)</span>#p;
+ #$' =~ m#<span class="cs-details">Chat Room.*?(\d+).*?</span>#p;
+ $' =~ m#<span class="cs-details">Chat Room - (\d+) users - </span>#p;
+ my $u=$1;
+ #$' =~ m#class="cs-time">.*?</span>(.*?)<span class="cs-category"#p;
+ $' =~ m#(current topic:|No topic)(.*?)<br>#p;
+ $t= $';
+ $h{topic}=dehtml($2);
+ $u =~ m/(\d+)/;
+ $h{users}=$1;
+ push @clist, {%h};
+ } else {
+ $t='';
+ }
+ }
+}
+
+sub fork_search {
+ my ($query,$net) = @_;
+ $footer="$net $query";
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ return if $forked;
+ my $pid = fork();
+ $forked = 1;
+ if ($pid > 0) {
+ close($wh);
+ Irssi::pidwait_add($pid);
+ my $pipetag;
+ my @args = ($rh, \$pipetag);
+ $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
+ print CLIENTCRAP "%R>>%n Please wait...";
+ } else {
+ search_channels($query,$net);
+ #my $data = encode_json( \@clist );
+ my $data = encode_json( { clist=>[ @clist ], rcount=>$rcount } );
+ print($wh $data);
+ close($wh);
+ POSIX::_exit(1);
+ }
+}
+
+sub pipe_input ($$) {
+ my ($rh, $pipetag) = @{$_[0]};
+ my $data;
+ {
+ select($rh);
+ local $/;
+ select(CLIENTCRAP);
+ $data = <$rh>;
+ close($rh);
+ }
+ Irssi::input_remove($$pipetag);
+ return unless($data);
+
+ my $res= decode_json( $data );
+ @results = @{ $res->{clist} };
+ $resultcount = $res->{rcount};
+
+ my $lnet=0;
+ my $lchan=0;
+ foreach (@results) {
+ $lnet =length($_->{network}) if ($lnet <length($_->{network}));
+ $lchan =length($_->{channel}) if ($lchan <length($_->{channel}));
+ }
+ $lnet++;
+ $lchan++;
+
+ my $text;
+ foreach (@results) {
+ $text .= sprintf("%-".$lnet."s%-".$lchan."s %4i %s\n",
+ $_->{network}, $_->{channel}, $_->{users}, substr($_->{topic},0,
+ $max_columns2-$lnet-$lchan));
+ }
+
+ $forked = 0;
+ print CLIENTCRAP draw_box('ChanSearch', $text, $footer, 1);
+}
+
+sub search_channels ($) {
+ my ($query,$net) = @_;
+ my $ua = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1,timeout => 30);
+ $ua->agent('Irssi Chansearch');
+ # http://irc.netsplit.de/channels/?net=IRCnet&chat=linux&num=10
+ my $num='';
+ my $count=0;
+ do {
+ my $page = "http://irc.netsplit.de/channels/?net=$net&chat=$query$num";
+ my $result = $ua->get($page);
+ return undef unless $result->is_success();
+ $t = $result->content();
+ $rcount = get_entries_count();
+ html_to_list();
+ $count += 10;
+ $num ="&num=$count";
+ } while ( $count < $rcount && $count < $max_results );
+}
+
+sub cmd_chansearch ($$$) {
+ my ($args, $server, $witem) = @_;
+ my $net= $default_network;
+ my $help;
+ my ($re, $ar) = GetOptionsFromString($args,
+ 'network=s' => \$net,
+ 'n=s' => \$net,
+ 'help' => \$help,
+ 'h' => \$help,
+ 'check' => \&self_check_init,
+ );
+ if ($max_columns==0) {
+ $max_columns2 = Irssi::active_win()->{width} -15;
+ }
+ if (!defined $help) {
+ fork_search($ar->[0], $net);
+ } else {
+ cmd_help($IRSSI{name}, $server, $witem);
+ }
+}
+
+sub self_check_init {
+ $max_results=30;
+ fork_search('linux','Freenode');
+ Irssi::timeout_add_once(5*1000, 'sig_self_check','');
+}
+
+sub self_check_quit {
+ my ( $s )=@_;
+ Irssi::command("selfcheckhelperscript $s");
+}
+
+sub sig_self_check {
+ my ($min, $max);
+ # min result
+ $min=20;
+ if ( scalar @results >= $min) {
+ print "Results: ",scalar @results," check";
+ } else {
+ print "Results: ",scalar @results," <$min fail";
+ self_check_quit("Error: self check fail (result)");
+ }
+ # result more pages
+ if ( $resultcount == scalar @results || $max_results == scalar @results ) {
+ print "Resultscount: $resultcount check";
+ } else {
+ print "Resultscount: $resultcount fail";
+ self_check_quit("Error: self check fail (pages)");
+ }
+ $max_results= Irssi::settings_get_int($IRSSI{name}.'_max_results');
+ # topic
+ $min= 1000;
+ $max= 0;
+ foreach my $n ( @results ) {
+ my $l = length ( $n->{topic} );
+ $min = $l if ($l < $min);
+ $max = $l if ($l > $max);
+ }
+ if ( $min != $max && $max >200 ) {
+ print "Topic min:$min max:$max check";
+ } else {
+ print "Topic min:$min max:$max";
+ self_check_quit("Error: self check fail (topic)");
+ }
+ # users
+ $min= 10000;
+ $max= 0;
+ foreach my $n ( @results ) {
+ my $l = $n->{users} ;
+ $min = $l if ($l < $min);
+ $max = $l if ($l > $max);
+ }
+ if ( $min != $max && $max >200 ) {
+ print "Users min:$min max:$max check";
+ } else {
+ print "Users min:$min max:$max";
+ self_check_quit("Error: self check fail (users)");
+ }
+ self_check_quit('ok');
+}
+
+sub sig_setup_changed {
+ $default_network= Irssi::settings_get_str($IRSSI{name}.'_default_network');
+ $max_results= Irssi::settings_get_int($IRSSI{name}.'_max_results');
+ $max_columns= Irssi::settings_get_int($IRSSI{name}.'_max_columns');
+}
+
+sub cmd_help {
+ my ($args, $server, $witem)=@_;
+ $args=~ s/\s+//g;
+ if (lc($IRSSI{name}) eq lc($args)) {
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop();
+ }
+}
+
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_default_network', 'freenode' );
+Irssi::settings_add_int($IRSSI{name}, $IRSSI{name}.'_max_results', 50 );
+Irssi::settings_add_int($IRSSI{name}, $IRSSI{name}.'_max_columns', 0 );
+
+Irssi::signal_add('setup changed', "sig_setup_changed");
+
+Irssi::command_bind('chansearch', \&cmd_chansearch);
+Irssi::command_set_options('chansearch', 'network check');
+Irssi::command_bind('help', \&cmd_help);
+
+sig_setup_changed();
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded';
+
+# vim:set sw=4 ts=8:
diff --git a/scripts/chanshare.pl b/scripts/chanshare.pl
new file mode 100644
index 0000000..dbd4bbe
--- /dev/null
+++ b/scripts/chanshare.pl
@@ -0,0 +1,122 @@
+# /CHANSHARE - display people who are in more than one channel with you
+# for irssi 0.7.98
+#
+# /CHANSHARE [ircnets ...] [#channels ...]
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# Version 0.1 - Timo Sirainen tss@iki.fi
+# Initial stalker.pl
+# Version 0.2 - Chad Armstrong chad@analogself.com
+# Added multiserver support
+# Added keying by nick AND hostname. "nick (fw.corp.com)"
+# Prints to current active window now.
+# Version 0.21 - Timo Sirainen tss@iki.fi
+# Removed printing to active window - if you want it, remove your
+# status window.
+# Version 0.3 - Timo Sirainen tss@iki.fi
+# Supports for limiting searches only to specified ircnets and
+# channels. Some cleanups..
+# Version 0.4 - bw1
+# bug fix
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.4";
+%IRSSI = (
+ authors => "Timo \'cras\' Sirainen",
+ contact => "tss\@iki.fi",
+ name => "chan share",
+ description => "/CHANSHARE - display people who are in more than one channel with you",
+ license => "Public Domain",
+ url => "http://irssi.org/",
+ changed => "2019-02-13",
+);
+
+sub cmd_chanshare {
+ my ($data, $server, $channel) = @_;
+ my (%channicks, @show_channels, @show_ircnets);
+
+ # get list of channels and ircnets
+ @show_channels = ();
+ @show_ircnets = ();
+ foreach my $arg (split(" ", $data)) {
+ if ($server->ischannel($arg)) {
+ push @show_channels, $arg;
+ } else {
+ push @show_ircnets, $arg;
+ }
+ }
+
+ my @checkservers = ();
+ if (scalar(@show_ircnets) == 0) {
+ # check from all servers
+ @checkservers = Irssi::servers();
+ } else {
+ # check from specified ircnets
+ foreach my $s (Irssi::servers()) {
+ foreach my $n (@show_ircnets) {
+ if ($s->{chatnet} eq $n) {
+ push @checkservers, $s;
+ last;
+ }
+ }
+ }
+ }
+
+ foreach my $s (@checkservers) {
+ my $mynick = $s->{nick};
+ foreach my $channel ($s->channels()) {
+ foreach my $nick ($channel->nicks()) {
+ my ($user, $host) = split(/@/, $nick->{host});
+ my $nickhost = $nick->{nick}." ($host)";
+ my @list = ();
+ next if ($nick->{nick} eq $mynick);
+
+ @list = @{$channicks{$nickhost}} if (exists $channicks{$nickhost});
+# Irssi::print($nickhost);
+ push @list, $channel->{name};
+ $channicks{$nickhost} = [@list];
+ }
+ }
+ }
+
+ Irssi::print("Nicks of those who share your #channels:");
+ foreach my $nick (keys %channicks) {
+ my @channels = @{$channicks{$nick}};
+ if (@channels > 1) {
+ my $chanstr = "";
+ my $ok = scalar(@show_channels) == 0;
+ foreach $channel (@channels) {
+ if (!$ok) {
+ # check the show_channels list..
+ foreach my $c (@show_channels) {
+ if ($channel eq $c) {
+ $ok = 1;
+ last;
+ }
+ }
+ }
+ $chanstr .= "$channel ";
+ }
+ Irssi::print("$chanstr : $nick") if ($ok);
+ }
+ }
+}
+
+Irssi::command_bind('chanshare', 'cmd_chanshare');
+
+# vim:set ts=8 sw=2 expandtab:
diff --git a/scripts/chansort.pl b/scripts/chansort.pl
new file mode 100644
index 0000000..7f85237
--- /dev/null
+++ b/scripts/chansort.pl
@@ -0,0 +1,79 @@
+#
+# Copyright (C) 2004-2021 by Peder Stray <peder.stray@gmail.com>
+#
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+
+use vars qw{$VERSION %IRSSI};
+($VERSION) = '$Revision: 1.5.1 $' =~ / (\d+(\.\d+)+) /;
+%IRSSI = (
+ name => 'chansort',
+ authors => 'Peder Stray',
+ contact => 'peder.stray@gmail.com',
+ url => 'https://github.com/pstray/irssi-chansort',
+ license => 'GPL',
+ description => 'Sort all channel and query windows',
+ );
+
+sub sig_sort_trigger {
+ return unless Irssi::settings_get_bool('chansort_autosort');
+ cmd_chansort();
+}
+
+# Usage: /CHANSORT
+sub cmd_chansort {
+ my(@windows);
+ my($minwin);
+
+ my $netonly = Irssi::settings_get_bool('chansort_netonly');
+
+ for my $win (Irssi::windows()) {
+ my $act = $win->{active};
+ my $key;
+
+ my $id = sprintf "%05d", $win->{refnum};
+
+ if ($act->{type} eq 'CHANNEL') {
+ $key = "C".$act->{server}{tag}.' '.($netonly ? $id : substr($act->{visible_name}, 1));
+ }
+ elsif ($act->{type} eq 'QUERY') {
+ $key = "Q".$act->{server}{tag}.' '.($netonly ? $id : $act->{visible_name});
+ }
+ else {
+ next;
+ }
+ if (!defined($minwin) || $minwin > $win->{refnum}) {
+ $minwin = $win->{refnum};
+ }
+ push @windows, [ lc $key, $win ];
+
+ }
+
+ for (sort {$a->[0] cmp $b->[0]} @windows) {
+ my($key,$win) = @$_;
+ my($act) = $win->{active};
+
+# printf("win[%d->%d]: t[%s] [%s] [%s] {%s}\n",
+# $win->{refnum},
+# $minwin,
+# $act->{type},
+# $act->{visible_name},
+# $act->{server}{tag},
+# $key,
+# );
+
+ $win->command("window move $minwin");
+ $minwin++;
+ }
+}
+
+Irssi::command_bind('chansort', 'cmd_chansort');
+
+Irssi::settings_add_bool('chansort', 'chansort_autosort', 0);
+Irssi::settings_add_bool('chansort', 'chansort_netonly', 0);
+
+Irssi::signal_add_last('window item name changed', 'sig_sort_trigger');
+Irssi::signal_add_last('channel created', 'sig_sort_trigger');
+Irssi::signal_add_last('query created', 'sig_sort_trigger');
diff --git a/scripts/chansync.pl b/scripts/chansync.pl
new file mode 100644
index 0000000..5ec869f
--- /dev/null
+++ b/scripts/chansync.pl
@@ -0,0 +1,75 @@
+# by Uwe 'duden' Dudenhoeffer
+#
+# chansync.pl
+
+
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '0.22';
+%IRSSI = (
+ authors => 'Uwe \'duden\' Dudenhoeffer',
+ contact => 'script@duden.eu.org',
+ name => 'chansync',
+ description => '/who a channel and optionaly executes a command',
+ license => 'GPLv2',
+ url => '',
+ changed => 'Sun Feb 9 18:27:51 CET 2003',
+ commands => 'chansync',
+);
+
+# Changelog
+#
+# 0.22
+# - added "commands => chansync"
+#
+# 0.21
+# - some design issues
+#
+# 0.2
+# - used "silent event who" instead of stopping "print text"
+#
+# 0.1
+# - first working version
+
+use Irssi 20020324;
+use POSIX;
+
+my(%arguments,%items);
+
+# Usage: /chansync [command]
+sub cmd_chansync {
+ my($args, $server, $item) = @_;
+ return if not ($item && $item->{type} eq "CHANNEL");
+ my($chan) = $item->{name};
+ $server->redirect_event('who', 1, $chan, -1, undef,
+ {
+ "event 315" => "redir chansync endwho",
+ "event 352" => "redir chansync who",
+ "" => "event empty",
+ });
+ $server->send_raw("WHO $chan");
+ $arguments{lc $chan} = $args;
+ $items{lc $chan} = $item;
+}
+
+sub sig_event_block {
+ Irssi::signal_stop();
+}
+
+sub sig_redir_chansync_who {
+ Irssi::signal_emit('silent event who', @_);
+}
+
+sub sig_redir_chansync_endwho {
+ my($server) = shift;
+ my(@text) = split " ", shift;
+ my($cmd) = $arguments{lc @text[1]};
+ $items{lc @text[1]}->command("$cmd");
+ delete $arguments{lc @text[1]};
+ delete $items{lc @text[1]};
+}
+
+Irssi::command_bind("chansync", "cmd_chansync");
+Irssi::signal_add('redir chansync who', 'sig_redir_chansync_who');
+Irssi::signal_add('redir chansync endwho', 'sig_redir_chansync_endwho');
diff --git a/scripts/chops.pl b/scripts/chops.pl
new file mode 100644
index 0000000..b97a4b2
--- /dev/null
+++ b/scripts/chops.pl
@@ -0,0 +1,144 @@
+#!/usr/bin/perl -w
+
+# chops.pl: Simulates BitchX's /chops and /nops commands
+# prints list with nickname and userhost
+#
+# Written by Jakub Jankowski <shasta@atn.pl>
+# for irssi 0.7.98.CVS
+#
+# todo:
+# - enhance the look of the script
+#
+# sample /chops output:
+# [11:36:33] -!- Irssi: Information about chanops on #irssi
+# [11:36:33] -!- Irssi: [nick] [hostmask]
+# [11:36:33] -!- Irssi: shasta shasta@quasimodo.olsztyn.tpsa.pl
+# [11:36:34] -!- Irssi: cras cras@xmunkki.org
+# [11:36:34] -!- Irssi: fuchs fox@wh8043.stw.uni-rostock.de
+# [11:36:34] -!- Irssi: End of listing
+#
+# sample /nops output:
+# [11:40:34] -!- Irssi: Information about non-ops on #irssi
+# [11:40:34] -!- Irssi: [nick] [hostmask]
+# [11:40:34] -!- Irssi: globe_ ~globe@ui20i21hel.dial.kolumbus.fi
+# [11:40:34] -!- Irssi: shastaBX shasta@thorn.kanal.olsztyn.pl
+# [11:40:34] -!- Irssi: End of listing
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "20020223";
+%IRSSI = (
+ authors => 'Jakub Jankowski',
+ contact => 'shasta@atn.pl',
+ name => 'chops',
+ description => 'Simulates BitchX\'s /CHOPS and /NOPS commands.',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.atn.pl/',
+);
+
+use Irssi;
+use Irssi::Irc;
+
+Irssi::theme_register([
+ 'chops_nochan', 'You are not on a channel',
+ 'chops_notsynced', 'Channel $0 is not fully synchronized yet',
+ 'chops_noone', 'There are no $0 to list',
+ 'chops_start', 'Information about $0 on $1',
+ 'chops_end', 'End of listing',
+ 'chops_header', '[nick] [hostmask]',
+ 'chops_line', '$[!9]0 $[!50]1'
+]);
+
+sub cmd_chops {
+ my ($data, $server, $channel) = @_;
+ my @chanops = ();
+
+ # if we're not on a channel, print appropriate message and return
+ if (!$channel) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_nochan');
+ return;
+ }
+
+ # if channel is not fully synced yet, print appropriate message and return
+ if (!$channel->{synced}) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_notsynced', $channel->{name});
+ return;
+ }
+
+ # gather all opped people into an array
+ foreach my $nick ($channel->nicks()) {
+ push(@chanops, $nick) if ($nick->{op});
+ }
+
+ # if there are no chanops, print appropriate message and return
+ if (scalar(@chanops) < 1) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_noone', "chanops");
+ return;
+ }
+
+ # print a starting message
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_start', "chanops", $channel->{name});
+
+ # print listing header
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_header');
+
+ # print every chanop's nick, status (gone/here), userhost and hopcount
+ foreach my $nick (@chanops) {
+ my $userhost = $nick->{host};
+ # if user's host is longer than 50 characters, cut it to 47 to fit in column
+ $userhost = substr($userhost, 0, 47) if (length($userhost) > 50);
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_line', $nick->{nick}, $userhost);
+ }
+
+ # print listing footer
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_end');
+}
+
+sub cmd_nops {
+ my ($data, $server, $channel) = @_;
+ my @nonops = ();
+
+ # if we're not on a channel, print appropriate message and return
+ if (!$channel) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_nochan');
+ return;
+ }
+
+ # if channel is not fully synced yet, print appropriate message and return
+ if (!$channel->{synced}) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_notsynced', $channel->{name});
+ return;
+ }
+
+ # gather all not opped people into an array
+ foreach my $nick ($channel->nicks()) {
+ push(@nonops, $nick) if (!$nick->{op});
+ }
+
+ # if there are only chanops, print appropriate message and return
+ if (scalar(@nonops) < 1) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_noone', "non-ops");
+ return;
+ }
+
+ # print a starting message
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_start', "non-ops", $channel->{name});
+
+ # print listing header
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_header');
+
+ # print every chanop's nick, status (gone/here), userhost and hopcount
+ foreach my $nick (@nonops) {
+ my $userhost = $nick->{host};
+ # if user's host is longer than 50 characters, cut it to 47 to fit in column
+ $userhost = substr($userhost, 0, 47) if (length($userhost) > 50);
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_line', $nick->{nick}, $userhost);
+ }
+
+ # print listing footer
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'chops_end');
+}
+
+Irssi::command_bind("chops", "cmd_chops");
+Irssi::command_bind("nops", "cmd_nops");
diff --git a/scripts/cleanpublic.pl b/scripts/cleanpublic.pl
new file mode 100644
index 0000000..364fd8f
--- /dev/null
+++ b/scripts/cleanpublic.pl
@@ -0,0 +1,41 @@
+# Simple script for removing colours in public channels :)
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+# Dev. info ^_^
+$VERSION = "0.3";
+%IRSSI = (
+ authors => "Jørgen Tjernø",
+ contact => "darkthorne\@samsen.com",
+ name => "CleanPublic",
+ description => "Simple script that removes colors and other formatting (bold, etc) from public channels",
+ license => "GPL",
+ url => "http://mental.mine.nu",
+ changed => "Wed Sep 24 13:17:15 CEST 2003"
+);
+
+# All the works
+sub strip_formatting {
+ my ($server, $data, $nick, $mask, $target) = @_;
+ # Channel *allowed* to be colorful?
+ foreach my $chan (split(' ', Irssi::settings_get_str('colored_channels'))) {
+ if ($target eq $chan) { return }
+ }
+
+ # Ruthlessly_ripped_from_Garion {
+ my $twin = Irssi::window_find_name($target);
+ # Beam it to window 1 if we cant find any other suitable target.
+ if (!defined($twin)) { $twin = Irssi::window_find_refnum(1); }
+ # }
+
+ # Remove formatting
+ $data =~ s/\x03\d?\d?(,\d?\d?)?|\x02|\x1f|\x16|\x06|\x07//g;
+ # Let it flow
+ Irssi::signal_continue($server, $data, $nick, $mask, $target);
+}
+
+# Hook me up
+Irssi::signal_add('message public', 'strip_formatting');
+Irssi::settings_add_str('lookandfeel', 'colored_channels', '');
diff --git a/scripts/clipboard.pl b/scripts/clipboard.pl
new file mode 100644
index 0000000..36a6489
--- /dev/null
+++ b/scripts/clipboard.pl
@@ -0,0 +1,90 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+use Irssi::Irc;
+use Tk;
+
+$VERSION = '1.2';
+%IRSSI = (
+authors => 'Dominic Battre',
+contact => 'dominic@battre.de',
+name => 'Quoting from X clipboard',
+description => 'Better quoting of content from clipboard (without leading spaces) -- requires Perl/Tk',
+license => 'Public Domain',
+url => 'http://www.battre.de',
+changed => 'Fri Dec 6 23:23:31 CET 2002',
+);
+
+# if you quote long lines by selecting the text and inserting via middle
+# mousebutton you get something like this:
+# 23:12 <@DominicB> 23:11 <@DominicB> This is a very long line. This is a very
+# long line. This is a
+# 23:12 <@DominicB> very long line. This is a very long line.
+# This is a very long
+# 23:12 <@DominicB> line.
+#
+# this script queries the clipboard of X11, strips leading blanks and
+# joins lines if needed so the result would be
+# 23:16 <@DominicB> 23:11 <@DominicB> This is a very long line. This is a very
+# long line. This is a very long line. This is a very long
+# line. This is a very long line.
+#
+# just execute by /qc ("quote clipboard")
+# for print only use /qc -p
+
+
+# Known problem
+# if you
+# 1) connect via `ssh -X user@localhost`
+# 2) start `screen irssi`
+# 3) use /qc,
+# 4) disconnect ssh
+# 5) reconnect via `ssh -X user@localhost`
+# 6) `screen -R -D`
+# 7) use /qc again
+# => screen and along with it irssi terminate
+# the problem persists if you try
+# perl -e 'use Tk;print MainWindow->new->SelectionGet("-selection","CLIPBOARD")'
+# in a ssh -X/screen environment. Thus it seems to be a problem of
+# X forwarding - not of Perl/Tk
+
+# credits to
+#
+# Hugo Haas for s/CLIPBOARD/PRIMARY/ (using PRIMARY instead of
+# CLIPBOARD in order to use highlighted text instead of the
+# X clipboard (identical to middle clicking)
+#
+# Clemens Heidinger using Irssi::print() now if /qc is executed outside a channel/query
+# -p for printing only
+
+Irssi::command_bind('qc','cmd_quoteclipboard');
+
+sub cmd_quoteclipboard {
+ my ($arguments, $server, $witem) = @_;
+
+ my $main = MainWindow->new;
+ my $text = $main->SelectionGet('-selection','PRIMARY');
+ $main->destroy();
+
+ my $sendMsg = ( $arguments !~ /-p/ && # no parameter -p
+ defined($witem) && $witem &&
+ ($witem->{'type'} eq 'CHANNEL' || $witem->{'type'} eq 'QUERY') )
+ ? sub { $server->command("msg $witem->{'name'} @_[0]"); }
+ : sub { Irssi::print(@_[0], MSGLEVEL_CRAP); };
+
+ my $prev = "";
+
+ while ( $text =~ /^( *)(.*)$/gm ) {
+ if ( $1 eq "" and $prev ne "") {
+ $sendMsg->($prev);
+ $prev = "$2 ";
+ } else {
+ $prev .= "$2 ";
+ }
+ }
+
+ if ( $prev ne "" ) {
+ $sendMsg->($prev);
+ }
+}
diff --git a/scripts/cloneprot.pl b/scripts/cloneprot.pl
new file mode 100644
index 0000000..2e51721
--- /dev/null
+++ b/scripts/cloneprot.pl
@@ -0,0 +1,89 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi;
+
+$VERSION = "1.11";
+%IRSSI = (
+ authors => "Rick (strlen) Jansen",
+ contact => "strlen\@shellz.nl",
+ name => "cloneprot",
+ description => "Parses OperServ notices to make autokill aliases from clonewarnings",
+ license => "GPL/1",
+ url => "http://www.shellz.nl/",
+ changed => "Wed Mar 13 20:26:46 CET 2002",
+);
+
+my ($lastmask, $clones, $trig, $hostmask, $username, $hostname);
+
+sub event_callback {
+ my ($server, $data, $sender, $address) = @_;
+ my $count = 0;
+ if ($sender eq $server->{address}) {
+ if ($data =~ /from OperServ: CLONES\((\d+)\): /) {
+ $clones = $1;
+ $trig = $clones + 2;
+ if ($data =~ /((\S+)\@(\S+))/) {
+ $hostmask = $1;
+ $username = $2;
+ $hostname = $3;
+ if ($hostmask eq $lastmask) {
+ $count++;
+ Irssi::print("[Warning #$count] $clones clones.");
+ Irssi::print("[[/tk (1h)] - [/ak 1|2 (6h)] - [/tr ($trig)] - [/cw 1|2 (/who)]]");
+ } else {
+ $server->command("/who $hostname");
+ Irssi::print("[Warning #1: $clones clones.");
+ Irssi::print("[1: $hostmask] - [2: $hostname]");
+ Irssi::print("[[/tk (1h)] - [/ak 1|2 (6h)] - [/tr ($trig)] - [/cw 1|2 (/who)]]");
+ $count=1;
+ }
+ Irssi::signal_stop();
+ }
+ }
+ }
+}
+
+sub cw_callback {
+ my ($mode,$server) = @_;
+ if ($mode == 1) {
+ $server->command("/who $hostmask");
+ } elsif ($mode == 2) {
+ $server->command("/who $hostname");
+ } else {
+ Irssi::print("Usage: /cw 1|2");
+ }
+}
+
+sub tk_callback {
+ my ($null,$server) = @_;
+ $server->command("/msg operserv tempakill $hostname Don't clone on SorceryNet.");
+}
+
+sub ak_callback {
+ my ($mode,$server) = @_;
+ if ($mode == 1) {
+ $server->command("/msg operserv autokill 6 $hostmask Don't clone on SorceryNet.");
+ } elsif ($mode == 2) {
+ $server->command("/msg operserv autokill 6 *!*\@$hostname Don't clone on SorceryNet.");
+ } else {
+ Irssi::print("Usage: /ak 1|2");
+ }
+}
+
+sub tr_callback {
+ my ($mode,$server) = @_;
+ if ($mode == 1) {
+ $server->command("/msg operserv trigger $username\@$hostname $trig");
+ } elsif ($mode == 2) {
+ $server->command("/msg operserv trigger $hostname $trig");
+ } else {
+ Irssi::print("Usage: /tr 1|2");
+ }
+}
+
+Irssi::command_bind("tk","tk_callback");
+Irssi::command_bind("ak","ak_callback");
+Irssi::command_bind("tr","tr_callback");
+Irssi::command_bind("cw","cw_callback");
+
+Irssi::signal_add("server event","event_callback");
diff --git a/scripts/clones.pl b/scripts/clones.pl
new file mode 100644
index 0000000..0175bd8
--- /dev/null
+++ b/scripts/clones.pl
@@ -0,0 +1,55 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi 20010920.0000 ();
+$VERSION = "2.01";
+%IRSSI = (
+ authors => 'From irssi source, modified by David Leadbeater (dg)',
+ name => 'clones',
+ description => '/CLONES - Display clones in the active channel (with added options)',
+ license => 'Same as Irssi',
+ url => 'http://irssi.dgl.cx/',
+);
+
+sub cmd_clones {
+ my ($data, $server, $channel) = @_;
+
+ my $min = $data =~ /\d/ ? $data : Irssi::settings_get_int('clones_min_show');
+
+ if (!$channel || $channel->{type} ne 'CHANNEL') {
+ Irssi::print('No active channel in window');
+ return;
+ }
+
+ my %hostnames = {};
+ my $ident = Irssi::settings_get_bool('clones_host_only');
+
+ foreach my $nick ($channel->nicks()) {
+ my $hostname;
+ if($ident) {
+ ($hostname = $nick->{host}) =~ s/^[^@]+@//;
+ }else{
+ $hostname = $nick->{host};
+ }
+
+ $hostnames{$hostname} ||= [];
+ push( @{ $hostnames{$hostname} }, $nick->{nick});
+ }
+
+ my $count = 0;
+ foreach my $host (keys %hostnames) {
+ next unless ref($hostnames{$host}) eq 'ARRAY'; # sometimes a hash is here
+ my @clones = @{ $hostnames{$host} };
+ if (scalar @clones >= $min) {
+ $channel->print('Clones:') if ($count == 0);
+ $channel->print("$host: " . join(' ',@clones));
+ $count++;
+ }
+ }
+
+ $channel->print('No clones in channel') if ($count == 0);
+}
+
+Irssi::command_bind('clones', 'cmd_clones');
+Irssi::settings_add_bool('misc', 'clones_host_only', 1);
+Irssi::settings_add_int('misc', 'clones_min_show', 2);
+
diff --git a/scripts/colored_nicks.pl b/scripts/colored_nicks.pl
new file mode 100644
index 0000000..af68499
--- /dev/null
+++ b/scripts/colored_nicks.pl
@@ -0,0 +1,479 @@
+########################################
+# Header ###############################
+########################################
+
+use strict;
+use Encode();
+use Irssi;
+use vars qw($VERSION %IRSSI);
+$VERSION = 'r4';
+%IRSSI = (
+ 'name' => 'colored_nicks',
+ 'authors' => 'Trilkk',
+ 'contact' => 'trilkk ät iki.fi',
+ 'url' => 'https://github.com/trilkk/irssi-colored-nicks',
+ 'license' => 'BSD',
+ 'description' => 'Exposes colored nickname variables for themes',
+);
+
+# List of protocols to act on.
+my @action_protos = qw(irc silc xmpp);
+# Global expando variable.
+my $expando_cnnick = '';
+# Global expando variable.
+my $expando_cnpadl = '';
+# Global expando variable.
+my $expando_cnpads = '';
+# Global expando variable.
+my $expando_cnuser = '';
+
+########################################
+# Functions ############################
+########################################
+
+# Creates a terminal color command code string.
+# Use cubes.pl to check string input.
+# Similar function in nickcolor_expando.pl by Nei was used as basis.
+# See: https://github.com/irssi/scripts.irssi.org/blob/master/scripts/nickcolor_expando.pl
+# \param 0 Irssi color code.
+# \return Color command code.
+sub create_color_command_code
+{
+ my $input_code = $_[0];
+ $input_code =~ /%(.*)/;
+ my $code = $1;
+
+ # First, try simple 16-color terminal codes.
+ my %color_map_16c =
+ (
+ 'k' => '0',
+ 'b' => '1',
+ 'g' => '2',
+ 'c' => '3',
+ 'r' => '4',
+ 'm' => '5',
+ 'y' => '6',
+ 'w' => '7',
+ 'K' => '8',
+ 'B' => '9',
+ 'G' => ':',
+ 'C' => ';',
+ 'R' => '<',
+ 'M' => '=',
+ 'Y' => '>',
+ 'W' => '?',
+ );
+ if(exists $color_map_16c{$code})
+ {
+ return "\cD" . $color_map_16c{$code} . '/';
+ }
+
+ # Try 256-color terminal codes.
+ my @ext_colour_off =
+ (
+ '.', '-', ',', '+', "'", '&',
+ );
+ if($code =~ /^(x)(?:0([[:xdigit:]])|([1-6])(?:([0-9])|([a-z]))|7([a-x]))$/i)
+ {
+ my $bg = $1 eq 'x';
+ my $col = defined $2 ? hex $2
+ : defined $6 ? 232 + (ord lc $6) - (ord 'a')
+ : 16 + 36 * ($3 - 1) + (defined $4 ? $4 : 10 + (ord lc $5) - (ord 'a'));
+ if ($col < 0x10)
+ {
+ my $chr = chr $col + ord '0';
+ return "\cD" . ($bg ? "/$chr" : "$chr/")
+ }
+ else
+ {
+ return "\cD" . $ext_colour_off[($col - 0x10) / 0x50 + $bg * 3] . chr (($col - 0x10) % 0x50 - 1 + ord '0')
+ }
+ }
+
+ # Default fallback is just gray.
+ return "\cD" . '7/';
+}
+
+# Create an irssi nickname string for a nick with maximum amount of characters.
+# \param 0 Nick.
+# \param 1 Attribution.
+# \param 2 Number of characters nick can use at maximum.
+# \return Truncated, colored nickname string.
+sub create_irssi_nick
+{
+ my $nick = $_[0];
+ my $attr = $_[1];
+ my $truncation = $_[2];
+
+ my $len = nick_length($nick);
+ if($attr)
+ {
+ $len += nick_length($attr);
+ }
+
+ # Hash the color before modifying nick.
+ my $color = simple_hash_color($nick);
+ my $format = create_color_command_code($color);
+
+ # Decrease until within parameters.
+ if($truncation > 0)
+ {
+ while($len > $truncation)
+ {
+ if(length($attr) > 1)
+ {
+ chop($attr);
+ }
+ else
+ {
+ chop($nick);
+ }
+ --$len;
+ }
+ }
+
+ if($attr)
+ {
+ return $format . $nick . create_color_command_code('%K') . $attr;
+ }
+ return $format . $nick;
+}
+
+# Create a buffer of spaces to pad a nick to n characters.
+# \param 0 Nick.
+# \param 1 Attribution.
+# \param 2 Number of characters nick can use at maximum.
+# \return Whitespace padding buffer.
+sub create_padding
+{
+ my $nick = $_[0];
+ my $attr = $_[1];
+ my $truncation = $_[2];
+
+ my $len = nick_length($nick);
+ if($attr)
+ {
+ $len += nick_length($attr);
+ }
+
+ my $ret = '';
+ if($truncation > 0)
+ {
+ while($len < $truncation)
+ {
+ ++$len;
+ $ret .= ' ';
+ }
+ }
+ return $ret;
+}
+
+# Extracts attribution information from the message.
+# \param 0 Nick.
+# \return Tuple of (nickname part, attribution part).
+sub extract_attribution
+{
+ my $nick = $_[0];
+ Encode::_utf8_on($nick);
+
+ # Split nickname from boundary of allowed IRC nickname characters.
+ # Non-breakable space and zero-width space are valid characters.
+ $nick =~ /^([\w\s\|\^_`\-\{\}\[\]\\\x{00A0}\x{200B}\x{202F}]+)(.*)$/;
+ return ($1, $2);
+}
+
+# Calculates djb2 hash over an array.
+# \param 0 Input array.
+# \return calculated hash.
+sub hash_djb2
+{
+ my @array = @_;
+ my $ret = 5381;
+ foreach my $cc (@array)
+ {
+ my $oo = ord($cc);
+ if(!is_zero_width($oo))
+ {
+ $ret = (($ret * 33) + $oo) & 0xFFFFFFFF;
+ }
+ }
+ return $ret;
+}
+
+# Calculates sdbm hash over an array.
+# \param 0 Input array.
+# \return calculated hash.
+sub hash_sdbm
+{
+ my @array = @_;
+ my $ret = 0;
+ foreach my $cc (@array)
+ {
+ my $oo = ord($cc);
+ if(!is_zero_width($oo))
+ {
+ $ret = (($ret * 65599) + $oo) & 0xFFFFFFFF;
+ }
+ }
+ return $ret;
+}
+
+# Gets the color array.
+# \return Color array.
+sub get_color_array()
+{
+ my $ret = Irssi::settings_get_str('colored_nicks_colors');
+ $ret =~ s/^\s+//;
+ $ret =~ s/\s+$//;
+ return split /\s/, $ret;
+}
+
+# Tells if a character has zero width.
+# \param 0 Character.
+# \return True if character has zero widh, false otherwise.
+sub is_zero_width
+{
+ my $cc = $_[0];
+ my @zero_width_chars =
+ (
+ 0x200B,
+ );
+ foreach my $zz (@zero_width_chars)
+ {
+ if(($cc == $zz) || (ord($cc) == $zz))
+ {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+# Calculate real length of a nickname.
+# Non-breakable space is not included.
+# \param 0 Nick, must be in unicode.
+# \return Nick length in terminal characters.
+sub nick_length
+{
+ my $nick = $_[0];
+ my $ret = 0;
+ foreach my $cc (split //,$nick)
+ {
+ if(!is_zero_width($cc))
+ {
+ ++$ret;
+ }
+ }
+ return $ret;
+};
+
+# Simple hash based on nick.
+# \param 0 String to hash.
+# \return Hash value.
+sub simple_hash
+{
+ # Remove characters that should not be taken into account for.
+ my $input_string = $_[0];
+ $input_string =~ s/^[\s_\-^]*//;
+ $input_string =~ s/[\s_\-^]*$//;
+ my @array = split(//, $input_string);
+ # Check for djb2 hash.
+ my $hash_function = Irssi::settings_get_str('colored_nicks_hash_function');
+ if($hash_function =~ /^djb2$/i)
+ {
+ return hash_djb2(@array);
+ }
+ # Fallback to sdbm hash.
+ return hash_sdbm(@array);
+}
+
+# Simple hash, but pick color based on nick.
+# \param 0 String to hash.
+# \return Color change string.
+sub simple_hash_color
+{
+ my $input_string = $_[0];
+ my @colors = get_color_array();
+ return $colors[simple_hash($input_string) % @colors];
+}
+
+########################################
+# Commands #############################
+########################################
+
+# Test command to list all colors in use.
+sub cmd_cn_list
+{
+ my $window = Irssi::active_win;
+ my $mode = MSGLEVEL_NEVER | MSGLEVEL_CLIENTCRAP;
+ my @colors = get_color_array();
+ for(my $ii = 0; ($ii < @colors); ++$ii)
+ {
+ my $color = @colors[$ii];
+ my $code = create_color_command_code($color);
+ # Insert non-breakable space as second character so irssi doesn't use the color code.
+ $color = substr($color, 0, 1) . "\x{200B}" . substr($color, 1);
+ $window->print($code . 'colored_nicks_' . $ii . '_' . $color, $mode);
+ }
+}
+
+# Test command for given input.
+# \param 0 Test nickname.
+sub cmd_cn_test
+{
+ my @nicks = split /\s/, $_[0];
+ my $window = Irssi::active_win;
+ my $mode = MSGLEVEL_NEVER | MSGLEVEL_CLIENTCRAP;
+ my $truncation_long = Irssi::settings_get_int('colored_nicks_truncation_long');
+ # Iterate over the input.
+ my $ret = '';
+ foreach my $nick (@nicks)
+ {
+ if($ret)
+ {
+ $ret .= ' ';
+ }
+ $ret .= create_irssi_nick($nick, '', $truncation_long);
+ }
+ # Only print if there was legit input.
+ if($ret)
+ {
+ $window->print($ret, $mode);
+ }
+}
+
+########################################
+# Signal hooks #########################
+########################################
+
+# Signal function for private messages to the user.
+# \param 0 Server struct.
+# \param 1 ???
+# \param 2 Input nickname.
+# \param 3 ???
+# \param 4 ???
+sub signal_cn_private
+{
+ my ($server, $param1, $input_nick, $param3, $param4) = @_;
+ my ($nick, $attr) = extract_attribution($input_nick);
+ my $truncation_long = Irssi::settings_get_int('colored_nicks_truncation_long');
+ $expando_cnnick = create_irssi_nick($nick, $attr, $truncation_long);
+ $expando_cnpadl = create_padding($nick, $attr, $truncation_long);
+ $expando_cnpads = '';
+ $expando_cnuser = '';
+}
+
+# Signal function for public messages by others.
+# \param 0 Server struct.
+# \param 1 ???
+# \param 2 Input nickname.
+# \param 3 ???
+# \param 4 ???
+sub signal_cn_public
+{
+ my ($server, $param1, $input_nick, $param3, $param4) = @_;
+ my ($nick, $attr) = extract_attribution($input_nick);
+ my $truncation_long = Irssi::settings_get_int('colored_nicks_truncation_long');
+ my $truncation_short = Irssi::settings_get_int('colored_nicks_truncation_short');
+ $expando_cnnick = create_irssi_nick($nick, $attr, $truncation_long);
+ $expando_cnpadl = create_padding($nick, $attr, $truncation_long);
+ $expando_cnpads = create_padding($nick, $attr, $truncation_short);
+ $expando_cnuser = '';
+}
+
+# Signal function for public messages from the user.
+# \param 0 Server struct.
+# \param 1 ???
+# \param 2 ???
+sub signal_cn_own_public
+{
+ my ($server, $param1, $param2) = @_;
+ my $truncation_long = Irssi::settings_get_int('colored_nicks_truncation_long');
+ $expando_cnnick = '';
+ $expando_cnpadl = create_padding($server->{nick}, '', $truncation_long);
+ $expando_cnpads = '';
+ $expando_cnuser = create_irssi_nick($server->{nick}, '', $truncation_long);
+}
+
+# Signal function for private messages from the user.
+# \param 0 Server struct.
+# \param 1 ???
+# \param 2 Input nick
+# \param 3 ???
+# \param 4 ???
+sub signal_cn_own_private
+{
+ my ($server, $param1, $input_nick, $param3) = @_;
+ my ($nick, $attr) = extract_attribution($input_nick);
+ my $truncation_long = Irssi::settings_get_int('colored_nicks_truncation_long');
+ $expando_cnnick = create_irssi_nick($nick, $attr, $truncation_long);
+ $expando_cnpadl = create_padding($nick, $attr, $truncation_long);
+ $expando_cnpads = create_padding($server->{nick}, '', $truncation_long);
+ $expando_cnuser = create_irssi_nick($server->{nick}, '', $truncation_long);
+}
+
+########################################
+# Irssi:: ##############################
+########################################
+
+Irssi::settings_add_str('misc', 'colored_nicks_colors',
+ '%c %X3N' . # cyans
+ ' ' .
+ '%X59 %X4B %X4A %m' . # magentas/purples
+ ' ' .
+ '%w %X7P %X7Q %X7R' . # whites
+ ' ' .
+ '%g %X1J %X2I %X2J %X3I' . # greens
+ ' ' .
+ '%X46 %X4C %X5I' . # browns
+ ' ' .
+ '%X2N %X2M %X1N %B' . # blues
+ ' ' .
+ '%X5C %X56 %y' . # oranges/yellows
+ ' ' .
+ '%X58 %X57' . # pinks/reds
+ '');
+Irssi::settings_add_str('misc', 'colored_nicks_hash_function', 'djb2');
+Irssi::settings_add_int('misc', 'colored_nicks_truncation_long', 12);
+Irssi::settings_add_int('misc', 'colored_nicks_truncation_short', 11);
+
+Irssi::expando_create('cnnick', sub { $expando_cnnick }, {
+ 'message public' => 'none',
+ 'message own_public' => 'none',
+ (map { ("message $_ action" => 'none',
+ "message $_ own_action" => 'none')
+ } @action_protos),
+ });
+
+Irssi::expando_create('cnpadl', sub { $expando_cnpadl }, {
+ 'message public' => 'none',
+ 'message own_public' => 'none',
+ (map { ("message $_ action" => 'none',
+ "message $_ own_action" => 'none')
+ } @action_protos),
+ });
+
+Irssi::expando_create('cnpads', sub { $expando_cnpads }, {
+ 'message public' => 'none',
+ 'message own_public' => 'none',
+ (map { ("message $_ action" => 'none',
+ "message $_ own_action" => 'none')
+ } @action_protos),
+ });
+
+Irssi::expando_create('cnuser', sub { $expando_cnuser }, {
+ 'message public' => 'none',
+ 'message own_public' => 'none',
+ (map { ("message $_ action" => 'none',
+ "message $_ own_action" => 'none')
+ } @action_protos),
+ });
+
+Irssi::signal_add({
+ 'message private' => 'signal_cn_private',
+ 'message public' => 'signal_cn_public',
+ 'message own_public' => 'signal_cn_own_public',
+ 'message own_private' => 'signal_cn_own_private',
+});
+
+Irssi::command_bind('colored_nicks_list', 'cmd_cn_list');
+Irssi::command_bind('colored_nicks_test', 'cmd_cn_test');
diff --git a/scripts/colorize_nicks.pl b/scripts/colorize_nicks.pl
new file mode 100644
index 0000000..afeb707
--- /dev/null
+++ b/scripts/colorize_nicks.pl
@@ -0,0 +1,217 @@
+use strict;
+use warnings;
+
+our $VERSION = '0.4.1'; # ed9cb119fc4b3d1
+our %IRSSI = (
+ authors => 'Nei',
+ contact => 'Nei @ anti@conference.jabber.teamidiot.de',
+ url => "http://anti.teamidiot.de/",
+ name => 'colorize_nicks',
+ description => 'Colourise mention of nicks in the message body.',
+ license => 'GNU GPLv2 or later',
+ );
+
+# inspired by mrwright's nickcolor.pl and xt's colorize_nicks.pl
+#
+# you need nickcolor_expando or another nickcolor script providing the
+# get_nick_color2 function
+
+# Usage
+# =====
+# should start working once loaded
+
+# Options
+# =======
+# /set colorize_nicks_skip_formats <num>
+# * how many forms (blocks of irssi format codes or non-letters) to
+# skip at the beginning of line before starting to colourise nicks
+# (you usually want to skip the speaker's nick itself and the
+# timestamp)
+#
+# /set colorize_nicks_ignore_list <words to ignore>
+# * list of nicks (words) that should never be coloured
+#
+# /set colorize_nicks_repeat_formats <ON|OFF>
+# * repeat the format stack from the beginning of line, enable when
+# using per-line colours and colorize_nicks breaks it
+
+# Commands
+# ========
+# you can use this alias:
+#
+# /alias nocolorize set colorize_nicks_ignore_list $colorize_nicks_ignore_list
+#
+# /nocolorize <nick>
+# * quickly add nick to the bad word list of nicks that should not be
+# colourised
+
+no warnings 'redefine';
+use Irssi;
+
+my $irssi_mumbo = qr/\cD[`-i]|\cD[&-@\xff]./;
+
+my $nickchar = qr/[\]\[[:alnum:]\\|`^{}_-]/;
+my $nick_pat = qr/($nickchar+)/;
+
+my @ignore_list;
+
+my $colourer_script;
+
+sub _find_colourer {
+ my $colourer;
+ unless ($colourer_script
+ && ($colourer = "Irssi::Script::$colourer_script"->can('get_nick_color2'))) {
+ for my $script (sort map { s/::$//r } keys %Irssi::Script::) {
+ if ($colourer = "Irssi::Script::$script"->can('get_nick_color2')) {
+ $colourer_script = $script;
+ last;
+ }
+ }
+ }
+ $colourer
+}
+
+sub _get_chanref {
+ my ($dest) = @_;
+ return unless $dest->{level} & MSGLEVEL_PUBLIC;
+ return unless defined $dest->{target};
+ return unless ref $dest->{server};
+ $dest->{server}->channel_find($dest->{target})
+}
+
+sub _colourise_nicks {
+ my ($dest, $chanref, $colourer, @nicks) = @_;
+
+ my %nicks = map { $_->[0] => $colourer->($dest->{server}{tag}, $chanref->{name}, $_->[1], 1) }
+ grep { defined }
+ map { if (my $nr = $chanref->nick_find($_)) {
+ [ $_ => $nr->{nick} ]
+ } }
+ keys %{ +{ map { $_ => undef } @nicks } };
+ delete @nicks{ @ignore_list };
+
+ my $nick_re = join '|', map { quotemeta } sort { length $b <=> length $a } grep { length $nicks{$_} } keys %nicks;
+
+ (\%nicks, $nick_re)
+}
+
+sub _colourise_form {
+ my ( $text,
+ $skip,
+ $nicks,
+ $nick_re ) = @_;
+ return if $skip < 0;
+
+ my $repeat = Irssi::settings_get_bool('colorize_nicks_repeat_formats');
+
+ my @forms = split /((?:$irssi_mumbo|\s|[.,*@%+&!#$()=~'";:?\/><]+(?=$irssi_mumbo|\s))+)/, $text, -1;
+ my $ret = '';
+ my $fmtstack = '';
+ while (@forms) {
+ my ($t, $form) = splice @forms, 0, 2;
+ if ($skip > 0) {
+ --$skip;
+ $ret .= $t;
+ $ret .= $form if defined $form;
+ if ($repeat) {
+ $fmtstack .= join '', $form =~ /$irssi_mumbo/g if defined $form;
+ $fmtstack =~ s/\cDe//g;
+ }
+ }
+ elsif (length $nick_re
+ && $t =~ s/((?:^|\s)\W{0,3}?)(?<!$nickchar|')($nick_re)(?!$nickchar)/$1$nicks->{$2}$2\cDg$fmtstack/g) {
+ $ret .= "$t\cDg$fmtstack";
+ $ret .= $form if defined $form;
+ $fmtstack .= join '', $form =~ /$irssi_mumbo/g if defined $form;
+ $fmtstack =~ s/\cDe//g;
+ }
+ else {
+ $ret .= $t;
+ $ret .= $form if defined $form;
+ }
+ }
+
+ $ret
+}
+
+# TXT_OWN_MSG, server->nick, msg, nickmode
+# TXT_OWN_MSG_CHANNEL, server->nick, target, msg, nickmode
+# TXT_PUBMSG_HILIGHT, color, printnick, msg, nickmode
+# TXT_PUBMSG_HILIGHT_CHANNEL, color, printnick, target, msg, nickmode
+# for_me ? TXT_PUBMSG_ME : TXT_PUBMSG, printnick, msg, nickmode
+# for_me ? TXT_PUBMSG_ME_CHANNEL : TXT_PUBMSG_CHANNEL, printnick, target, msg, nickmode
+sub prt_format_issue {
+ my ( $theme,
+ $module,
+ $dest,
+ $format,
+ @args
+ ) = @_;
+ my $chanref = _get_chanref($dest);
+ return unless $chanref;
+ my $colourer = _find_colourer();
+ return unless $colourer;
+
+ my $arg = 1;
+ $arg++ if $format =~ /_channel/;
+ $arg++ if $format =~ /_hilight/;
+ return unless @args > $arg;
+
+ utf8::decode($args[$arg]);
+ my $text = $args[$arg];
+ my $stripped = Irssi::strip_codes($text);
+
+ utf8::decode($stripped);
+ my ($nicks, $nick_re) = _colourise_nicks($dest, $chanref, $colourer, $stripped =~ /$nick_pat/g);
+ return unless $nicks;
+
+ $args[$arg] = _colourise_form($text, 0, $nicks, $nick_re);
+ Irssi::signal_continue($theme, $module, $dest, $format, @args)
+ if defined $args[$arg] && $args[$arg] ne $text;
+}
+
+sub prt_text_issue {
+ my ( $dest,
+ $text,
+ $stripped
+ ) = @_;
+ my $chanref = _get_chanref($dest);
+ return unless $chanref;
+ my $colourer = _find_colourer();
+ return unless $colourer;
+
+ utf8::decode($text);
+ utf8::decode($stripped);
+ my ($nicks, $nick_re) = _colourise_nicks($dest, $chanref, $colourer, $stripped =~ /$nick_pat/g);
+ return unless $nicks;
+
+ my $skip = Irssi::settings_get_int('colorize_nicks_skip_formats');
+ my $ret = _colourise_form($text, $skip, $nicks, $nick_re);
+ Irssi::signal_continue($dest, $ret, $stripped)
+ if defined $ret && $ret ne $text;
+}
+
+sub setup_changed {
+ @ignore_list = split /\s+|,/, Irssi::settings_get_str('colorize_nicks_ignore_list');
+}
+
+sub init {
+ setup_changed();
+}
+
+if ((Irssi::parse_special('$abiversion')||0) >= 28) {
+ Irssi::signal_add(
+ 'print format' => 'prt_format_issue'
+ );
+} else {
+ Irssi::signal_add(
+ 'print text' => 'prt_text_issue'
+ );
+ Irssi::settings_add_int('colorize_nicks', 'colorize_nicks_skip_formats' => 2);
+}
+Irssi::signal_add_last('setup changed' => 'setup_changed');
+
+Irssi::settings_add_str('colorize_nicks', 'colorize_nicks_ignore_list' => '');
+Irssi::settings_add_bool('colorize_nicks', 'colorize_nicks_repeat_formats' => 0);
+
+init();
diff --git a/scripts/colorkick.pl b/scripts/colorkick.pl
new file mode 100644
index 0000000..c28e420
--- /dev/null
+++ b/scripts/colorkick.pl
@@ -0,0 +1,69 @@
+#!/usr/pkg/bin/perl
+#
+# script what's kicking users for using color or blink
+#
+# settings:
+# what type function
+# colorkick_channels str list of channels have to be ``protected''
+# colorkick_color int 0: don't kick on color
+# colorkick_blink int 0: don't kick on blink
+#
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+
+use vars qw/%IRSSI $VERSION/;
+$VERSION='0.1';
+%IRSSI =
+(
+ authors => "Gabor Nyeki",
+ contact => "bigmac\@vim.hu",
+ name => "colorkick",
+ description => "kicking users for using colors or blinks",
+ license => "public domain",
+ written => "Thu Dec 26 00:22:54 CET 2002",
+ changed => "2017-03-07"
+);
+
+sub catch_junk
+{
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $text) = split(/ :/, $data, 2);
+ my $valid_channel = 0;
+
+ #if ($target[0] != '#' && $target[0] != '!' && $target[0] != '&')
+ #{
+ # return;
+ #}
+
+ for my $channel (split(/ /,
+ Irssi::settings_get_str('colorkick_channels')))
+ {
+ if ($target eq $channel)
+ {
+ $valid_channel = 1;
+ last;
+ }
+ }
+ if ($valid_channel == 0)
+ {
+ return;
+ }
+
+ if ($text =~ /\x3/ &&
+ Irssi::settings_get_bool('colorkick_color'))
+ {
+ $server->send_raw("KICK $target $nick :color abuse");
+ }
+ elsif ($text =~ /\x6/ &&
+ Irssi::settings_get_bool('colorkick_blink'))
+ {
+ $server->send_raw("KICK $target $nick :blink abuse");
+ }
+}
+
+Irssi::settings_add_str('colorkick', 'colorkick_channels', '');
+Irssi::settings_add_bool('colorkick', 'colorkick_color', 1);
+Irssi::settings_add_bool('colorkick', 'colorkick_blink', 1);
+Irssi::signal_add("event privmsg", "catch_junk");
diff --git a/scripts/connectcmd.pl b/scripts/connectcmd.pl
new file mode 100644
index 0000000..9b5bf38
--- /dev/null
+++ b/scripts/connectcmd.pl
@@ -0,0 +1,165 @@
+use strict;
+use Irssi 20020101.0250 ();
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.2";
+%IRSSI = (
+ authors => "Ian Peters",
+ contact => "itp\@ximian.com",
+ name => "Connect Command",
+ description => "run arbitrary shell commands while [dis]connecting to a server",
+ license => "Public Domain",
+ url => "http://irssi.org/",
+ changed => "2017-03-18"
+);
+
+my %preconn_actions;
+my %postconn_actions;
+my %disconn_actions;
+
+sub load_actions {
+ my $fi;
+
+ open $fi, '<', "$ENV{HOME}/.irssi/connectcmd_actions";
+
+ while (<$fi>) {
+ my @lines = split "\n";
+ foreach my $line (@lines) {
+ my ($server, $type, $action) = split ":", $line;
+ if ($type eq "preconn") {
+ $preconn_actions{$server} = $action;
+ } elsif ($type eq "postconn") {
+ $postconn_actions{$server} = $action;
+ } elsif ($type eq "disconn") {
+ $disconn_actions{$server} = $action;
+ }
+ }
+ }
+
+ close $fi;
+}
+
+sub save_actions {
+ my $fa;
+ open $fa, q{>}, "$ENV{HOME}/.irssi/connectcmd_actions";
+
+ foreach my $server (keys %preconn_actions) {
+ print $fa "$server:preconn:$preconn_actions{$server}\n";
+ }
+ foreach my $server (keys %postconn_actions) {
+ print $fa "$server:postconn:$postconn_actions{$server}\n";
+ }
+ foreach my $server (keys %disconn_actions) {
+ print $fa "$server:disconn:$disconn_actions{$server}\n";
+ }
+
+ close $fa;
+}
+
+sub sig_server_looking {
+ my ($server) = @_;
+
+ if (my $action = $preconn_actions{$server->{'address'}}) {
+ system ($action);
+ }
+}
+
+sub sig_server_connected {
+ my ($server) = @_;
+
+ if (my $action = $postconn_actions{$server->{'address'}}) {
+ system ($action);
+ }
+}
+
+sub sig_server_disconnected {
+ my ($server) = @_;
+
+ if (my $action = $disconn_actions{$server->{'address'}}) {
+ system ($action);
+ }
+}
+
+sub cmd_connectcmd {
+ my ($data, $server, $witem) = @_;
+
+ #my ($op, $type, $server, $action) = split " ", $data;
+ $data =~ m/^(\S*)\s+(\S*)\s+(\S*)\s+(.*)$/;
+ my $op=$1;
+ my $type=$2;
+ my $server=$3;
+ my $action=$4;
+
+ $op = lc $op;
+
+ if (!$op) {
+ Irssi::print ("No operation given");
+ } elsif ($op eq "add") {
+ if (!$type) {
+ Irssi::print ("Type not specified [preconn|postconn|disconn]");
+ } elsif (!$server) {
+ Irssi::print ("Server not specified");
+ } elsif (!$action) {
+ Irssi::print ("Action not specified");
+ } else {
+ if ($type eq "preconn") {
+ $preconn_actions{$server} = $action;
+ Irssi::print ("Added preconnect action of $action on $server");
+ save_actions;
+ } elsif ($type eq "postconn") {
+ $postconn_actions{$server} = $action;
+ Irssi::print ("Added postconnect action of $action on $server");
+ save_actions;
+ } elsif ($type eq "disconn") {
+ $disconn_actions{$server} = $action;
+ Irssi::print ("Added disconnect action of $action on $server");
+ save_actions;
+ } else {
+ Irssi::print ("Unrecognized trigger $type [preconn|postconn|disconn]");
+ }
+ }
+ } elsif ($op eq "remove") {
+ if (!$type) {
+ Irssi::print ("Type not specified [preconn|postconn|disconn]");
+ } elsif (!$server) {
+ Irssi::print ("Server not specified");
+ } else {
+ if ($type eq "preconn") {
+ delete ($preconn_actions{$server});
+ Irssi::print ("Removed preconnect action on $server");
+ save_actions;
+ } elsif ($type eq "postconn") {
+ delete ($postconn_actions{$server});
+ Irssi::print ("Removed postconnect action on $server");
+ save_actions;
+ } elsif ($type eq "disconn") {
+ delete ($disconn_actions{$server});
+ Irssi::print ("Removed disconnect action on $server");
+ save_actions;
+ } else {
+ Irssi::print ("Unrecognized trigger $type [preconn|postconn|disconn]");
+ }
+ }
+ } elsif ($op eq "list") {
+ Irssi::print ("Preconnect Actions:");
+ foreach my $server (keys %preconn_actions) {
+ Irssi::print ("$server $preconn_actions{$server}");
+ }
+ Irssi::print ("Postconnect Actions:");
+ foreach my $server (keys %postconn_actions) {
+ Irssi::print ("$server $postconn_actions{$server}");
+ }
+ Irssi::print ("Disconnect Actions:");
+ foreach my $server (keys %disconn_actions) {
+ Irssi::print ("$server $disconn_actions{$server}");
+ }
+ }
+}
+
+load_actions();
+
+Irssi::command_bind ('connectcmd', 'cmd_connectcmd');
+
+Irssi::signal_add ('server looking', 'sig_server_looking');
+Irssi::signal_add ('server connected', 'sig_server_connected');
+Irssi::signal_add ('server disconnected', 'sig_server_disconnected');
diff --git a/scripts/copy.pl b/scripts/copy.pl
new file mode 100644
index 0000000..7b1e6e2
--- /dev/null
+++ b/scripts/copy.pl
@@ -0,0 +1,290 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+use Irssi::UI;
+use Irssi::TextUI;
+use MIME::Base64;
+use File::Glob qw/:bsd_glob/;
+
+$VERSION = '0.10';
+%IRSSI = (
+ authors => 'vague,bw1',
+ contact => 'bw1@aol.at',
+ name => 'copy',
+ description => 'copy a line in a paste buffer',
+ license => 'Public Domain',
+ url => 'https://scripts.irssi.org/',
+ changed => '2020-09-26',
+ modules => 'MIME::Base64 File::Glob',
+ commands=> 'copy',
+);
+
+my $help = << "END";
+%9Name%9
+ $IRSSI{name}
+%9Version%9
+ $VERSION
+%9Synopsis%9
+ /copy [start [end]]
+ /copy <-f word>
+%9Description%9
+ $IRSSI{description}
+
+ Tested with xterm, tmux, screen and ssh
+ see man xterm /disallowedWindowOps
+%9Settings%9
+ $IRSSI{name}_selection
+ c clipboard
+ p primary
+ q secondary
+ s select
+ 0-7 cut buffers
+ $IRSSI{name}_method
+ xterm
+ xclip
+ xsel
+ screen
+ print
+ file
+ $IRSSI{name}_file
+ filename for method 'file'
+ $IRSSI{name}_file_mode
+ open mode for method 'file'
+ $IRSSI{name}_file_eol
+ end of line string for method 'file'
+%9See also%9
+ https://www.freecodecamp.org/news/tmux-in-practice-integration-with-system-clipboard-bcd72c62ff7b/
+ http://anti.teamidiot.de/static/nei/*/Code/urxvt/
+ https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Operating-System-Commands
+END
+
+# Thanks
+#
+# dive
+# /tmp/screen-exchange
+# nei
+# http://anti.teamidiot.de/static/nei/*/Code/urxvt/
+# vague
+# line buffer
+
+my ($copy_selection, $copy_method);
+my ($copy_file, $copy_file_mode, $copy_file_eol);
+
+
+sub cmd_copy {
+ my ($args, $server, $witem)=@_;
+ my ($opt, $arg) = Irssi::command_parse_options('copy', $args);
+ if (exists $opt->{f}) {
+ cmd_find($opt->{f}, $server, $witem);
+ } else {
+ cmd_num($args, $server, $witem);
+ }
+}
+
+sub cmd_find {
+ my ($args, $server, $witem)=@_;
+ my $line=Irssi::active_win->view->{startline};
+ my $str;
+ while ( defined $line ) {
+ my $s= $line->get_text(0);
+ if ( $s =~ /$args/ ) {
+ $str =$s;
+ last;
+ }
+ $line= $line->next();
+ }
+ if (defined $str) {
+ paste ($str);
+ }
+}
+
+sub cmd_num {
+ my ($args, $server, $witem)=@_;
+ my $line=Irssi::active_win->view->{buffer}{cur_line};
+ unless (defined $line) {
+ Irssi::print('No Copy!', MSGLEVEL_CLIENTCRAP);
+ return();
+ }
+
+ my @arg = split /[\s-]/, $args;
+ if(@arg > 2 || grep {/[^\d]+/} @arg) {
+ Irssi::print('Illegal range!', MSGLEVEL_CLIENTCRAP);
+ return();
+ }
+
+ $arg[0] = 1 if ($arg[0]==0);
+ $arg[0] -= 1;
+ $arg[1] -= 1 if defined $arg[1];
+
+ for(1..$arg[0]) {
+ last unless $line->prev;
+ $line = $line->prev;
+ }
+
+ my $str;
+ for($arg[0]..($arg[1] // $arg[0])) {
+ $str = join $copy_file_eol, $line->get_text(0), $str;
+
+ last unless $line->prev;
+ $line = $line->prev;
+ }
+ paste ($str);
+}
+
+sub paste {
+ my ($str)= @_;
+ if ( $copy_method eq 'xterm' ) {
+ paste_xterm($str, $copy_selection);
+ } elsif ( $copy_method eq 'xclip' ) {
+ paste_xclip($str, $copy_selection);
+ } elsif ( $copy_method eq 'xsel' ) {
+ paste_xsel($str, $copy_selection);
+ } elsif ( $copy_method eq 'screen' ) {
+ paste_screen($str, $copy_selection);
+ } elsif ( $copy_method eq 'print' ) {
+ paste_print($str, $copy_selection);
+ } elsif ( $copy_method eq 'file' ) {
+ paste_file($str, $copy_selection);
+ }
+}
+
+sub paste_file {
+ my ($str, $par)= @_;
+ open my $fa, $copy_file_mode, $copy_file;
+ print $fa $str, $copy_file_eol;
+ close $fa;
+}
+
+sub paste_print {
+ my ($str, $par)= @_;
+ Irssi::print($str, MSGLEVEL_CLIENTCRAP);
+}
+
+sub paste_screen {
+ my ($str, $par)= @_;
+ my $fn= '/tmp/screen-exchange';
+ open my $fa, ">", $fn;
+ print $fa $str;
+ close $fa;
+}
+
+sub paste_xclip {
+ my ($str, $par)= @_;
+ my %ma= (
+ 0=>'buffer-cut',
+ p=>'primary',
+ q=>'secondary',
+ c=>'clipboard',
+ );
+ my $sel= $ma{substr($par,0,1)};
+ if (defined $sel) {
+ $sel= "-selection $sel";
+ }
+ my $cmd="xclip -i $sel";
+ open my $fa, "|-", $cmd;
+ print $fa $str;
+ close $fa;
+}
+
+sub paste_xsel {
+ my ($str, $par)= @_;
+ my %ma= (
+ p=>'--primary',
+ q=>'--secondary',
+ c=>'--clipboard',
+ );
+ my $sel= $ma{substr($par,0,1)};
+ my $cmd="xsel -i $sel";
+ open my $fa, "|-", $cmd;
+ print $fa $str;
+ close $fa;
+}
+
+sub paste_xterm {
+ my ($str,$par)=@_;
+ my $b64=encode_base64($str,'');
+ #print STDERR "\033]52;cpqs01234;".$b64."\007";
+ my $pstr="\033]52;".$par.";".$b64."\007";
+ if ($ENV{TERM} =~ m/^xterm/) {
+ print STDERR $pstr;
+ } elsif ($ENV{TERM} eq 'screen') {
+ # tmux
+ if (defined $ENV{TMUX}) {
+ my $tc = `tmux list-clients`;
+ $ENV{TMUX} =~ m/,(\d+)$/;
+ my $tcn =$1;
+ my $pty;
+ foreach (split /\n/,$tc) {
+ $_ =~ m/^(.*?): (\d+)/;
+ if ($tcn == $2) {
+ $pty = $1;
+ last();
+ }
+ }
+ my $fa;
+ open $fa,'>',$pty;
+ print $fa $pstr;
+ close $fa;
+ # screen
+ } elsif (defined $ENV{STY}) {
+ $ENV{STY} =~ m/\..*?-(\d+)\./;
+ my $pty = "/dev/pts/$1";
+ my $fa;
+ open $fa,'>',$pty;
+ print $fa $pstr;
+ close $fa;
+ }
+ }
+}
+
+sub cmd_help {
+ my ($args, $server, $witem)=@_;
+ $args=~ s/\s+//g;
+ if ($IRSSI{name} eq $args) {
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop();
+ }
+}
+
+sub sig_setup_changed {
+ my $cs= Irssi::settings_get_str($IRSSI{name}.'_selection');
+ if ($cs =~ m/^[cpqs0-7]*$/ ) {
+ $copy_selection=$cs;
+ } else {
+ $cs =~ s/[^cpqs0-7]//g;
+ $copy_selection=$cs;
+ Irssi::settings_set_str($IRSSI{name}.'_selection', $cs);
+ }
+ my $cm= Irssi::settings_get_str($IRSSI{name}.'_method');
+ my %md=(xterm=>1, xclip=>1, xsel=>1, screen=>1, print=>1, file=>1 );
+ if (exists $md{$cm} ) {
+ $copy_method= $cm;
+ } else {
+ $cm= $copy_method;
+ Irssi::settings_set_str($IRSSI{name}.'_method', $cm);
+ }
+ my $fn= Irssi::settings_get_str($IRSSI{name}.'_file');
+ $copy_file= bsd_glob($fn);
+ my $fm= Irssi::settings_get_str($IRSSI{name}.'_file_mode');
+ $copy_file_mode= $fm;
+ my $fe= Irssi::settings_get_str($IRSSI{name}.'_file_eol');
+ $fe =~ s/\\n/\n/g;
+ $fe =~ s/\\t/\t/g;
+ $copy_file_eol= $fe;
+}
+
+Irssi::signal_add('setup changed', \&sig_setup_changed);
+
+Irssi::settings_add_str($IRSSI{name} ,$IRSSI{name}.'_selection', '');
+Irssi::settings_add_str($IRSSI{name} ,$IRSSI{name}.'_method', 'xterm');
+Irssi::settings_add_str($IRSSI{name} ,$IRSSI{name}.'_file', '');
+Irssi::settings_add_str($IRSSI{name} ,$IRSSI{name}.'_file_mode', '>');
+Irssi::settings_add_str($IRSSI{name} ,$IRSSI{name}.'_file_eol', '\n');
+
+Irssi::command_bind($IRSSI{name}, \&cmd_copy);
+Irssi::command_bind('help', \&cmd_help);
+
+Irssi::command_set_options('copy','+f');
+
+sig_setup_changed();
diff --git a/scripts/countdown.pl b/scripts/countdown.pl
new file mode 100644
index 0000000..1a970e3
--- /dev/null
+++ b/scripts/countdown.pl
@@ -0,0 +1,59 @@
+# countdown.pl
+
+# adds public countdown command
+
+# ver 1.0
+# - initial release
+
+use Irssi;
+use strict;
+use Time::Local;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.0";
+%IRSSI = (
+ authors => 'Mikko \'Quidz\' Salmi',
+ name => 'countdown',
+ contact => 'mikko@quidz.net',
+ description => 'adds public channel command for counting down something',
+ license => 'Public Domain',
+ changed => 'Thu Aug 8 12:06:46 EET 2002'
+);
+
+Irssi::settings_add_str('misc','countdown_target','2003 01 01 00 00 00');
+Irssi::settings_add_str('misc','countdown_message','New year 2003:');
+Irssi::settings_add_str('misc','countdown_command','!countdown');
+Irssi::settings_add_str('misc','countdown_chan','#countdown');
+
+sub sig_public {
+ my ($server, $msg, $nick, $address, $target) = @_;
+ my $ctarget = Irssi::settings_get_str("countdown_target");
+ my $cinfo = Irssi::settings_get_str("countdown_message");
+ my $ccmd = Irssi::settings_get_str("countdown_command");
+ my $cchan = Irssi::settings_get_str("countdown_chan");
+ if ($msg eq $ccmd and lc($target) eq lc($cchan))
+ {
+ if ($ctarget =~ /^(\d+?) (\d+?) (\d+?) (\d+?) (\d+?) (\d+?)$/)
+ {
+ my $sec = timelocal($6,$5,$4,$3,$2-1,$1-1900);
+ $sec -= time;
+ my $min = ($sec/60)-(($sec%60)/60);
+ my $hour = ($min/60)-(($min%60)/60);
+ my $day = ($hour/24)-(($hour%24)/24);
+ $sec = ($sec%60);
+ $min = ($min%60);
+ $hour = ($hour%24);
+ if ($day) { $cinfo = $cinfo." $day d"; }
+ if ($hour) { $cinfo = $cinfo." $hour h"; }
+ if ($min) { $cinfo = $cinfo." $min m"; }
+ if ($sec) { $cinfo = $cinfo." $sec s"; }
+ $server->command("msg $target $cinfo");
+ } else
+ {
+ Irssi::print("Error: countdown.pl misc.countdown_target should be format <year> <month> <day> <hour> <minute> <second>");
+ }
+ }
+}
+
+Irssi::signal_add_last('message public', 'sig_public');
+Irssi::print("Script : countdown.pl loaded");
diff --git a/scripts/country.pl b/scripts/country.pl
new file mode 100644
index 0000000..c8e98c9
--- /dev/null
+++ b/scripts/country.pl
@@ -0,0 +1,325 @@
+# Print the country name in /WHOIS replies
+# /COUNTRY <code> prints the name for the country code
+# Installation: Add $whois_country somewhere in your /FORMAT whois line
+
+use strict;
+use Irssi 20021028;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.0.1";
+%IRSSI = (
+ authors => "Timo Sirainen",
+ contact => "tss\@iki.fi",
+ name => "country",
+ description => "Print the country name in /WHOIS replies",
+ license => "Public Domain",
+ changed => "Mon Oct 28 00:29:26 EET 2002"
+);
+
+my %countries;
+my $last_country = "";
+
+sub sig_whois {
+ my ($server, $data, $nick, $host) = @_;
+ my ($me, $nick, $user, $host) = split(" ", $data);
+
+ if ($host =~ /\.([a-zA-Z]+)$/) {
+ $last_country = $countries{lc $1};
+ } else {
+ $last_country = "";
+ }
+}
+
+sub expando_whois_country {
+ return $last_country;
+}
+
+sub cmd_country {
+ my $country = lc shift;
+ if ($country eq "") {
+ Irssi::print("USAGE: /COUNTRY <country code>");
+ return;
+ }
+
+ my $name = $countries{$country};
+ if (!$name) {
+ Irssi::print("Unknown country code: $country");
+ } else {
+ Irssi::print("$country is $name");
+ }
+}
+
+Irssi::command_bind('country', \&cmd_country);
+Irssi::signal_add_first('event 311', \&sig_whois);
+Irssi::expando_create('whois_country', \&expando_whois_country,
+ { 'event 311' => 'None' } );
+
+my $countryfile = '
+# list taken from http://www.iana.org/cctld/cctld-whois.htm
+# on 27-10-2002 by Lam
+ac Ascension Island
+ad Andorra
+ae United Arab Emirates
+af Afghanistan
+ag Antigua and Barbuda
+ai Anguilla
+al Albania
+am Armenia
+an Netherlands Antilles
+ao Angola
+aq Antarctica
+ar Argentina
+as American Samoa
+at Austria
+au Australia
+aw Aruba
+az Azerbaijan
+ba Bosnia and Herzegovina
+bb Barbados
+bd Bangladesh
+be Belgium
+bf Burkina Faso
+bg Bulgaria
+bh Bahrain
+bi Burundi
+bj Benin
+bm Bermuda
+bn Brunei Darussalam
+bo Bolivia
+br Brazil
+bs Bahamas
+bt Bhutan
+bv Bouvet Island
+bw Botswana
+by Belarus
+bz Belize
+ca Canada
+cc Cocos (Keeling) Islands
+cd Congo Democratic Republic of the
+cf Central African Republic
+cg Congo Republic of
+ch Switzerland
+ci Cote d\\\'Ivoire
+ck Cook Islands
+cl Chile
+cm Cameroon
+cn China
+co Colombia
+cr Costa Rica
+cu Cuba
+cv Cap Verde
+cx Christmas Island
+cy Cyprus
+cz Czech Republic
+de Germany
+dj Djibouti
+dk Denmark
+dm Dominica
+do Dominican Republic
+dz Algeria
+ec Ecuador
+ee Estonia
+eg Egypt
+eh Western Sahara
+er Eritrea
+es Spain
+et Ethiopia
+fi Finland
+fj Fiji
+fk Falkland Islands (Malvina)
+fm Micronesia Federal State of
+fo Faroe Islands
+fr France
+ga Gabon
+gd Grenada
+ge Georgia
+gf French Guiana
+gg Guernsey
+gh Ghana
+gi Gibraltar
+gl Greenland
+gm Gambia
+gn Guinea
+gp Guadeloupe
+gq Equatorial Guinea
+gr Greece
+gs South Georgia and the South Sandwich Islands
+gt Guatemala
+gu Guam
+gw Guinea-Bissau
+gy Guyana
+hk Hong Kong
+hm Heard and McDonald Islands
+hn Honduras
+hr Croatia/Hrvatska
+ht Haiti
+hu Hungary
+id Indonesia
+ie Ireland
+il Israel
+im Isle of Man
+in India
+io British Indian Ocean Territory
+iq Iraq
+ir Iran (Islamic Republic of)
+is Iceland
+it Italy
+je Jersey
+jm Jamaica
+jo Jordan
+jp Japan
+ke Kenya
+kg Kyrgyzstan
+kh Cambodia
+ki Kiribati
+km Comoros
+kn Saint Kitts and Nevis
+kp Korea Democratic People\\\'s Republic
+kr Korea Republic of
+kw Kuwait
+ky Cayman Islands
+kz Kazakhstan
+la Lao People\\\'s Democratic Republic
+lb Lebanon
+lc Saint Lucia
+li Liechtenstein
+lk Sri Lanka
+lr Liberia
+ls Lesotho
+lt Lithuania
+lu Luxembourg
+lv Latvia
+ly Libyan Arab Jamahiriya
+ma Morocco
+mc Monaco
+md Moldova Republic of
+mg Madagascar
+mh Marshall Islands
+mk Macedonia Former Yugoslav Republic
+ml Mali
+mm Myanmar
+mn Mongolia
+mo Macau
+mp Northern Mariana Islands
+mq Martinique
+mr Mauritania
+ms Montserrat
+mt Malta
+mu Mauritius
+mv Maldives
+mw Malawi
+mx Mexico
+my Malaysia
+mz Mozambique
+na Namibia
+nc New Caledonia
+ne Niger
+nf Norfolk Island
+ng Nigeria
+ni Nicaragua
+nl Netherlands
+no Norway
+np Nepal
+nr Nauru
+nu Niue
+nz New Zealand
+om Oman
+pa Panama
+pe Peru
+pf French Polynesia
+pg Papua New Guinea
+ph Philippines
+pk Pakistan
+pl Poland
+pm St. Pierre and Miquelon
+pn Pitcairn Island
+pr Puerto Rico
+ps Palestinian Territories
+pt Portugal
+pw Palau
+py Paraguay
+qa Qatar
+re Reunion Island
+ro Romania
+ru Russian Federation
+rw Rwanda
+sa Saudi Arabia
+sb Solomon Islands
+sc Seychelles
+sd Sudan
+se Sweden
+sg Singapore
+sh St. Helena
+si Slovenia
+sj Svalbard and Jan Mayen Islands
+sk Slovak Republic
+sl Sierra Leone
+sm San Marino
+sn Senegal
+so Somalia
+sr Suriname
+st Sao Tome and Principe
+sv El Salvador
+sy Syrian Arab Republic
+sz Swaziland
+tc Turks and Caicos Islands
+td Chad
+tf French Southern Territories
+tg Togo
+th Thailand
+tj Tajikistan
+tk Tokelau
+tm Turkmenistan
+tn Tunisia
+to Tonga
+tp East Timor
+tr Turkey
+tt Trinidad and Tobago
+tv Tuvalu
+tw Taiwan
+tz Tanzania
+ua Ukraine
+ug Uganda
+uk United Kingdom
+um US Minor Outlying Islands
+us United States
+uy Uruguay
+uz Uzbekistan
+va Holy See (City Vatican State)
+vc Saint Vincent and the Grenadines
+ve Venezuela
+vg Virgin Islands (British)
+vi Virgin Islands (USA)
+vn Vietnam
+vu Vanuatu
+wf Wallis and Futuna Islands
+ws Western Samoa
+ye Yemen
+yt Mayotte
+yu Yugoslavia
+za South Africa
+zm Zambia
+zw Zimbabwe
+# these are my own inventions
+com commercial
+net network
+org organisation
+edu educational
+mil military
+gov government
+aero air-transport
+biz business
+coop cooperative
+info informative
+museum museum
+name individual
+pro profession
+';
+
+foreach my $line (split(/\n/, $countryfile)) {
+ chomp $line;
+ next if ($line =~ /^#/ || $line eq "");
+
+ my ($code, $name) = split(/\t/, $line);
+ $countries{$code} = $name;
+}
diff --git a/scripts/cp1250_kick.pl b/scripts/cp1250_kick.pl
new file mode 100644
index 0000000..9ad231d
--- /dev/null
+++ b/scripts/cp1250_kick.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/perl -w
+#
+# cp1250-kick.pl - skrypt wyrzucaj±cy z kana³u osoby u¿ywaj±ce kodowania cp1250
+# - kicks people using cp1250 charset from channel
+#
+# /SET cp1250_kick_reason "tekst" - powód "kopniêcia"
+# /SET cp1250_kick_ops <ON|OFF> - czy "kopiemy" operatorów kana³u [OFF]
+# /SET cp1250_nokick "#chan_name nickname ..." - lista chronionych kana³ów
+# i/lub osób, dla których skrypt nie bêdzie dzia³a³
+#
+# Autor: Tomasz Poradowski (batonik@irc.pl)
+# Na podstawie: cp2iso.pl autorstwa Jakuba Jankowskiego <shasta@atn.pl>
+#
+# -----
+# 28.09.2002 kilka drobnych poprawek wprowadzonych przez Jakuba Jankowskiego
+# - cp1250_kick_ops ma teraz warto¶æ boolean (ON/OFF)
+# -----
+# 06.05.2002 ma³a poprawka w wyszukiwaniu "nicków" na li¶cie chronionych
+# -----
+
+use Irssi;
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.3";
+%IRSSI = (
+ authors => 'Tomasz Poradowski',
+ contact => 'batonik@irc.pl',
+ name => 'cp1250_kick',
+ description => 'Kicks people using cp1250 charset',
+ license => 'GPL',
+ changed => 'Sat Sep 28 12:58:26 CEST 2002'
+);
+
+sub cp1250_kick {
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $text) = split(/ :/, $data, 2);
+ my $kick_reason = Irssi::settings_get_str('cp1250_kick_reason');
+ my $nokick_list = Irssi::settings_get_str('cp1250_nokick');
+
+ return unless ($target =~ /^[#\!\+]/);
+ if ($text =~ /[\xA5\xB9\x8C\x9C\x8F\x9F]/) {
+ my $chan = Irssi::channel_find($target);
+ my $n = $chan->nick_find($nick);
+ return if ($nokick_list =~ m/\Q$chan->{name}\E|\Q$n->{nick}\E/);
+ return if ($n->{op} && !Irssi::settings_get_bool('cp1250_kick_ops'));
+ if ($chan->{chanop})
+ {
+ Irssi::print("Kopiemy $nick z $target! [cp1250 kick]");
+ $server->send_raw("KICK $target $nick :".$kick_reason);
+ }
+ else
+ {
+ Irssi::print("%R!%n [cp1250 kick] Nie jeste¶ operatorem kana³u $target.");
+ }
+ }
+}
+
+Irssi::settings_add_str('misc', 'cp1250_kick_reason', 'http://windows.online.pl wzywa Ciê! [cp1250 kick]');
+Irssi::settings_add_bool('misc', 'cp1250_kick_ops', 0);
+Irssi::settings_add_str('misc', 'cp1250_nokick', '');
+
+# musi siê wywo³aæ jeszcze przed cp2iso.pl (je¶li siê go u¿ywa)
+Irssi::signal_add_first('event privmsg', 'cp1250_kick');
diff --git a/scripts/crapbuster.pl b/scripts/crapbuster.pl
new file mode 100644
index 0000000..9c81002
--- /dev/null
+++ b/scripts/crapbuster.pl
@@ -0,0 +1,45 @@
+
+# By Stefan 'tommie' Tomanek
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "2022112701";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "CRAPbuster",
+ description => "Removes CRAP or CLIENTCRAP messages from your buffer",
+ license => "GPLv2",
+ changed => "$VERSION",
+ commands => "crapbuster"
+);
+
+# /scrollback levelclear -level crap,clientcrap
+
+use Irssi;
+use Irssi::TextUI;
+
+sub cmd_crapbuster ($$$) {
+ my ($args, $server, $witem) = @_;
+ my $limit = $args =~ /^\d+$/ ? $args : -1;
+ my $win = ref $witem ? $witem->window() : Irssi::active_win();
+ my $view = $win->view;
+ my $line = $view->get_lines;
+ $line = $line->next while defined $line->next;
+ while (defined $line->prev){
+ last if $limit == 0;
+ my $level = $line->{info}{level};
+ my $copy = $line;
+ $line = $line->prev;
+ foreach (split / /, Irssi::settings_get_str('crapbuster_levels')) {
+ next unless (($level & Irssi::level2bits($_)) != 0 );
+ $view->remove_line($copy);
+ last;
+ }
+ $limit-- if $limit;
+ }
+ $view->redraw();
+}
+
+Irssi::command_bind('crapbuster', \&cmd_crapbuster);
+Irssi::settings_add_str($IRSSI{name}, 'crapbuster_levels', 'CLIENTCRAP CRAP');
diff --git a/scripts/cron.pl b/scripts/cron.pl
new file mode 100644
index 0000000..0d1ac1e
--- /dev/null
+++ b/scripts/cron.pl
@@ -0,0 +1,306 @@
+#
+# Short help/usage:
+# /jobadd hour minute day_of_month month day_of_week command
+# Possibile switches for jobadd:
+# -disabled
+# -server <tag>
+# -<number>
+# /jobs [-v]
+# /jobdel [-finished] | job_number
+# /jobdisable job_number
+# /jobenable job_number
+# /jobssave
+# /jobsload
+#
+# Examples of usage:
+# /jobadd 17 45 * * * /echo This will be executed at 17:45
+# /jobadd -5 17 45 * * * /echo The same as above but only 5 times
+# /jobadd * 05 * * * /echo Execute this every hour 5 minutes after the hour
+# /jobadd */6 0 * * * /echo Execute at 0:0, 6:0, 12:0, 18:0
+# /jobadd * */30,45 * * * /echo Execute every hour at 00, 30, 45 minute
+# /jobadd * 1-15/5 * * * /echo at 1,6,11
+#
+# The servertag in -server usually is name from /ircnet, but
+# should work with servers not in any ircnet (hmm probably)
+#
+# The format was taken from crontab(5).
+# The only differences are:
+# 1) hour field is before minute field (why the hell minute is first in
+# crontab?). But this could be changed in final version.
+# 2) day of week is 0..6. 0 is Sunday, 1 is Monday, 6 is Saturday.
+# 7 is illegal value while in crontab it's the same as 0 (i.e. Sunday).
+# I might change this, depends on demand.
+# 3) you can't use names in month and day of week. You must use numbers
+# Type 'man 5 crontab' to know more about allowed values etc.
+#
+# TODO:
+# - add full (or almost full) cron functionality
+# - probably more efficient checking for job in timeout
+# - imput data validation
+# ? should we remember if the server was given with -server
+#
+# Changelog:
+# 0.12 (2014.11.12)
+# Automatically load jobs when loaded
+#
+# 0.11 (2004.12.12)
+# Job are executed exactly at the time (+- 1s), not up to 59s late
+#
+# 0.10 (2003.03.25):
+# Added -<number> to execute job only <number> times. Initial patch from
+# Marian Schubert (M dot Schubert at sh dot cvut dot cz)
+#
+# 0.9:
+# Bugfix: according to crontab(5) when both DoM and DoW are restricted
+# it's enough to only one of fields to match
+#
+# 0.8:
+# Added -disabled to /jobadd
+# Added jobs loading and saving to file
+#
+# 0.7:
+# Bugfixes. Should work now ;)
+#
+# 0.6:
+# Added month, day of month, day of week
+#
+# 0.5:
+# Initial testing release
+#
+
+use Irssi;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.12";
+%IRSSI = (
+ authors => 'Piotr Krukowiecki',
+ contact => 'piotr \at/ krukowiecki /dot\ net',
+ name => 'cron aka jobs',
+ description => 'cron implementation, allows to execute commands at given interval/time',
+ license => 'GNU GPLv2',
+ changed => '2004.12.12',
+ url => 'http://www.krukowiecki.net/code/irssi/'
+);
+
+my @jobs = ();
+my $seconds = (gmtime(time()))[0];
+my $timeout_tag;
+my $stop_timeout_tag;
+if ($seconds > 0) {
+ $stop_timeout_tag = Irssi::timeout_add((60-$seconds)*1000,
+ sub {
+ Irssi::timeout_remove($stop_timeout_tag);
+ $timeout_tag = Irssi::timeout_add(60000, 'sig_timeout', undef);
+ }, undef);
+} else {
+ $timeout_tag = Irssi::timeout_add(60000, 'sig_timeout', undef);
+}
+my $savefile = Irssi::get_irssi_dir() . "/cron.save";
+
+# First arg - current hour or minute.
+# Second arg - hour or minute specyfications.
+sub time_matches($$) {
+ my ($current, $spec) = @_;
+ foreach my $h (split(/,/, $spec)) {
+ if ($h =~ /(.*)\/(\d+)/) { # */number or number-number/number
+ my $step = $2;
+ if ($1 eq '*') { # */number
+ return 1 if ($current % $step == 0);
+ next;
+ }
+ if ($1 =~ /(\d+)-(\d+)/) { # number-number/number
+ my ($from, $to) = ($1, $2);
+ next if ($current < $from or $current > $to); # not in range
+ my $current = $current;
+ if ($from > 0) { # shift time
+ $to -= $from;
+ $current -= $from;
+ $from = 0;
+ }
+ return 1 if ($current % $step == 0);
+ next;
+ }
+ next;
+ }
+ if ($h =~ /(\d+)-(\d+)/) { # number-number
+ return 1 if ($current >= $1 and $current <= $2);
+ next
+ }
+ return 1 if ($h eq '*' or $h == $current); # '*' or exact hour
+ }
+ return 0;
+}
+
+sub sig_timeout {
+ my $ctime = time();
+ my ($cminute, $chour, $cdom, $cmonth, $cdow) = (localtime($ctime))[1,2,3,4,6];
+ $cmonth += 1;
+ foreach my $job (@jobs) {
+ next if ($job->{'disabled'});
+ next if ($job->{'repeats'} == 0);
+ next if (not time_matches($chour, $job->{'hour'}));
+ next if (not time_matches($cminute, $job->{'minute'}));
+ next if (not time_matches($cmonth, $job->{'month'}));
+ if ($job->{'dom'} ne '*' and $job->{'dow'} ne '*') {
+ next if (not (time_matches($cdom, $job->{'dom'}) or
+ time_matches($cdow, $job->{'dow'})));
+ } else {
+ next if (not time_matches($cdom, $job->{'dom'}));
+ next if (not time_matches($cdow, $job->{'dow'}));
+ }
+
+ my $server = Irssi::server_find_tag($job->{'server'});
+ if (!$server) {
+ Irssi::print("cron.pl: could not find server '$job->{server}'");
+ next;
+ }
+ $server->command($job->{'commands'});
+ if ($job->{'repeats'} > 0) {
+ $job->{'repeats'} -= 1;
+ }
+ }
+}
+
+sub cmd_jobs {
+ my ($data, $server, $channel) = @_;
+ my $verbose = ($data eq '-v');
+ Irssi::print("Current Jobs:");
+ foreach (0 .. $#jobs) {
+ my $repeats = $jobs[$_]{'repeats'};
+ my $msg = "$_) ";
+ if (!$verbose) {
+ next if ($repeats == 0);
+ $msg .= "-$repeats " if ($repeats != -1);
+ } else {
+ $msg .= "-$repeats " if ($repeats != -1);
+ }
+
+ $msg .= ($jobs[$_]{'disabled'}?"-disabled ":"")
+ ."-server $jobs[$_]{server} "
+ ."$jobs[$_]{hour} $jobs[$_]{minute} $jobs[$_]{dom} "
+ ."$jobs[$_]{month} $jobs[$_]{dow} "
+ ."$jobs[$_]{commands}";
+ Irssi::print($msg);
+ }
+ Irssi::print("End of List");
+}
+
+# /jobdel job_number
+sub cmd_jobdel {
+ my ($data, $server, $channel) = @_;
+ if ($data eq "-finished") {
+ foreach (reverse(0 .. $#jobs)) {
+ if ($jobs[$_]{'repeats'} == 0) {
+ splice(@jobs, $_, 1);
+ Irssi::print("Removed Job #$_");
+ }
+ }
+ return;
+ } elsif ($data !~ /\d+/ or $data < 0 or $data > $#jobs) {
+ Irssi::print("Bad Job Number");
+ return;
+ }
+ splice(@jobs, $data, 1);
+ Irssi::print("Removed Job #$data");
+}
+
+# /jobdisable job_number
+sub cmd_jobdisable {
+ my ($data, $server, $channel) = @_;
+ if ($data < 0 || $data > $#jobs) {
+ Irssi::print("Bad Job Number");
+ return;
+ }
+ $jobs[$data]{'disabled'} = 1;
+ Irssi::print("Disabled job number $data");
+}
+# /jobenable job_number
+sub cmd_jobenable {
+ my ($data, $server, $channel) = @_;
+ if ($data < 0 || $data > $#jobs) {
+ Irssi::print("Bad Job Number");
+ return;
+ }
+ $jobs[$data]{'disabled'} = 0;
+ Irssi::print("Enabled job number $data");
+}
+
+# /jobadd [-X] [-disabled] [-server servertag] hour minute day_of_month month day_of_week command
+sub cmd_jobadd {
+ my ($data, $server, $channel) = @_;
+
+ $server = $server->{tag};
+ my $disabled = 0;
+ my $repeats = -1;
+ while ($data =~ /^\s*-/) {
+ if ($data =~ s/^\s*-disabled\s+//) {
+ $disabled = 1;
+ next;
+ }
+ if ($data =~ s/^\s*-(\d+)\s+//) {
+ $repeats = $1;
+ next;
+ }
+ my $comm;
+ ($comm, $server, $data) = split(' ', $data, 3);
+ if ($comm ne '-server') {
+ Irssi::print("Bad switch: '$comm'");
+ return;
+ }
+ }
+ my ($hour, $minute, $dom, $month, $dow, $commands) = split(' ', $data, 6);
+
+ push (@jobs, { 'hour' => $hour, 'minute' => $minute, 'dom' => $dom,
+ 'month' => $month, 'dow' => $dow,
+ 'server' => $server, 'commands' => $commands,
+ 'disabled' => $disabled, 'repeats' => $repeats } );
+ Irssi::print("Job added");
+}
+
+sub cmd_jobssave {
+ if (not open (FILE, ">", $savefile)) {
+ Irssi::print("Could not open file '$savefile': $!");
+ return;
+ }
+ foreach (0 .. $#jobs) {
+ next if ($jobs[$_]->{'repeats'} == 0); # don't save finished jobs
+ print FILE
+ ($jobs[$_]->{'repeats'}>0 ? "-$jobs[$_]->{'repeats'} " : "")
+ . ($jobs[$_]{'disabled'}?"-disabled ":"")
+ ."-server $jobs[$_]{server} "
+ ."$jobs[$_]{hour} $jobs[$_]{minute} $jobs[$_]{dom} "
+ ."$jobs[$_]{month} $jobs[$_]{dow} "
+ ."$jobs[$_]{commands}\n";
+ }
+ close FILE;
+ Irssi::print("Jobs saved");
+}
+
+sub cmd_jobsload {
+ if (not open (FILE, q{<}, $savefile)) {
+ Irssi::print("Could not open file '$savefile': $!");
+ return;
+ }
+ @jobs = ();
+
+ while (<FILE>) {
+ chomp;
+ cmd_jobadd($_, undef, undef);
+ }
+
+ close FILE;
+ Irssi::print("Jobs loaded");
+}
+
+cmd_jobsload();
+
+Irssi::command_bind('jobs', 'cmd_jobs', 'Cron');
+Irssi::command_bind('jobadd', 'cmd_jobadd', 'Cron');
+Irssi::command_bind('jobdel', 'cmd_jobdel', 'Cron');
+Irssi::command_bind('jobdisable', 'cmd_jobdisable', 'Cron');
+Irssi::command_bind('jobenable', 'cmd_jobenable', 'Cron');
+Irssi::command_bind('jobssave', 'cmd_jobssave', 'Cron');
+Irssi::command_bind('jobsload', 'cmd_jobsload', 'Cron');
+
+# vim:noexpandtab:ts=4
diff --git a/scripts/ctrlact.pl b/scripts/ctrlact.pl
new file mode 100644
index 0000000..1a59bf6
--- /dev/null
+++ b/scripts/ctrlact.pl
@@ -0,0 +1,1087 @@
+# ctrlact.pl — Irssi script for fine-grained control of activity indication
+#
+# © 2017–2021 martin f. krafft <madduck@madduck.net>
+# Released under the MIT licence.
+#
+### Usage:
+#
+# /script load ctrlact
+#
+# If you like a busy activity statusbar, this script is not for you.
+#
+# If, on the other hand, you don't care about most activity, but you do want
+# the ability to define, per-item and per-window, what level of activity should
+# trigger a change in the statusbar, possibily depending on how long ago
+# you yourself were active on the channel, then ctrlact might be for you.
+#
+# For instance, you might never want to be disturbed by activity in any
+# channel, unless someone highlights you, or if you've said something yourself
+# in the channel in the past hour. You also want all activity
+# in queries (except on efnet), as well as an indication about any chatter in
+# your company channels. The following ctrlact map would do this for you:
+#
+# channel * /^#myco-/ messages
+# channel * * messages 3600
+# channel * * hilights
+# query efnet * messages
+# query * * all
+#
+# These five lines would be interpreted/read as:
+# "only messages or higher in a channel matching /^#myco-/ should trigger act"
+# "in all other channels where I've been active in the last 3600 seconds,
+# trigger on all messages"
+# "in all other channels, only hilights (or higher) should trigger act"
+# "queries on efnet should only trigger act for messages and higher"
+# "privmsgs of all levels should trigger act in queries elsewhere"
+#
+# The activity level in the fourth column is thus to be interpreted as
+# "the minimum level of activity that will trigger an indication"
+#
+# Loading this script per-se should not change anything, except it will create
+# ~/.irssi/ctrlact with some informational content, including the defaults and
+# some examples.
+#
+# The four activity levels are, and you can use either the words, or the
+# integers in the map.
+#
+# all (data_level: 1)
+# messages (data_level: 2)
+# hilights (data_level: 3)
+# none (data_level: 4)
+#
+# Note that the name is either matched in full and verbatim, or treated like
+# a regular expression, if it starts and ends with the same punctuation
+# character. You may also use the asterisk by itself to match everything, or
+# as part of a word, e.g. #debian-*. No other wildcards are supported.
+#
+# If you change the file, make sure to use /ctrlact reload or else it may get
+# overwritten.
+#
+# There's an interplay between window items and windows here, and you can
+# specify mininum activity levels for each. Here are the rules:
+#
+# 1. if the minimum activity level of a window item (channel or query) is not
+# reached, then the window is prevented from indicating activity.
+# 2. if traffic in a window item does reach minimum activity level, then the
+# minimum activity level of the window is considered, and activity is only
+# indicated if the window's minimum activity level is lower.
+#
+# In general, this means you'd have windows defaulting to 'all', but it might
+# come in handy to move window items to windows with min.levels of 'hilights'
+# or even 'none' in certain cases, to further limit activity indication for
+# them.
+#
+# You can use the Irssi settings activity_msg_level and activity_hilight_level
+# to specify which IRC levels will be considered messages and hilights. Note
+# that if an activity indication is inhibited, then there also won't be
+# a beep (cf. beep_msg_level), unless you toggle ctrlmap_inhibit_beep.
+#
+### Changelog:
+#
+# 2021-09-20 : v1.5
+# * Introduce snoop and sleep. Snooping means ctrlact will apply rules as if
+# you had just been active on the channel, and sleeping means that ctrlact
+# applies rules as if you hadn't been active recently.
+# * Also display the time remaining when an attention-span rule matches
+# * Sanity checks on the fallback settings
+# * Implement /ctrlact help
+# * Fix /ctrlact show with an empty ruleset
+#
+# 2021-09-11 : v1.4
+# * Let rules be defined and removed with /ctrlact add/remove
+# * Implement saving of map file
+# * Introduce the concept of attention span
+# * Wildcard matching on substrings
+# * Several code refactorings and improvements
+#
+# 2021-09-06 : v1.3
+# * Maintenance release, minor fixups
+#
+# 2017-02-24 : v1.2
+# * Fix invocation of '/ctrlact query' without a -tag (#354)
+#
+# 2017-02-15 : v1.1
+# * Configurable inhibition of beeps
+# * Re-read configuration properly
+# * Provide for matching on chatnet/server tag
+#
+# 2017-02-12 : v1.0
+# * Initial public release
+#
+### To-do:
+#
+# - figure out interplay with activity_hide_level
+# - use Irssi formats
+#
+use strict;
+use warnings;
+use utf8;
+use Carp qw( croak );
+use Irssi;
+use Text::ParseWords;
+use version;
+
+our %IRSSI = (
+ authors => 'martin f. krafft',
+ contact => 'madduck@madduck.net',
+ name => 'ctrlact',
+ description => 'allows per-channel control over activity indication',
+ license => 'MIT',
+ url => 'https://github.com/irssi/scripts.irssi.org/blob/master/scripts/ctrlact.pl',
+ version => '1.5',
+ changed => '2021-09-20'
+);
+
+our $VERSION = $IRSSI{version};
+my $_VERSION = version->parse($VERSION);
+
+### DEFAULTS AND SETTINGS ######################################################
+
+my @DATALEVEL_KEYWORDS = ('all', 'messages', 'hilights', 'none');
+
+my $debug = 0;
+my $map_file = Irssi::get_irssi_dir()."/ctrlact";
+my $fallback_channel_threshold = 1;
+my $fallback_query_threshold = 1;
+my $fallback_window_threshold = 1;
+my $inhibit_beep = 1;
+my $autosave = 1;
+
+Irssi::settings_add_str('ctrlact', 'ctrlact_map_file', $map_file);
+Irssi::settings_add_bool('ctrlact', 'ctrlact_debug', $debug);
+Irssi::settings_add_str('ctrlact', 'ctrlact_fallback_channel_threshold', $fallback_channel_threshold);
+Irssi::settings_add_str('ctrlact', 'ctrlact_fallback_query_threshold', $fallback_query_threshold);
+Irssi::settings_add_str('ctrlact', 'ctrlact_fallback_window_threshold', $fallback_window_threshold);
+Irssi::settings_add_bool('ctrlact', 'ctrlact_inhibit_beep', $inhibit_beep);
+Irssi::settings_add_bool('ctrlact', 'ctrlact_autosave', $autosave);
+
+sub init_threshold_setting {
+ my ($type, $ref) = @_;
+ my $setting = 'ctrlact_fallback_'.$type.'_threshold';
+ my $th = Irssi::settings_get_str($setting);
+ my $dl = get_data_level($th);
+ if ($dl) {
+ ${$ref} = $dl;
+ }
+ else {
+ Irssi::settings_set_str($setting, ${$ref});
+ }
+}
+
+sub sig_setup_changed {
+ $debug = Irssi::settings_get_bool('ctrlact_debug');
+ $map_file = Irssi::settings_get_str('ctrlact_map_file');
+
+ init_threshold_setting('channel', \$fallback_channel_threshold);
+ init_threshold_setting('query', \$fallback_query_threshold);
+ init_threshold_setting('window', \$fallback_window_threshold);
+
+ $inhibit_beep = Irssi::settings_get_bool('ctrlact_inhibit_beep');
+ $autosave = Irssi::settings_get_bool('ctrlact_autosave');
+}
+Irssi::signal_add('setup changed', \&sig_setup_changed);
+Irssi::signal_add('setup reread', \&sig_setup_changed);
+sig_setup_changed();
+
+my $changed_since_last_save = 0;
+
+my @window_thresholds;
+my @channel_thresholds;
+my @query_thresholds;
+my %THRESHOLDARRAYS = ('window' => \@window_thresholds,
+ 'channel' => \@channel_thresholds,
+ 'query' => \@query_thresholds
+ );
+
+my %OWN_ACTIVITY = ();
+
+### HELPERS ####################################################################
+
+use constant DEBUGEVENTFORMAT => "%7s %7.7s %-22.22s %d %s %d → %-7s (%-8s ↠%s)";
+sub say {
+ my ($msg, $level, $inwin) = @_;
+ $level = $level // MSGLEVEL_CLIENTCRAP;
+ if ($inwin) {
+ Irssi::active_win->print("ctrlact: $msg", $level);
+ }
+ else {
+ Irssi::print("ctrlact: $msg", $level);
+ }
+}
+
+sub debug {
+ return unless $debug;
+ my ($msg, $inwin) = @_;
+ $msg = $msg // "";
+ say("DEBUG: ".$msg, MSGLEVEL_CRAP + MSGLEVEL_NO_ACT, $inwin);
+}
+
+use Data::Dumper;
+sub dumper {
+ debug(scalar Dumper(@_), 1);
+}
+
+sub info {
+ my ($msg, $inwin) = @_;
+ say($msg, MSGLEVEL_CLIENTCRAP, $inwin);
+}
+
+sub warning {
+ my ($msg, $inwin) = @_;
+ $msg = $msg // "";
+ say("WARNING: ".$msg, MSGLEVEL_CLIENTERROR, $inwin);
+}
+
+sub error {
+ my ($msg, $inwin) = @_;
+ $msg = $msg // "";
+ say("ERROR: ".$msg, MSGLEVEL_CLIENTERROR, $inwin);
+}
+
+sub match {
+ my ($pat, $text) = @_;
+ if ($pat =~ m/^(\W)(.+)\1$/) {
+ return ($pat, $text) if $text =~ /$2/i;
+ }
+ elsif ($pat =~ m/\*/) {
+ my $rpat = $pat =~ s/\*/.*/gr;
+ return ($pat, $text) if $text =~ /$rpat/
+ }
+ else {
+ return ($pat, $text) if lc($text) eq lc($pat);
+ }
+ return ();
+}
+
+sub to_data_level {
+ my ($kw) = @_;
+ my $ret = 0;
+ for my $i (0 .. $#DATALEVEL_KEYWORDS) {
+ if ($kw eq $DATALEVEL_KEYWORDS[$i]) {
+ $ret = $i + 1;
+ }
+ }
+ return $ret
+}
+
+sub is_data_level {
+ my ($dl) = @_;
+ return $dl =~ /^[1-4]$/;
+}
+
+sub from_data_level {
+ my ($dl) = @_;
+ if (is_data_level($dl)) {
+ return $DATALEVEL_KEYWORDS[$dl-1];
+ }
+}
+
+sub get_data_level {
+ my ($data) = @_;
+ if (is_data_level($data)) {
+ return $data;
+ }
+ elsif((my $dl = to_data_level($data)) > 0) {
+ return $dl;
+ }
+ else {
+ error("Invalid data level: $data");
+ }
+}
+
+sub walk_match_array {
+ my ($name, $net, $type, $arr) = @_;
+ foreach my $rule (@{$arr}) {
+ my ($netpat, $net) = match($rule->[0], $net);
+ my ($namepat, $name) = match($rule->[1], $name);
+ next unless $netpat and $namepat;
+
+ my $own = $OWN_ACTIVITY{($net, $name)} // 0;
+ my $time = time();
+ my $span = ($rule->[3] eq '∞') ? 0 : $rule->[3];
+ my $remaining = $own + $span - $time;
+
+ if ($span > 0 and $remaining <= 0) {
+ delete $OWN_ACTIVITY{($net, $name)};
+ next;
+ }
+
+ my $result = to_data_level($rule->[2]);
+ my $tresult = from_data_level($result);
+ $name = '(unnamed)' unless length $name;
+ my $match = sprintf('%s = net:%s name:%s span:%s',
+ $rule->[4], $netpat, $namepat,
+ ($remaining < 0) ? $rule->[3] : $remaining.'s remain');
+ return ($result, $tresult, $match);
+ }
+ return -1;
+}
+
+sub get_mappings_table {
+ my ($arr, $fallback) = @_;
+ my @ret = ();
+ while (my ($i, $elem) = each @{$arr}) {
+ push @ret, sprintf("%7d: %-16s %-32s %-9s %-5s (%s)",
+ $i, @{$elem});
+ }
+ push @ret, sprintf("%7s: %-16s %-32s %-9s %-5s (%s)",
+ 'last', '*', '*', from_data_level($fallback), '∞', 'default');
+ return join("\n", @ret);
+}
+
+sub get_specific_threshold {
+ my ($type, $name, $net) = @_;
+ $type = lc($type);
+ if (exists $THRESHOLDARRAYS{$type}) {
+ return walk_match_array($name, $net, $type, $THRESHOLDARRAYS{$type});
+ }
+ else {
+ croak "ctrlact: can't look up threshold for type: $type";
+ }
+}
+
+sub get_item_threshold {
+ my ($type, $name, $net) = @_;
+ my ($ret, $tret, $match) = get_specific_threshold($type, $name, $net);
+ return ($ret, $tret, $match) if $ret > 0;
+ if ($type eq 'CHANNEL') {
+ return ($fallback_channel_threshold, from_data_level($fallback_channel_threshold), '[default]');
+ }
+ else {
+ return ($fallback_query_threshold, from_data_level($fallback_query_threshold), '[default]');
+ }
+}
+
+sub get_win_threshold {
+ my ($name, $net) = @_;
+ my ($ret, $tret, $match) = get_specific_threshold('window', $name, $net);
+ if ($ret > 0) {
+ return ($ret, $tret, $match);
+ }
+ else {
+ return ($fallback_window_threshold, from_data_level($fallback_window_threshold), '[default]');
+ }
+}
+
+sub set_threshold {
+ my ($arr, $chatnet, $name, $level, $pos, $span) = @_;
+
+ if ($level =~ /^[1-4]$/) {
+ $level = from_data_level($level);
+ }
+ elsif (!to_data_level($level)) {
+ error("Not a valid activity level: $level", 1);
+ return -1;
+ }
+
+ my $found = 0;
+ my $index = 0;
+ for (; $index < scalar @{$arr}; ++$index) {
+ my $item = $arr->[$index];
+ if ($item->[0] eq $chatnet and $item->[1] eq $name) {
+ $found = 1;
+ last;
+ }
+ }
+
+ if ($found) {
+ splice @{$arr}, $index, 1;
+ $pos = $index unless defined $pos;
+ }
+
+ splice @{$arr}, $pos // 0, 0, [$chatnet, $name, $level, $span, 'manual'];
+ $changed_since_last_save = 1;
+ return $found;
+}
+
+sub unset_threshold {
+ my ($arr, $chatnet, $name, $pos) = @_;
+ my $found = 0;
+ if (defined $pos) {
+ if ($pos > $#{$arr}) {
+ warning("There exists no rule \@$pos");
+ }
+ else {
+ splice @{$arr}, $pos, 1;
+ $found = 1;
+ }
+ }
+ else {
+ for (my $i = scalar @{$arr} - 1; $i >= 0; --$i) {
+ my $item = $arr->[$i];
+ if ($item->[0] eq $chatnet and $item->[1] eq $name) {
+ splice @{$arr}, $i, 1;
+ $found = 1;
+ }
+ }
+ if (!$found) {
+ warning("No matching rule found for deletion");
+ }
+ }
+ $changed_since_last_save = $found;
+ return $found;
+}
+
+sub print_levels_for_all {
+ my ($type, @arr) = @_;
+ info(uc("$type mappings:"));
+ for my $i (@arr) {
+ my $name = $i->{'name'};
+ my $net = $i->{'server'}->{'tag'} // '';
+ my ($c, $t, $tt, $match);
+ if ($type eq 'window') {
+ ($t, $tt, $match) = get_win_threshold($name, $net);
+ $c = $i->{'refnum'};
+ }
+ else {
+ ($t, $tt, $match) = get_item_threshold($type, $name, $net);
+ $c = $i->window()->{'refnum'};
+ }
+ info(sprintf("%4d: %-40.40s → %d (%-8s) match %s", $c, $name, $t, $tt, $match));
+ }
+}
+
+sub parse_args {
+ # type: -window -channel -query
+ # tag: -*
+ # span: +\d
+ # position: @\d
+ # anything else: item
+ my ($data) = @_;
+ my @args = shellwords($data);
+ my ($type, $tag, $pos, $span);
+ my @rest = ();
+ my $max = 0;
+
+ foreach my $arg (@args) {
+ if ($arg =~ m/^-(windows?|channels?|quer(?:ys?|ies))/) {
+ if ($type) {
+ error("Can't specify $arg after -$type", 1);
+ return 1;
+ }
+ my $m = $1;
+ $type = 'window' if $m =~ m/^w/;
+ $type = 'channel' if $m =~ m/^c/;
+ $type = 'query' if $m =~ m/^q/;
+ }
+ elsif ($arg =~ m/^-(\S+)/) {
+ if ($tag) {
+ error("Tag -$tag already specified, cannot accept $arg", 1);
+ return 1;
+ }
+ $tag = $1;
+ }
+ elsif ($arg =~ m/^@([0-9]+)/) {
+ if ($pos) {
+ error("Position $pos already given, cannot accept $arg", 1);
+ return 1;
+ }
+ $pos = $1;
+ }
+ elsif ($arg =~ m/^\+([0-9]+)/) {
+ if ($span) {
+ error("Span $span already given, cannot accept $arg", 1);
+ return 1;
+ }
+ $span = $1;
+ }
+ else {
+ push @rest, $arg;
+ $max = length $arg if length $arg > $max;
+ }
+ }
+
+ my %args = (
+ type => $type,
+ tag => $tag,
+ pos => $pos,
+ span => $span,
+ rest => \@rest,
+ max => $max
+ );
+ return \%args;
+}
+
+### HILIGHT SIGNAL HANDLERS ####################################################
+
+my $_inhibit_beep = 0;
+my $_inhibit_window = 0;
+
+sub maybe_inhibit_witem_hilight {
+ my ($witem, $oldlevel) = @_;
+ return unless $witem;
+ $oldlevel = 0 unless $oldlevel;
+ my $newlevel = $witem->{'data_level'};
+ return if ($newlevel <= $oldlevel);
+
+ $_inhibit_window = 0;
+ $_inhibit_beep = 0;
+ my $witype = $witem->{'type'};
+ my $winame = $witem->{'name'};
+ my $witag = $witem->{'server'}->{'tag'} // '';
+ my ($th, $tth, $match) = get_item_threshold($witype, $winame, $witag);
+ my $inhibit = $newlevel > 0 && $newlevel < $th;
+ debug(sprintf(DEBUGEVENTFORMAT, lc($witype), $witag, $winame, $newlevel,
+ $inhibit ? ('<',$th,'inhibit'):('≥',$th,'pass'),
+ $tth, $match));
+ if ($inhibit) {
+ Irssi::signal_stop();
+ # the rhval comes from config, so if the user doesn't want the
+ # bell inhibited, this is effectively a noop.
+ $_inhibit_beep = $inhibit_beep;
+ $_inhibit_window = $witem->window();
+ }
+}
+Irssi::signal_add_first('window item hilight', \&maybe_inhibit_witem_hilight);
+
+sub inhibit_win_hilight {
+ my ($win) = @_;
+ Irssi::signal_stop();
+ Irssi::signal_emit('window dehilight', $win);
+}
+
+sub maybe_inhibit_win_hilight {
+ my ($win, $oldlevel) = @_;
+ return unless $win;
+ if ($_inhibit_window && $win->{'refnum'} == $_inhibit_window->{'refnum'}) {
+ inhibit_win_hilight($win);
+ }
+ else {
+ $oldlevel = 0 unless $oldlevel;
+ my $newlevel = $win->{'data_level'};
+ return if ($newlevel <= $oldlevel);
+
+ my $wname = $win->{'name'};
+ my $wtag = $win->{'server'}->{'tag'} // '';
+ my ($th, $tth, $match) = get_win_threshold($wname, $wtag);
+ my $inhibit = $newlevel > 0 && $newlevel < $th;
+ debug(sprintf(DEBUGEVENTFORMAT, 'window', $wtag,
+ $wname?$wname:"$win->{'refnum'}(unnamed)", $newlevel,
+ $inhibit ? ('<',$th,'inhibit'):('≥',$th,'pass'),
+ $tth, $match));
+ inhibit_win_hilight($win) if $inhibit;
+ }
+}
+Irssi::signal_add_first('window hilight', \&maybe_inhibit_win_hilight);
+
+sub maybe_inhibit_beep {
+ Irssi::signal_stop() if $_inhibit_beep;
+}
+Irssi::signal_add_first('beep', \&maybe_inhibit_beep);
+
+###
+
+sub record_own_message {
+ my ($server, $msg, $target) = @_;
+ $OWN_ACTIVITY{($server->{chatnet}, $target)} = time();
+}
+for my $i ('public', 'private') {
+ Irssi::signal_add("message own_$i", \&record_own_message);
+}
+
+### SAVING AND LOADING #########################################################
+
+sub get_mappings_fh {
+ my ($filename) = @_;
+ my $fh;
+ if (! -e $filename) {
+ save_mappings($filename);
+ info("Created new/empty mappings file: $filename");
+ }
+ open($fh, '<', $filename) || croak "Cannot open mappings file: $!";
+ return $fh;
+}
+
+sub load_mappings {
+ my ($filename) = @_;
+ @window_thresholds = @channel_thresholds = @query_thresholds = ();
+ my $fh = get_mappings_fh($filename);
+ my $firstline = <$fh> || croak "Cannot read from $filename.";;
+ my $version;
+ if ($firstline =~ m/^#+\s+ctrlact mappings file \(version: *([\d.]+)\)/) {
+ $version = version->parse($1);
+ }
+ else {
+ croak "First line of $filename is not a ctrlact header.";
+ }
+
+ my $nrcols = 5;
+ if ($version <= version->parse('1.0')) {
+ $nrcols = 3;
+ }
+ elsif ($version <= version->parse('1.3')) {
+ $nrcols = 4;
+ }
+ my $l = 1;
+ my $cnt = 0;
+ while (<$fh>) {
+ $l++;
+ next if m/^\s*(?:#|$)/;
+ my ($type, @matchers) = split;
+ if (scalar @matchers >= $nrcols) {
+ error("Cannot parse $filename:$l: $_");
+ return;
+ }
+ @matchers = ['*', @matchers] if $version <= version->parse('1.0');
+
+ if (scalar @matchers == $nrcols - 2) {
+ push @matchers, '∞';
+ }
+
+ push @matchers, sprintf('line %2d', $l);
+
+ if (exists $THRESHOLDARRAYS{$type}) {
+ push @{$THRESHOLDARRAYS{$type}}, [@matchers];
+ $cnt += 1;
+ }
+ }
+ close($fh) || croak "Cannot close mappings file: $!";
+ return $cnt;
+}
+
+sub save_mappings {
+ my ($filename) = @_;
+ open(FH, '+>', $filename) || croak "Cannot create mappings file: $!";
+
+ my $ftw = from_data_level($fallback_window_threshold);
+ my $ftc = from_data_level($fallback_channel_threshold);
+ my $ftq = from_data_level($fallback_query_threshold);
+ print FH <<"EOF";
+# ctrlact mappings file (version: $_VERSION)
+#
+# WARNING: this file will be overwritten on /save,
+# use "/set ctrlact_autosave off" to avoid.
+#
+# type: window, channel, query
+# server: the server tag (chatnet)
+# name: full name to match, /regexp/, or * (for all)
+# min.level: none, messages, hilights, all, or 1,2,3,4
+# span: "attention span", how many seconds after your own
+# last message should this rule apply
+#
+# type server name min.level span
+
+EOF
+ foreach my $type (sort keys %THRESHOLDARRAYS) {
+ foreach my $arr (@{$THRESHOLDARRAYS{$type}}) {
+ print FH "$type\t";
+ print FH join "\t", @{$arr}[0..2];
+ print FH "\t" . @{$arr}[3] if @{$arr}[3] ne '∞';
+ print FH "\n";
+ }
+ }
+ print FH <<"EOF";
+
+# EXAMPLES
+#
+### only indicate activity in the status window if messages were displayed:
+# window * (status) messages
+#
+### never ever indicate activity for any item bound to this window:
+# window * oubliette none
+#
+### indicate activity on all messages in debian-related channels on OFTC:
+# channel oftc /^#debian/ messages
+#
+### display any text (incl. joins etc.) for the '#madduck' channel:
+# channel * #madduck all
+#
+### display messages in channels in which we were recently (3600s) active:
+# channel * * messages 3600
+#
+### otherwise ignore everything in channels, unless a hilight is triggered:
+# channel * * hilights
+#
+### make somebot only get your attention if they hilight you:
+# query efnet somebot hilights
+#
+### otherwise we want to see everything in queries:
+# query * * all
+
+# DEFAULTS:
+# window * * $ftw
+# channel * * $ftc
+# query * * $ftq
+
+# vim:noet:tw=0:ts=16
+EOF
+ close FH;
+}
+
+sub cmd_load {
+ my $cnt = load_mappings($map_file);
+ if (!$cnt) {
+ @window_thresholds = @channel_thresholds = @query_thresholds = ();
+ }
+ else {
+ info("Loaded $cnt mappings from $map_file");
+ $changed_since_last_save = 0;
+ }
+}
+
+sub cmd_save {
+ my ($args) = @_;
+ if (!$changed_since_last_save and $args ne '-force') {
+ info("Not saving unchanged mappings without -force");
+ return;
+ }
+ autosave(1);
+}
+
+### OTHER COMMANDS #############################################################
+
+sub cmd_add {
+ my ($data, $server, $witem) = @_;
+ my $args = parse_args($data);
+ my $type = $args->{type} // 'channel';
+ my $tag = $args->{tag} // '*';
+ my $pos = $args->{pos};
+ my $span = $args->{span} // '∞';
+ my ($name, $level);
+
+ for my $item (@{$args->{rest}}) {
+ if (!$name) {
+ $name = $item;
+ }
+ elsif (!$level) {
+ $level = $item;
+ }
+ else {
+ error("Unexpected argument: $item");
+ return;
+ }
+ }
+
+ if (!$name) {
+ error("Must specify at least a level");
+ return;
+ }
+ elsif (!length $level) {
+ if ($witem) {
+ $level = $name;
+ $name = $witem->{name};
+ $tag = $server->{chatnet} unless $tag;
+ }
+ else {
+ error("No name specified, and no active window item");
+ return;
+ }
+ }
+
+ my $res = set_threshold($THRESHOLDARRAYS{$type}, $tag, $name, $level, $pos, $span);
+ if ($res > 0) {
+ info("Existing rule replaced.");
+ }
+ elsif ($res == 0) {
+ info("Rule added.");
+ }
+}
+
+sub cmd_remove {
+ my ($data, $server, $witem) = @_;
+ my $args = parse_args($data);
+ my $type = $args->{type} // 'channel';
+ my $tag = $args->{tag} // '*';
+ my $pos = $args->{pos};
+ my $name;
+
+ for my $item (@{$args->{rest}}) {
+ if (!$name) {
+ $name = $item;
+ }
+ else {
+ error("Unexpected argument: $item");
+ return;
+ }
+ }
+ if (!defined $pos) {
+ if (!$name) {
+ if ($witem) {
+ $name = $witem->{name};
+ $tag = $server->{chatnet} unless $tag;
+ }
+ else {
+ error("No name specified, and no active window item");
+ return;
+ }
+ }
+ }
+
+ if (unset_threshold($THRESHOLDARRAYS{$type}, $tag, $name, $pos)) {
+ info("Rule removed.");
+ }
+}
+
+sub cmd_snoop {
+ my ($data, $server, $witem) = @_;
+ my $args = parse_args($data);
+ my $type = $args->{type} // 'channel';
+ my $tag = $args->{tag};
+ my $name;
+
+ for my $item (@{$args->{rest}}) {
+ if (!$name) {
+ $name = $item;
+ }
+ else {
+ error("Unexpected argument: $item");
+ return;
+ }
+ }
+
+ if (!$name) {
+ if ($witem) {
+ $name = $witem->{name};
+ $tag = $server->{chatnet} unless $tag;
+ }
+ else {
+ error("No name specified, and no active window item");
+ return;
+ }
+ }
+
+ $OWN_ACTIVITY{($tag, $name)} = time();
+ info("Snooping in on $tag/$name", 1);
+}
+
+sub cmd_sleep {
+ my ($data, $server, $witem) = @_;
+ my $args = parse_args($data);
+ my $type = $args->{type} // 'channel';
+ my $tag = $args->{tag};
+ my $name;
+
+ for my $item (@{$args->{rest}}) {
+ if (!$name) {
+ $name = $item;
+ }
+ else {
+ error("Unexpected argument: $item");
+ return;
+ }
+ }
+
+ if (!$name) {
+ if ($witem) {
+ $name = $witem->{name};
+ $tag = $server->{chatnet} unless $tag;
+ }
+ else {
+ error("No name specified, and no active window item");
+ return;
+ }
+ }
+
+ my $was = $OWN_ACTIVITY{($tag, $name)};
+ delete $OWN_ACTIVITY{($tag, $name)};
+ if ($was) {
+ $was = time() - $was;
+ info("Back to sleep on $tag/$name (after $was seconds)", 1);
+ }
+}
+
+sub cmd_list {
+ info("WINDOW MAPPINGS\n" . get_mappings_table(\@window_thresholds, $fallback_window_threshold));
+ info("CHANNEL MAPPINGS\n" . get_mappings_table(\@channel_thresholds, $fallback_channel_threshold));
+ info("QUERY MAPPINGS\n" . get_mappings_table(\@query_thresholds, $fallback_query_threshold));
+}
+
+sub cmd_query {
+ my ($data, $server, $witem) = @_;
+ my $args = parse_args($data);
+ my $type = $args->{type} // 'channel';
+ my $tag = $args->{tag} // '*';
+ my $max = $args->{max};
+ my @words = @{$args->{rest}};
+
+ if (!@words) {
+ if ($witem) {
+ push @words, $witem->{name};
+ $tag = $server->{chatnet} unless $tag ne '*';
+ }
+ else {
+ error("No name specified, and no active window item");
+ return;
+ }
+ }
+
+ foreach my $name (@words) {
+ my ($t, $tt, $match) = get_specific_threshold($type, $name, $tag);
+ info(sprintf("%7s: %7s %-22s → %-8s match: %s", $type, $tag, $name, $tt, $match), 1);
+ }
+}
+
+sub cmd_show {
+ my ($data, $server, $item) = @_;
+ my $args = parse_args($data);
+ my $type = $args->{type} // 'all';
+
+ if ($type eq 'channel' or $type eq 'all') {
+ print_levels_for_all('channel', Irssi::channels());
+ }
+ if ($type eq 'query' or $type eq 'all') {
+ print_levels_for_all('query', Irssi::queries());
+ }
+ if ($type eq 'window' or $type eq 'all') {
+ print_levels_for_all('window', Irssi::windows());
+ }
+}
+
+sub autosave {
+ my ($force) = @_;
+ return unless $force or $changed_since_last_save;
+ if (!$autosave) {
+ info("Not saving mappings due to ctrlact_autosave setting");
+ return;
+ }
+ info("Saving mappings to $map_file");
+ save_mappings($map_file);
+ $changed_since_last_save = 0;
+}
+
+sub UNLOAD {
+ autosave();
+}
+
+sub cmd_help {
+ my ($data, $server, $item) = @_;
+ Irssi::print (<<"SCRIPTHELP_EOF", MSGLEVEL_CLIENTCRAP);
+%_ctrlact $_VERSION - fine-grained control of activity indication%_
+
+%U%_Synopsis%_%U
+
+%_CTRLACT ADD%_ [<%Umatchspec%U>] [@<%Uposition%U>] [+<%Uspan%U>] <%Ulevel%U>
+%_CTRLACT REMOVE%_ [<%Umatchspec%U>] [@<%Uposition%U>]
+%_CTRLACT QUERY%_ [<%Umatchspec%U>]
+%_CTRLACT SNOOP%_ [<%Umatchspec%U>]
+%_CTRLACT SLEEP%_ [<%Umatchspec%U>]
+%_CTRLACT LIST%_
+%_CTRLACT SHOW%_ [<%Utype%U>]
+%_CTRLACT SAVE%_ [-force]
+%_CTRLACT [RE]LOAD%_
+%_CTRLACT HELP%_
+
+<%Umatchspec%U> %| [-<%Utype%U>] [-<%Utag%U>] <%Uname%U>
+%U%U %| (defaults to current window item, if available)
+<%Utype%U> %| "window"|"channel"|"query"
+%U%U %| (default: "channel")
+<%Utag%U> %| The chat network's tag, e.g. oftc
+<%Uname%U> %| Name of the channel, query, or window
+%U%U %| May include '*', or be a regular expression: /.../
+<%Ulevel%U> %| Minimum activity level to match:
+%U%U %| 1, all, 2, messages, 3, highlights, 4, none
+<%Uposition%U> %| Integer index where to insert new rule, or of rule to remove
+<%Uspan%U> %| Time in seconds during which this rule applies following own engagement
+
+%U%_Settings%_%U
+
+/set %_ctrlact_map_file%_ [$map_file]
+ %| Controls where the activity control map will be read from (and saved to)
+
+/set %_ctrlact_fallback_channel_threshold%_ [$fallback_channel_threshold]
+/set %_ctrlact_fallback_query_threshold%_ [$fallback_query_threshold]
+/set %_ctrlact_fallback_window_threshold%_ [$fallback_window_threshold]
+ %| Controls the lowest data level that will trigger activity for channels,
+ %| queries, and windows respectively, if no applicable mapping could be
+ %| found. Valid values are 1, all, 2, messages, 3, highlights, 4, none.
+
+/set %_ctrlact_inhibit_beep%_ [$inhibit_beep]
+ %| If an activity wouldn't be indicated, also inhibit the beep/bell. Turn
+ %| this off if you want the bell anyway.
+
+/set %_ctrlact_autosave%_ [$autosave]
+ %| Unless this is disabled, the rules will be written out to the map file
+ %| (and overwriting it) on /save and /ctrlact save.
+
+/set %_ctrlact_debug%_ [$debug]
+ %| Turns on debug output. Not that this may itself be buggy, so please don't
+ %| use it unless you really need it.
+
+%U%_Examples%_%U
+
+Set channel default level to hilights only:
+ %|%#/SET %_ctrlact_fallback_channel_threshold%_ hilights
+
+Show activity for messages in the #irssi channel on LiberaChat:
+ %|%#/%_CTRLACT ADD%_ -LiberaChat #irssi messages
+
+Show all activity for messages on my company's channels:
+ %|%#/%_CTRLACT ADD%_ -channel #myco-* all
+
+Create a rule for the current window item:
+ %|%#/%_CTRLACT ADD%_ all
+
+Insert a rule at position 3 (default is to insert at the top):
+ %|%#/%_CTRLACT ADD%_ @3 #mutt messages
+
+List all mappings:
+ %|%#/%_CTRLACT LIST%_
+
+Remove mapping at position 3:
+ %|%#/%_CTRLACT REMOVE%_ @3
+
+Remove mapping for current window item:
+ %|%#/%_CTRLACT REMOVE%_
+
+Remove mapping for #irssi channel (see above)
+ %|%#/%_CTRLACT REMOVE%_ -LiberaChat #irssi
+
+Save mappings to file ($map_file), using -force to write even if nothing has changed:
+ %|%#/%_CTRLACT SAVE%_ -force
+
+Load mappings from file ($map_file):
+ %|%#/%_CTRLACT LOAD%_
+
+Create a rule to show activity on any channel in which we've engaged in the last hour:
+ %|%#/%_CTRLACT ADD%_ +3600 -* * messages
+
+Pretend that we interacted with the #perl channel, so as to get activity as per the last rule:
+ %|%#/%_CTRLACT SNOOP%_ #perl
+
+Stop activity indication for the current channel after we engaged with it:
+ %|%#/%_CTRLACT SLEEP%_
+
+Query which rule would apply to the current channel:
+ %|%#/%_CTRLACT QUERY%_
+
+Show the matching rule for every query:
+ %|%#/%_CTRLACT SHOW%_ -query
+SCRIPTHELP_EOF
+}
+
+Irssi::signal_add('setup saved', \&autosave);
+Irssi::signal_add('setup reread', \&cmd_load);
+
+Irssi::command_bind('ctrlact help',\&cmd_help);
+Irssi::command_bind('ctrlact reload',\&cmd_load);
+Irssi::command_bind('ctrlact load',\&cmd_load);
+Irssi::command_bind('ctrlact save',\&cmd_save);
+Irssi::command_bind('ctrlact add',\&cmd_add);
+Irssi::command_bind('ctrlact remove',\&cmd_remove);
+Irssi::command_bind('ctrlact snoop',\&cmd_snoop);
+Irssi::command_bind('ctrlact sleep',\&cmd_sleep);
+Irssi::command_bind('ctrlact list',\&cmd_list);
+Irssi::command_bind('ctrlact query',\&cmd_query);
+Irssi::command_bind('ctrlact show',\&cmd_show);
+
+Irssi::command_bind('ctrlact' => sub {
+ my ($data, $server, $item) = @_;
+ $data =~ s/\s+$//g;
+ if ($data) {
+ Irssi::command_runsub('ctrlact', $data, $server, $item);
+ }
+ else {
+ cmd_help();
+ }
+ }
+);
+Irssi::command_bind('help', sub {
+ my ($data, $server, $item) = @_;
+ my @words = split /\s+/, $data;
+ return unless shift @words eq 'ctrlact';
+ cmd_help();
+ Irssi::signal_stop();
+ }
+);
+
+cmd_load();
diff --git a/scripts/cubes.pl b/scripts/cubes.pl
new file mode 100644
index 0000000..58d0c71
--- /dev/null
+++ b/scripts/cubes.pl
@@ -0,0 +1,55 @@
+use strict;
+use warnings;
+use Irssi 20140603;
+
+our $VERSION = '1.1';
+our %IRSSI = (
+ authors => 'Irssi staff',
+ contact => 'staff@irssi.org',
+ url => 'https://irssi.org',
+ name => 'cubes',
+ description => '256 colour test script for Irssi.',
+ license => 'Public Domain',
+);
+
+sub cubes {
+ my $t = $_[0];
+ my $w = Irssi::active_win;
+ my $C = MSGLEVEL_CLIENTCRAP;
+ my $N = MSGLEVEL_NEVER | $C;
+ my $T = $t ? "X" : "x";
+ my $M = $t ? "" : "99,";
+ my $P = sub {
+ $w->print(@_)
+ };
+ $P->("%_bases", $C);
+ $P->( do {
+ join '', map { "%${T}0${_}0$_" } '0' .. '9', 'A' .. 'F'
+ }, $N);
+ $P->("%_cubes", $C);
+ $P->( do {
+ my $y = $_*6;
+ join '', map {
+ my $x = $_;
+ map { "%${T}$x$_$x$_" } @{['0' .. '9', 'A' .. 'Z']}[$y .. $y+5]
+ } 1 .. 6
+ }, $N)
+ for 0 .. 5;
+ $P->("%_grays", $C);
+ $P->( do {
+ join '', map { "%${T}7${_}7$_" } 'A' .. 'X'
+ }, $N);
+ $P->("%_mIRC extended colours", $C);
+ my $x;
+ $x .= sprintf "\cC$M%02d%02d", $_, $_
+ for 0 .. 15;
+ $P->($x, $N);
+ for my $z (0 .. 6) {
+ my $x;
+ $x .= sprintf "\cC$M%02d%02d", $_, $_
+ for 16 + ($z * 12) .. 16 + ($z * 12) + 11;
+ $P->($x, $N);
+ }
+}
+Irssi::command_bind 'cubes' => sub { cubes(0); };
+Irssi::command_bind 'cubes_text' => sub { cubes(1); };
diff --git a/scripts/cwho.pl b/scripts/cwho.pl
new file mode 100644
index 0000000..8b527c4
--- /dev/null
+++ b/scripts/cwho.pl
@@ -0,0 +1,79 @@
+## Usage: /CWHO [-a | -l | -o | -v ] [ mask ]
+
+## ver 1.1
+# - added sorting
+# - few fixes
+
+use Irssi 20020300;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.1";
+%IRSSI = (
+ authors => "Maciek \'fahren\' Freudenheim",
+ contact => "fahren\@bochnia.pl",
+ name => "Cached WHO",
+ description => "Usage: /CWHO [-a | -l | -o | -v ] [ mask ]",
+ license => "GNU GPLv2 or later",
+ changed => "Mon May 6 14:02:25 CEST 2002"
+);
+
+Irssi::theme_register([
+ 'cwho_line', '%K[%W$[!-3]0%K][%C$1%B$[9]2%K][%B$[-10]3%P@%B$[34]4%K]%n'
+]);
+
+sub sort_mode {
+ if ($a->[0] eq $b->[0]) {
+ return 0;
+ } elsif ($a->[0] eq "@") {
+ return -1;
+ } elsif ($b->[0] eq "@") {
+ return 1;
+ } elsif ($a->[0] eq "v") {
+ return -1;
+ } elsif ($b->[0] eq "v") {
+ return 1
+ };
+}
+
+Irssi::command_bind 'cwho' => sub {
+ my ($pars, $server, $winit) = @_;
+ $pars =~ s/^\s+//;
+ my @data = split(/ +/, $pars);
+ my ($cmode, $cmask, $i) = ('.', "*!*@*", 0);
+
+ unless ($winit && $winit->{type} eq "CHANNEL") {
+ Irssi::print("You don't have active channel in that window");
+ return;
+ }
+
+ my $channel = $winit->{name};
+
+ while ($_ = shift(@data)) {
+ /^-a$/ and $cmode = '.', next;
+ /^-l$/ and $cmode = 'X', next;
+ /^-o$/ and $cmode = '@', next;
+ /^-v$/ and $cmode = 'v', next;
+ /[!@.]+/ and $cmask = $_, next;
+ }
+
+ my @sorted = ();
+ for my $hash ($winit->nicks()) {
+ my $mode = $hash->{op}? "@" : $hash->{voice}? "v" : " ";
+
+ if ($cmode eq "X") {
+ next if $mode ne " ";
+ } elsif ($mode !~ /$cmode/) {next}
+
+ next unless $server->mask_match_address($cmask, $hash->{nick}, $hash->{host});
+
+ my ($user, $host) = split(/@/, $hash->{host});
+ push @sorted, [ $mode, $hash->{nick}, $user, $host ];
+ }
+
+ @sorted = sort { sort_mode || lc $a->[1] cmp lc $b->[1] } @sorted;
+
+ $server->printformat($channel, MSGLEVEL_CLIENTCRAP, 'cwho_line', ++$i, @$_) for (@sorted);
+
+ Irssi::print("No matches for \'$cmask\'.") unless $i;
+}
diff --git a/scripts/dancer_forwardfix.pl b/scripts/dancer_forwardfix.pl
new file mode 100644
index 0000000..25df81d
--- /dev/null
+++ b/scripts/dancer_forwardfix.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/perl -w
+
+## Bugreports and Licence disclaimer.
+#
+# For bugreports and other improvements contact Geert Hauwaerts <geert@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+##
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.03";
+
+%IRSSI = (
+ authors => 'Geert Hauwaerts',
+ contact => 'geert@irssi.org',
+ name => 'dancer_forwardfix.pl',
+ description => 'This script will fix the Irssi problem with channel forwarding on the Dancer ircd.',
+ license => 'Public Domain',
+ url => 'http://irssi.hauwaerts.be/dancer_forwardfix.pl',
+ changed => 'Sun May 9 01:19:25 2004',
+);
+
+Irssi::theme_register([
+ 'fwfix_loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.',
+ 'fwfix_reason', '%R>>%n %_Forwardfix:%_ $0 forwarded to $1'
+]);
+
+sub fix_379 {
+
+ my ($server, $data) = @_;
+ my ($nick, $mainchan, $fwdchan, $reason) = split(/ /, $data);
+
+ if ($server && ($server->{'version'} =~ /dancer/)) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fwfix_reason', $mainchan, $fwdchan);
+ Irssi::timeout_add_once(1000, sub { $server->command("PART $mainchan"); }, undef);
+ Irssi::signal_stop;
+ }
+}
+
+Irssi::signal_add('event 379', 'fix_379');
+
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fwfix_loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
diff --git a/scripts/dancer_hide_477.pl b/scripts/dancer_hide_477.pl
new file mode 100644
index 0000000..abf2256
--- /dev/null
+++ b/scripts/dancer_hide_477.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl -w
+
+## Bugreports and Licence disclaimer.
+#
+# For bugreports and other improvements contact Geert Hauwaerts <geert@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+##
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.01";
+
+%IRSSI = (
+ authors => 'Geert Hauwaerts',
+ contact => 'geert@irssi.org',
+ name => 'dancer_hide_477.pl',
+ description => 'This script hides the 477 numerics from the dancer IRCd.',
+ license => 'GNU General Public License',
+ url => 'http://irssi.hauwaerts.be/dancer_hide_477.pl',
+ changed => 'Fri Mar 12 19:46:24 2004',
+);
+
+Irssi::theme_register([
+ 'dancer_hide_477_loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.'
+]);
+
+sub hide_477 {
+
+ my ($server, $data) = @_;
+ my ($num, $nick, $auth_nick) = split(/ +/, $_[1], 3);
+
+ if ($server && ($server->{'version'} =~ /dancer/)) {
+ Irssi::signal_stop();
+ }
+}
+
+Irssi::signal_add('event 477', 'hide_477');
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'dancer_hide_477_loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
diff --git a/scripts/dau.pl b/scripts/dau.pl
new file mode 100644
index 0000000..ac8c051
--- /dev/null
+++ b/scripts/dau.pl
@@ -0,0 +1,5750 @@
+################################################################################
+# $Id: dau.pl 273 2008-02-03 15:27:25Z heidinger $
+################################################################################
+#
+# dau.pl - write like an idiot
+#
+################################################################################
+# Author
+################################################################################
+#
+# Clemens Heidinger <heidinger@dau.pl>
+#
+################################################################################
+# Changelog
+################################################################################
+#
+# dau.pl has a built-in changelog (--changelog switch)
+#
+################################################################################
+# Credits
+################################################################################
+#
+# - Robert Hennig: For the original dau shell script. Out of this script,
+# merged with some other small Perl and shell scripts and aliases arised the
+# first version of dau.pl for irssi.
+#
+################################################################################
+# Documentation
+################################################################################
+#
+# dau.pl has a built-in documentation (--help switch)
+#
+################################################################################
+# License
+################################################################################
+#
+# Licensed under the BSD license
+#
+################################################################################
+# Website
+################################################################################
+#
+# http://dau.pl/
+#
+# Additional information, DAU.pm, the dauomat and the dauproxy
+#
+################################################################################
+
+use 5.6.0;
+use File::Basename;
+use File::Path;
+use IPC::Open3;
+use Irssi 20021107.0841;
+use Irssi::TextUI;
+use locale;
+use POSIX;
+use re 'eval';
+use strict;
+use Tie::File;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '2.4.3';
+#$VERSION = '2.4.3 SVN ($LastChangedRevision: 273 $)';
+%IRSSI = (
+ authors => 'Clemens Heidinger',
+ changed => '$LastChangedDate: 2008-02-03 16:27:25 +0100 (Sun, 03 Feb 2008) $',
+ commands => 'dau',
+ contact => 'heidinger@dau.pl',
+ description => 'write like an idiot',
+ license => 'BSD',
+ modules => 'File::Basename File::Path IPC::Open3 POSIX Tie::File',
+ name => 'DAU',
+ sbitems => 'daumode',
+ url => 'http://dau.pl/',
+);
+
+################################################################################
+# Register commands
+################################################################################
+
+Irssi::command_bind('dau', \&command_dau);
+
+################################################################################
+# Register settings
+# setting changed/added => change/add it here
+################################################################################
+
+# boolean
+Irssi::settings_add_bool('misc', 'dau_away_quote_reason', 1);
+Irssi::settings_add_bool('misc', 'dau_away_reminder', 0);
+Irssi::settings_add_bool('misc', 'dau_babble_verbose', 1);
+Irssi::settings_add_bool('misc', 'dau_color_choose_colors_randomly', 1);
+Irssi::settings_add_bool('misc', 'dau_cowsay_print_cow', 0);
+Irssi::settings_add_bool('misc', 'dau_figlet_print_font', 0);
+Irssi::settings_add_bool('misc', 'dau_silence', 0);
+Irssi::settings_add_bool('misc', 'dau_statusbar_daumode_hide_when_off', 0);
+Irssi::settings_add_bool('misc', 'dau_tab_completion', 1);
+
+# Integer
+Irssi::settings_add_int('misc', 'dau_babble_history_size', 10);
+Irssi::settings_add_int('misc', 'dau_babble_verbose_minimum_lines', 2);
+Irssi::settings_add_int('misc', 'dau_cool_maximum_line', 2);
+Irssi::settings_add_int('misc', 'dau_cool_probability_eol', 20);
+Irssi::settings_add_int('misc', 'dau_cool_probability_word', 20);
+Irssi::settings_add_int('misc', 'dau_remote_babble_interval_accuracy', 90);
+
+# String
+Irssi::settings_add_str('misc', 'dau_away_away_text', '$N is away now: [ $reason ]. Away since: $Z. I am currently not available at $T @ $chatnet (sry 4 amsg)!');
+Irssi::settings_add_str('misc', 'dau_away_back_text', '$N is back: [ $reason ]. Away time: [ $time ]. I am available again at $T @ $chatnet (sry 4 amsg)!');
+Irssi::settings_add_str('misc', 'dau_away_options',
+ "--parse_special --bracket -left '!---?[' -right ']?---!' --color -split capitals -random off -codes 'light red; yellow'," .
+ "--parse_special --bracket -left '--==||{{' -right '}}||==--' --color -split capitals -random off -codes 'light red; light cyan'," .
+ "--parse_special --bracket -left '--==||[[' -right ']]||==--' --color -split capitals -random off -codes 'yellow; light green'"
+);
+Irssi::settings_add_str('misc', 'dau_away_reminder_interval', '1 hour');
+Irssi::settings_add_str('misc', 'dau_away_reminder_text', '$N is still away: [ $reason ]. Away time: [ $time ] (sry 4 amsg)');
+Irssi::settings_add_str('misc', 'dau_babble_options_line_by_line', '--nothing');
+Irssi::settings_add_str('misc', 'dau_babble_options_preprocessing', '');
+Irssi::settings_add_str('misc', 'dau_color_codes', 'blue; green; red; magenta; yellow; cyan');
+Irssi::settings_add_str('misc', 'dau_cool_eol_style', 'random');
+Irssi::settings_add_str('misc', 'dau_cowsay_cowlist', '');
+Irssi::settings_add_str('misc', 'dau_cowsay_cowpath', &def_dau_cowsay_cowpath);
+Irssi::settings_add_str('misc', 'dau_cowsay_cowpolicy', 'allow');
+Irssi::settings_add_str('misc', 'dau_cowsay_cowsay_path', &def_dau_cowsay_cowsay_path);
+Irssi::settings_add_str('misc', 'dau_cowsay_cowthink_path', &def_dau_cowsay_cowthink_path);
+Irssi::settings_add_str('misc', 'dau_daumode_channels', '');
+Irssi::settings_add_str('misc', 'dau_delimiter_string', ' ');
+Irssi::settings_add_str('misc', 'dau_figlet_fontlist', 'mnemonic,term,ivrit');
+Irssi::settings_add_str('misc', 'dau_figlet_fontpath', &def_dau_figlet_fontpath);
+Irssi::settings_add_str('misc', 'dau_figlet_fontpolicy', 'allow');
+Irssi::settings_add_str('misc', 'dau_figlet_path', &def_dau_figlet_path);
+Irssi::settings_add_str('misc', 'dau_files_away', '.away');
+Irssi::settings_add_str('misc', 'dau_files_babble_messages', 'babble_messages');
+Irssi::settings_add_str('misc', 'dau_files_cool_suffixes', 'cool_suffixes');
+Irssi::settings_add_str('misc', 'dau_files_root_directory', "$ENV{HOME}/.dau");
+Irssi::settings_add_str('misc', 'dau_files_substitute', 'substitute.pl');
+Irssi::settings_add_str('misc', 'dau_language', 'en');
+Irssi::settings_add_str('misc', 'dau_moron_eol_style', 'random');
+Irssi::settings_add_str('misc', 'dau_parse_special_list_delimiter', ' ');
+Irssi::settings_add_str('misc', 'dau_random_options',
+ '--substitute --boxes --uppercase,' .
+ "--substitute --color -split capitals -random off -codes 'light red; yellow'," .
+ "--substitute --color -split capitals -random off -codes 'light red; light cyan'," .
+ "--substitute --color -split capitals -random off -codes 'yellow; light green'," .
+ '--substitute --color --uppercase,' .
+ '--substitute --cool,' .
+ '--substitute --delimiter,' .
+ '--substitute --dots --moron,' .
+ '--substitute --leet,' .
+ '--substitute --mix,' .
+ '--substitute --mixedcase --bracket,' .
+ '--substitute --moron --stutter --uppercase,' .
+ '--substitute --moron -omega on,' .
+ '--substitute --moron,' .
+ '--substitute --uppercase --underline,' .
+ '--substitute --words --mixedcase'
+);
+Irssi::settings_add_str('misc', 'dau_remote_babble_channellist', '');
+Irssi::settings_add_str('misc', 'dau_remote_babble_channelpolicy', 'deny');
+Irssi::settings_add_str('misc', 'dau_remote_babble_interval', '1 hour');
+Irssi::settings_add_str('misc', 'dau_remote_channellist', '');
+Irssi::settings_add_str('misc', 'dau_remote_channelpolicy', 'deny');
+Irssi::settings_add_str('misc', 'dau_remote_deop_reply', 'you are on my shitlist now @ $nick');
+Irssi::settings_add_str('misc', 'dau_remote_devoice_reply', 'you are on my shitlist now @ $nick');
+Irssi::settings_add_str('misc', 'dau_remote_op_reply', 'thx 4 op @ $nick');
+Irssi::settings_add_str('misc', 'dau_remote_permissions', '000000');
+Irssi::settings_add_str('misc', 'dau_remote_question_regexp', '%%%DISABLED%%%');
+Irssi::settings_add_str('misc', 'dau_remote_question_reply', 'EDIT_THIS_ONE');
+Irssi::settings_add_str('misc', 'dau_remote_voice_reply', 'thx 4 voice @ $nick');
+Irssi::settings_add_str('misc', 'dau_standard_messages', 'hi @ all');
+Irssi::settings_add_str('misc', 'dau_standard_options', '--random');
+Irssi::settings_add_str('misc', 'dau_words_range', '1-4');
+
+################################################################################
+# Register signals
+# (Note that most signals are set dynamical in the subroutine signal_handling)
+################################################################################
+
+Irssi::signal_add_last('setup changed', \&signal_setup_changed);
+Irssi::signal_add_last('window changed' => sub { Irssi::statusbar_items_redraw('daumode') });
+Irssi::signal_add_last('window item changed' => sub { Irssi::statusbar_items_redraw('daumode') });
+
+################################################################################
+# Register statusbar items
+################################################################################
+
+Irssi::statusbar_item_register('daumode', '', 'statusbar_daumode');
+
+################################################################################
+# Global variables
+################################################################################
+
+# Timer used by --away
+
+our %away_timer;
+
+# babble
+
+our %babble;
+
+# --command -in
+
+our $command_in;
+
+# The command to use for the output (MSG f.e.)
+
+our $command_out;
+
+# '--command -out' used?
+
+our $command_out_activated;
+
+# Counter for the subroutines entered
+
+our $counter_subroutines;
+
+# Counter for the switches
+# --me --moron: --me would be 0, --moron 1
+
+our $counter_switches;
+
+# daumode
+
+our %daumode;
+
+# daumode activated?
+
+our $daumode_activated;
+
+# Help text
+
+our %help;
+$help{options} = <<END;
+%9--away%9
+ Toggle away mode
+
+ %9-channels%9 %U'#channel1/network1, #channel2/network2, ...'%U:
+ Say away message in all those %Uchannels%U
+
+ %9-interval%9 %Utime%U:
+ Remind channel now and then that you're away
+
+ %9-reminder%9 %Uon|off%U:
+ Turn reminder on or off
+
+%9--babble%9
+ Babble a message.
+
+ %9-at%9 %Unicks%U:
+ Comma separated list of nicks to babble at.
+ \$nick1, \$nick2 and so forth of the babble line will be replaced
+ by those nicks.
+
+ %9-cancel%9 %Uon|off%U:
+ Cancel active babble
+
+ %9-filter%9 %Uregular expression%U:
+ Only let through if the babble matches the %Uregular expression%U
+
+ %9-history_size%9 %Un%U:
+ Set the size of the history for this one babble to %Un%U
+
+%9--boxes%9
+ Put words in boxes
+
+%9--bracket%9
+ Bracket the text
+
+ %9-left%9 %Ustring%U:
+ Left bracket
+
+ %9-right%9 %Ustring%U:
+ Right bracket
+
+%9--changelog%9
+ Print the changelog
+
+%9--chars%9
+ Only one character each line
+
+%9--color%9
+ Write in colors
+
+ %9-codes%9 %Ucodes%U:
+ Overrides setting dau_color_codes
+
+ %9-random%9 %Uon|off%U:
+ Choose color randomly from setting dau_color_codes resp.
+ %9--color -codes%9 or take one by one in the exact order given.
+
+ %9-split%9
+ %Ucapitals%U: Split by capitals
+ %Uchars%U: Every character another color
+ %Ulines%U: Every line another color
+ %Uparagraph%U: The whole paragraph in one color
+ %Urchars%U: Some characters one color
+ %Uwords%U: Every word another color
+
+%9--command%9
+ %9-in%9 %Ucommand%U:
+ Feed dau.pl with the output (the public message)
+ that %Ucommand%U produces
+
+ %9-out%9 %Ucommand%U:
+ %Utopic%U for example will set a dauified topic
+
+%9--cool%9
+ Be \$cool[tm]!!!!11one
+
+ %9-eol_style%9 %Ustring%U:
+ Override setting dau_cool_eol_style
+
+ %9-max%9 %Un%U:
+ \$Trademarke[tm] only %Un%U words per line tops
+
+ %9-prob_eol%9 %U0-100%U:
+ Probability that "!!!11one" or something like that will be put at EOL.
+ Set it to 100 and every line will be.
+ Set it to 0 and no line will be.
+
+ %9-prob_word%9 %U0-100%U:
+ Probability that a word will be \$trademarked[tm].
+ Set it to 100 and every word will be.
+ Set it to 0 and no word will be.
+
+%9--cowsay%9
+ Use cowsay to write
+
+ %9-arguments%9 %Uarguments%U:
+ Pass any option to cowsay, f.e. %U'-b'%U or %U'-e XX'%U.
+ Look in the cowsay manualpage for details.
+
+ %9-cow%9 %Ucow%U:
+ The cow to use
+
+ %9-think%9 %Uon|off%U:
+ Thinking instead of speaking
+
+%9--create_files%9
+ Create files and directories of all dau_files_* settings
+
+%9--daumode%9
+ Toggle daumode.
+ Works on a per channel basis!
+
+ %9-modes_in%9 %Umodes%U:
+ All incoming messages will be dauified and the
+ specified modes are used by dau.pl.
+
+ %9-modes_out%9 %Umodes%U:
+ All outgoing messages will be dauified and the
+ specified modes are used by dau.pl.
+
+ %9-perm%9 %U[01][01]%U:
+ Dauify incoming/outgoing messages?
+
+%9--delimiter%9
+ Insert a delimiter-string after each character
+
+ %9-string%9 %Ustring%U:
+ Override setting dau_delimiter_string. If this string
+ contains whitespace, you should quote the string with
+ single quotes.
+
+%9--dots%9
+ Put dots... after words...
+
+%9--figlet%9
+ Use figlet to write
+
+ %9-font%9 %Ufont%U:
+ The font to use
+
+%9--help%9
+ Print help
+
+ %9-setting%9 %Usetting%U:
+ More information about a specific setting
+
+%9--leet%9
+ Write in leet speech
+
+%9--long_help%9
+ Long help, i.e. examples, more about some features, ...
+
+%9--me%9
+ Send a CTCP ACTION instead of a PRIVMSG
+
+%9--mix%9
+ Mix all the characters in a word except for the first and last
+
+%9--mixedcase%9
+ Write in mixed case
+
+%9--moron%9
+ Write in uppercase, mix in some typos, perform some
+ substitutions on the text, ... Just write like a
+ moron
+
+ %9-eol_style%9 %Ustring%U:
+ Override setting dau_moron_eol_style
+
+ %9-level%9 %Un%U:
+ %Un%U gives the level of stupidity applied to text,
+ the higher the stupider.
+ %U0%U is the minimum, %U1%U currently only implemented for dau_language = de.
+
+ %9-omega%9 %Uon|off%U:
+ The fantastic omega mode
+
+ %9-typo%9 %Uon|off%U:
+ Mix in random typos
+
+ %9-uppercase%9 %Uon|off%U:
+ Uppercase text
+
+%9--nothing%9
+ Do nothing
+
+%9--parse_special%9
+ Parse for special metasequences and substitute them.
+
+ %9-irssi_variables%9 %Uon|off%U:
+ Parse irssi special variables like \$N
+
+ %9-list_delimiter%9 %Ustring%U:
+ Set the list delimiter used for \@nicks and \@opnicks to %Ustring%U.
+
+ The special metasequences are:
+
+ - \\n:
+ real newline
+ - \$nick1 .. \$nickN:
+ N different randomly selected nicks
+ - \@nicks:
+ All nicks in channel
+ - \$opnick1 .. \$opnickN:
+ N different randomly selected opnicks
+ - \@opnicks:
+ All nicks in channel with operator status
+ - \$?{ code }:
+ the (perl)code will be evaluated and the last expression
+ returned will replace that metasequence
+ - irssis special variables like \$C for the current
+ channel and \$N for your current nick
+
+ Quoting:
+
+ - \\\$: literal \$
+ - \\\\: literal \\
+
+%9--random%9
+ Let dau.pl choose the options randomly. Get these options from the setting
+ dau_random_options.
+
+ %9-verbose%9 %Uon|off%U:
+ Print what options --random has chosen
+
+%9--reverse%9
+ Reverse the input string
+
+%9--stutter%9
+ Stutter a bit
+
+%9--substitute%9
+ Apply own substitutions from file
+
+%9--underline%9
+ Underline text
+
+%9--uppercase%9
+ Write in upper case
+
+%9--words%9
+ Only a few words each line
+END
+
+# Containing irssi's 'cmdchars'
+
+our $k = Irssi::parse_special('$k');
+
+# Remember your nick mode
+
+our %nick_mode;
+
+# All the options
+
+our %option;
+
+# print() the message or not?
+
+our $print_message;
+
+# Queue holding the switches
+
+our %queue;
+
+# Remember the last switches used by --random so that they don't repeat
+
+our $random_last;
+
+# Signals
+
+our %signal = (
+ 'complete word' => 0,
+ 'daumode in' => 0,
+ 'event 404' => 0,
+ 'event privmsg' => 0,
+ 'nick mode changed' => 0,
+ 'send text' => 0,
+);
+
+# All switches that may be given at commandline
+
+our %switches = (
+
+ # These switches may be combined
+
+ combo => {
+ boxes => { 'sub' => \&switch_boxes },
+ bracket => {
+ 'sub' => \&switch_bracket,
+ left => { '*' => 1 },
+ right => { '*' => 1 },
+ },
+ chars => { 'sub' => \&switch_chars },
+ color => {
+ 'sub' => \&switch_color,
+ codes => { '*' => 1 },
+ random => {
+ off => 1,
+ on => 1,
+ },
+ 'split' => {
+ capitals => 1,
+ chars => 1,
+ lines => 1,
+ paragraph => 1,
+ rchars => 1,
+ words => 1,
+ },
+ },
+ command => {
+ 'sub' => \&switch_command,
+ in => { '*' => 1 },
+ out => { '*' => 1 },
+ },
+ cool => {
+ 'sub' => \&switch_cool,
+ eol_style => {
+ suffixes => 1,
+ exclamation_marks => 1,
+ random => 1,
+ },
+ max => { '*' => 1 },
+ prob_eol => { '*' => 1 },
+ prob_word => { '*' => 1 },
+ },
+ cowsay => {
+ 'sub' => \&switch_cowsay,
+ arguments => { '*' => 1 },
+ think => {
+ off => 1,
+ on => 1,
+ },
+ },
+ delimiter => {
+ 'sub' => \&switch_delimiter,
+ string => { '*' => 1 },
+ },
+ dots => { 'sub' => \&switch_dots },
+ figlet => { 'sub' => \&switch_figlet },
+ me => { 'sub' => \&switch_me },
+ mix => { 'sub' => \&switch_mix },
+ moron => {
+ 'sub' => \&switch_moron,
+ eol_style => {
+ nothing => 1,
+ random => 1,
+ },
+ level => { '*' => 1 },
+ omega => {
+ off => 1,
+ on => 1,
+ },
+ typo => {
+ off => 1,
+ on => 1,
+ },
+ uppercase => {
+ off => 1,
+ on => 1,
+ },
+ },
+ leet => { 'sub' => \&switch_leet },
+ mixedcase => { 'sub' => \&switch_mixedcase },
+ nothing => { 'sub' => \&switch_nothing },
+ parse_special => {
+ 'sub' => \&switch_parse_special,
+ irssi_variables => {
+ off => 1,
+ on => 1,
+ },
+ list_delimiter => { '*' => 1 },
+ },
+ 'reverse' => { 'sub' => \&switch_reverse },
+ stutter => { 'sub' => \&switch_stutter },
+ substitute => { 'sub' => \&switch_substitute },
+ underline => { 'sub' => \&switch_underline },
+ uppercase => { 'sub' => \&switch_uppercase },
+ words => { 'sub' => \&switch_words },
+ },
+
+ # The following switches must not be combined
+
+ nocombo => {
+ away => {
+ 'sub' => \&switch_away,
+ channels => { '*' => 1 },
+ interval => { '*' => 1 },
+ reminder => {
+ on => 1,
+ off => 1,
+ },
+ },
+ babble => {
+ 'sub' => \&switch_babble,
+ at => { '*' => 1 },
+ cancel => {
+ on => 1,
+ off => 1,
+ },
+ filter => { '*' => 1 },
+ history_size => { '*' => 1 },
+ },
+ changelog => { 'sub' => \&switch_changelog },
+ create_files => { 'sub' => \&switch_create_files },
+ daumode => {
+ 'sub' => \&switch_daumode,
+ modes_in => { '*' => 1 },
+ modes_out => { '*' => 1 },
+ perm => {
+ '00' => 1,
+ '01' => 1,
+ '10' => 1,
+ '11' => 1,
+ },
+ },
+ help => {
+ 'sub' => \&switch_help,
+
+ # setting changed/added => change/add it here
+
+ setting => {
+ # boolean
+ dau_away_quote_reason => 1,
+ dau_away_reminder => 1,
+ dau_babble_verbose => 1,
+ dau_color_choose_colors_randomly => 1,
+ dau_cowsay_print_cow => 1,
+ dau_figlet_print_font => 1,
+ dau_silence => 1,
+ dau_statusbar_daumode_hide_when_off => 1,
+ dau_tab_completion => 1,
+
+ # Integer
+ dau_babble_history_size => 1,
+ dau_babble_verbose_minimum_lines => 1,
+ dau_cool_maximum_line => 1,
+ dau_cool_probability_eol => 1,
+ dau_cool_probability_word => 1,
+ dau_remote_babble_interval_accuracy => 1,
+
+ # String
+ dau_away_away_text => 1,
+ dau_away_back_text => 1,
+ dau_away_options => 1,
+ dau_away_reminder_interval => 1,
+ dau_away_reminder_text => 1,
+ dau_babble_options_line_by_line => 1,
+ dau_babble_options_preprocessing => 1,
+ dau_color_codes => 1,
+ dau_cool_eol_style => 1,
+ dau_cowsay_cowlist => 1,
+ dau_cowsay_cowpath => 1,
+ dau_cowsay_cowpolicy => 1,
+ dau_cowsay_cowsay_path => 1,
+ dau_cowsay_cowthink_path => 1,
+ dau_daumode_channels => 1,
+ dau_delimiter_string => 1,
+ dau_figlet_fontlist => 1,
+ dau_figlet_fontpath => 1,
+ dau_figlet_fontpolicy => 1,
+ dau_figlet_path => 1,
+ dau_files_away => 1,
+ dau_files_babble_messages => 1,
+ dau_files_cool_suffixes => 1,
+ dau_files_root_directory => 1,
+ dau_files_substitute => 1,
+ dau_language => 1,
+ dau_moron_eol_style => 1,
+ dau_parse_special_list_delimiter => 1,
+ dau_random_options => 1,
+ dau_remote_babble_channellist => 1,
+ dau_remote_babble_channelpolicy => 1,
+ dau_remote_babble_interval => 1,
+ dau_remote_channellist => 1,
+ dau_remote_channelpolicy => 1,
+ dau_remote_deop_reply => 1,
+ dau_remote_devoice_reply => 1,
+ dau_remote_op_reply => 1,
+ dau_remote_permissions => 1,
+ dau_remote_question_regexp => 1,
+ dau_remote_question_reply => 1,
+ dau_remote_voice_reply => 1,
+ dau_standard_messages => 1,
+ dau_standard_options => 1,
+ dau_words_range => 1,
+ },
+ },
+ long_help => { 'sub' => \&switch_long_help },
+ random => { 'sub' => \&switch_random,
+ verbose => {
+ off => 1,
+ on => 1,
+ },
+ },
+ },
+);
+
+################################################################################
+# Code run once at start
+################################################################################
+
+print CLIENTCRAP "dau.pl $VERSION loaded. For help type %9${k}dau --help%9 or %9${k}dau --long_help%9";
+
+signal_setup_changed();
+build_nick_mode_struct();
+signal_handling();
+
+################################################################################
+# Subroutines (commands)
+################################################################################
+
+sub command_dau {
+ my ($data, $server, $witem) = @_;
+ my $output;
+
+ $output = parse_text($data, $witem);
+
+ unless (defined($server) && $server && $server->{connected}) {
+ $print_message = 1;
+ }
+ unless ((defined($witem) && $witem &&
+ ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')))
+ {
+ $print_message = 1;
+ }
+
+ if ($daumode_activated) {
+
+ if (defined($witem) && $witem &&
+ ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY'))
+ {
+ my $modes_set = 0;
+
+ # daumode set with parameters (modes_in)
+
+ if ($queue{0}{daumode}{modes_in}) {
+ $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 1;
+ $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} =
+ $queue{0}{daumode}{modes_in};
+ $modes_set = 1;
+ }
+
+ # daumode set with parameters (modes_out)
+
+ if ($queue{0}{daumode}{modes_out}) {
+ $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 1;
+ $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} =
+ $queue{0}{daumode}{modes_out};
+ $modes_set = 1;
+ }
+
+ # daumode set without parameters
+
+ if (!$daumode{channels_in}{$server->{tag}}{$witem->{name}} &&
+ !$daumode{channels_out}{$server->{tag}}{$witem->{name}} &&
+ !$modes_set)
+ {
+ $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 1;
+ $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 1;
+ $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = '';
+ $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = '';
+ }
+
+ # daumode unset
+
+ elsif (($daumode{channels_in}{$server->{tag}}{$witem->{name}} ||
+ $daumode{channels_out}{$server->{tag}}{$witem->{name}}) &&
+ !$modes_set)
+ {
+ $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 0;
+ $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 0;
+ $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = '';
+ $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = '';
+ }
+
+
+ # the perm-option overrides everything
+
+ # perm: 00
+
+ if ($queue{0}{daumode}{perm} eq '00') {
+ $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 0;
+ $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 0;
+ $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = '';
+ $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = '';
+ }
+
+ # perm: 01
+
+ if ($queue{0}{daumode}{perm} eq '01') {
+ $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 0;
+ $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 1;
+ $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = '';
+ }
+
+ # perm: 10
+
+ if ($queue{0}{daumode}{perm} eq '10') {
+ $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 1;
+ $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 0;
+ $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = '';
+ }
+
+ # perm: 11
+
+ if ($queue{0}{daumode}{perm} eq '11') {
+ $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 1;
+ $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 1;
+ }
+
+ Irssi::statusbar_items_redraw('daumode');
+ }
+
+ # Signal handling (for daumode and signal 'send text')
+
+ signal_handling();
+
+ return;
+ }
+
+ # MSG (or CTCP ACTION) $output to active channel/query-window
+
+ {
+ no strict 'refs';
+
+ $output = $output || '';
+ output_text($witem, $witem->{name}, $output);
+ }
+}
+
+################################################################################
+# Subroutines (switches, must not be combined)
+################################################################################
+
+sub switch_away {
+ my ($reason, $channel_rec, $reminder, $interval) = @_;
+ my $output;
+ my $time;
+ my $status = 'away';
+
+ ################################################################################
+ ################################################################################
+ # Get and handle options
+ ################################################################################
+ ################################################################################
+
+ ################################################################################
+ # "/dau --away -interval <interval>" resp. dau_away_reminder_interval setting
+ ################################################################################
+
+ # If called from command line, i.e. not by the
+ # "/dau --away -channels '<channels>'" workaround, $interval will be defined
+ # here
+ if (!defined($interval)) {
+ $interval = time_parse(return_option('away', 'interval', $option{dau_away_reminder_interval}));
+ }
+ if ($interval < 10 || $interval > 1000000000) {
+ print_err('Invalid value for away timer!');
+ return;
+ }
+
+ ################################################################################
+ # setting dau_away_options
+ ################################################################################
+
+ my $options = return_random_list_item($option{dau_away_options});
+
+ ################################################################################
+ # "/dau --away -reminder <on|off>" resp. dau_away_reminder setting
+ ################################################################################
+
+ # If called from command line, i.e. not by "/dau --away -channels '<channels>'"
+ # workaround, $reminder will be defined here
+ if (!defined($reminder)) {
+ $reminder = return_option('away', 'reminder', $option{dau_away_reminder});
+ }
+
+ # on -> 1, off -> 0
+ if ($reminder eq 'on' || $reminder == 1) {
+ $reminder = 1;
+ } else {
+ $reminder = 0;
+ }
+
+ ################################################################################
+ # "/dau --away -channels '<channels>'"
+ ################################################################################
+
+ # Go through all channels and for each call this subroutine again with
+ # $reminder and $interval as additional parameter as those otherwise would be
+ # lost. Sad world.
+
+ my $channels = return_option('away', 'channels');
+ # If not deleted, the program may loop here.
+ undef($queue{0}{away}{channels});
+ while ($channels =~ m{([^/]+)/([^,]+),?\s*}g) {
+ my $channel = $1;
+ my $network = $2;
+
+ my $server_rec = Irssi::server_find_tag($network);
+ my $channel_rec = $server_rec->channel_find($channel);
+
+ if (defined($channel_rec) && $channel_rec &&
+ ($channel_rec->{type} eq 'CHANNEL' || $channel_rec->{type} eq 'QUERY'))
+ {
+ switch_away($reason, $channel_rec, $reminder, $interval);
+ }
+
+ }
+ # "/dau --away -channels '<channels>'" first run => exit
+ return if ($channels);
+
+ ################################################################################
+ # Now we are clear (from -channels)...
+ ################################################################################
+
+ # Normal "/dau --away" (i.e. no -channels), but called from non
+ # channel/query window => exit
+ unless (defined($channel_rec) && $channel_rec &&
+ ($channel_rec->{type} eq 'CHANNEL' || $channel_rec->{type} eq 'QUERY'))
+ {
+ return;
+ }
+
+ my $channel = $channel_rec->{name};
+ my $network = $channel_rec->{server}->{tag};
+ my $id = "$channel/$network";
+
+ ################################################################################
+ # Open file
+ ################################################################################
+
+ my $file = "$option{dau_files_root_directory}/$option{dau_files_away}";
+ my @file;
+ unless (tie(@file, 'Tie::File', $file)) {
+ print_err("Cannot tie $file!");
+ return;
+ }
+
+ ################################################################################
+ # Go through/edit file
+ ################################################################################
+
+ # Format:
+ # channel | network | time | options | reminder | interval | reason
+ my $i = 0;
+ foreach my $line (@file) {
+ if ($line =~ m{^\Q$channel\E\x02\Q$network\E\x02(\d+)\x02([^\x02]*)\x02(?:\d)\x02(?:\d+)\x02(.*)}) {
+ $time = $1;
+ $options = $2;
+ $reason = $3;
+ $status = 'back';
+ last;
+ }
+ $i++;
+ }
+
+ if ($status eq 'away' && $reason eq '') {
+ print_out('Please set reason for your being away!');
+ return;
+ }
+
+ if ($status eq 'away') {
+ push(@file, "$channel\x02$network\x02" . time . "\x02$options\x02$reminder\x02$interval\x02$reason");
+ $output = $option{dau_away_away_text};
+ }
+
+ if ($status eq 'back') {
+ splice(@file, $i, 1);
+ $output = $option{dau_away_back_text};
+ }
+
+ ################################################################################
+ # Special variables
+ ################################################################################
+
+ # $time
+
+ if ($status eq 'back') {
+ my $difference = time_diff_verbose(time, $time);
+ $output =~ s/\$time/$difference/g;
+ }
+
+ # $reason
+
+ if ($option{dau_away_quote_reason}) {
+ $reason =~ s/\\/\\\\/g;
+ $reason =~ s/\$/\\\$/g;
+ }
+ $output =~ s/\$reason/$reason/g;
+
+ ################################################################################
+ # Write changes back to file
+ ################################################################################
+
+ untie(@file);
+
+ ################################################################################
+ # The reminder timer
+ ################################################################################
+
+ if ($status eq 'away' && $reminder) {
+ $away_timer{$id} = Irssi::timeout_add($interval, \&timer_away_reminder, $id);
+ } else {
+ Irssi::timeout_remove($away_timer{$id});
+ }
+
+ ################################################################################
+ # Print message to channel
+ ################################################################################
+
+ $output = parse_text("$options $output", $channel_rec);
+ output_text($channel_rec, $channel_rec->{name}, $output);
+
+ return;
+}
+
+sub switch_babble {
+ my ($data, $channel) = @_;
+ my $text;
+
+ # Cancel babble?
+
+ if (lc(return_option('babble', 'cancel')) eq 'on') {
+ if (defined($babble{timer_writing})) {
+ Irssi::timeout_remove($babble{timer_writing});
+ undef($babble{timer_writing});
+
+ if ($babble{remote}) {
+ timer_remote_babble_reset();
+ }
+
+ print_out("Babble cancelled.");
+ }
+ return;
+ }
+
+ # Filters
+
+ my @filter = ();
+ my $option_babble_at = return_option('babble', 'at');
+ my $option_babble_filter = return_option('babble', 'filter');
+ my $option_babble_history_size = return_option('babble', 'history_size', $option{dau_babble_history_size});
+
+ if ($option_babble_filter) {
+ push(@filter, $option_babble_filter);
+ }
+
+ # If something is babbling right now, exit
+
+ if (defined($babble{timer_writing})) {
+ print_err("You are already babbling something!");
+ return;
+ }
+
+ # get text from file
+
+ if ($option_babble_at) {
+ my @nicks;
+ foreach my $nick (split(/\s*,\s*/, $option_babble_at)) {
+ push(@nicks, $nick);
+ }
+ if (@nicks > 0) {
+ for (my $i = 1; $i <= $#nicks + 1; $i++) {
+ push(@filter, '\$nick' . $i);
+ }
+ }
+
+ $text = &babble_get_text($channel, \@filter, \@nicks, $option_babble_history_size);
+ } else {
+ $text = &babble_get_text($channel, \@filter, undef, $option_babble_history_size);
+ }
+
+ # babble only in channels
+
+ unless (defined($channel) && $channel && $channel->{type} eq 'CHANNEL') {
+ print_out('%9--babble%9 will only work in channel windows!');
+ return;
+ }
+
+ # Start the babbling
+
+ babble_start($channel, $text, 0);
+
+ return;
+}
+
+sub switch_changelog {
+ my $output;
+ $print_message = 1;
+
+ $output = &fix(<<" END");
+ CHANGELOG
+
+ 2002-05-05 release 0.1.0
+ initial release
+
+ 2002-05-06 release 0.1.1
+ maintenance release
+
+ 2002-05-11 release 0.2.0
+ new feature: %9--delimiter%9
+
+ 2002-05-12 release 0.3.0
+ new feature: %9--mixedcase%9
+
+ 2002-05-17 release 0.4.0
+ %9--delimiter%9 revised
+
+ 2002-05-20 release 0.4.1
+ some nice new substitutions for %9--moron%9
+
+ 2002-05-24 release 0.5.0
+ new settings for %9--figlet%9
+
+ 2002-06-15 release 0.6.0
+ new settings for %9--figlet%9
+
+ 2002-06-16 release 0.6.1
+ maintenance release
+
+ 2002-06-16 release 0.6.2
+ maintenance release
+
+ 2002-06-17 release 0.7.0
+ new stuff for %9--moron%9
+
+ 2002-06-19 release 0.8.0
+ new feature: %9--dots%9
+
+ 2002-06-23 release 0.9.0
+ new "reply to question" remote feature
+
+ 2002-06-23 release 0.9.1
+ maintenance release
+
+ 2002-06-29 release 0.9.2
+ maintenance release
+
+ 2002-07-23 release 0.9.3
+ maintenance release
+
+ 2002-07-28 release 1.0.0
+ - Tabcompletion for the switches
+ - new feature: %9--changelog%9
+ - new feature: %9--help%9
+ - new feature: %9--leet%9
+ - new feature: %9--reverse%9
+
+ 2002-07-28 release 1.0.1
+ maintenance release
+
+ 2002-09-01 release 1.0.2
+ maintenance release
+
+ 2002-09-03 release 1.0.3
+ new switch for %9--figlet%9: %9-font%9
+
+ 2002-09-03 release 1.0.4
+ maintenance release
+
+ 2002-09-03 release 1.0.5
+ maintenance release
+
+ 2002-09-09 release 1.1.0
+ You can combine switches now!
+
+ 2002-11-22 release 1.2.0
+ - new setting: %9dau_moron_eol_style%9
+ - new setting: %9dau_standard_messages%9
+ - new setting: %9dau_standard_options%9
+ - new remote features: Say something on (de)op/(de)voice
+ - new switch for %9--delimiter%9: %9-string%9
+ - new switch for %9--moron%9: %9-eol_style%9
+ - new feature: %9--color%9
+ - new feature: %9--daumode%9
+ - new feature: %9--random%9
+ - new feature: %9--stutter%9
+ - new feature: %9--uppercase%9
+ - new statusbar item: %9daumode%9
+
+ 2002-11-27 release 1.2.1
+ maintenance release
+
+ 2002-12-15 release 1.2.2
+ maintenance release
+
+ 2003-01-12 release 1.3.0
+ - new setting: %9dau_files_root_directory%9
+ - %9--moron%9: randomly transpose letters with letters
+ next to them at the keyboard
+ - new switch for %9--moron%9: %9-uppercase%9
+ - new feature: %9--create_files%9
+
+ 2003-01-17 release 1.4.0
+ - %9--color%9 revised
+ - new remote feature: babble
+
+ 2003-01-18 release 1.4.1
+ maintenance release
+
+ 2003-01-20 release 1.4.2
+ new setting: %9dau_statusbar_daumode_hide_when_off%9
+
+ 2003-02-01 release 1.4.3
+ maintenance release
+
+ 2003-02-09 release 1.4.4
+ maintenance release
+
+ 2003-02-16 release 1.4.5
+ maintenance release
+
+ 2003-03-16 release 1.4.6
+ maintenance release
+
+ 2003-05-01 release 1.5.0
+ - new setting: %9dau_tab_completion%9
+ - new feature: %9--bracket%9
+
+ 2003-06-13 release 1.5.1
+ new feature: %9--underline%9
+
+ 2003-07-16 release 1.5.2
+ new feature: %9--boxes%9
+
+ 2003-08-16 release 1.5.3
+ maintenance release
+
+ 2003-09-14 release 1.5.4
+ maintenance release
+
+ 2003-11-16 release 1.6.0
+ - Incoming messages can be dauified now!
+ - daumode statusbar item revised
+
+ 2004-03-25 release 1.7.0
+ - new setting: %9dau_babble_options_line_by_line%9
+ - new setting: %9dau_files_babble_messages%9
+ - new switch for %9--color%9: %9-split paragraph%9
+ - new switch for %9--command%9: %9-in%9
+ - new switch for %9--moron%9: %9-omega%9
+ - new feature: %9--cowsay%9
+ - new feature: %9--mix%9 (by Martin Kihlgren <zond\@troja.ath.cx>)
+
+ 2004-04-01 release 1.7.1
+ - new setting: %9dau_remote_babble_channellist%9
+ - new setting: %9dau_remote_babble_channelpolicy%9
+ - new setting: %9dau_remote_babble_interval_accuracy%9
+
+ 2004-04-02 release 1.7.2
+ maintenance release
+
+ 2004-04-05 release 1.7.3
+ maintenance release
+
+ 2004-05-01 release 1.8.0
+ - new feature: %9--babble%9
+ - %9--help%9 revised
+
+ 2004-06-24 release 1.8.1
+ - new setting: %9dau_babble_verbose%9
+ - new setting: %9dau_babble_verbose_minimum_lines%9
+
+ 2004-07-10 release 1.8.2
+ maintenance release
+
+ 2004-07-25 release 1.8.3
+ maintenance release
+
+ 2004-09-14 release 1.8.4
+ maintenance release
+
+ 2004-10-18 release 1.8.5
+ maintenance release
+
+ 2004-11-07 release 1.8.6
+ maintenance release
+
+ 2005-01-28 release 1.9.0
+ - new setting: %9dau_cowsay_cowthink_path%9
+ - new switch for %9--cowsay%9: %9-arguments%9
+ - new switch for %9--cowsay%9: %9-think%9
+
+ 2005-06-05 release 2.0.0
+ - new setting: %9dau_color_choose_colors_randomly%9
+ - new setting: %9dau_color_codes%9
+ - new setting: %9dau_language%9
+ - new setting: %9dau_remote_question_regexp%9
+ - new switch for %9--bracket%9: %9-left%9
+ - new switch for %9--bracket%9: %9-right%9
+ - new switch for %9--color%9: %9-codes%9
+ - new switch for %9--color%9: %9-random%9
+ - new switch for %9--color%9: %9-split capitals%9
+ - new feature: %9--away%9
+ - new feature: %9--cool%9
+ - new feature: %9--long_help%9
+ - new feature: %9--parse_special%9
+
+ 2005-07-01 release 2.1.0
+ - new switch for %9--babble%9: %9-at%9
+ - %9--color%9: Support for background colors
+ - %9--color -codes%9: You may use now the color names
+ instead of the numeric color codes
+
+ 2005-07-24 release 2.1.1
+ maintenance release
+
+ 2005-08-02 release 2.1.2
+ maintenance release
+
+ 2005-11-01 release 2.1.3
+ maintenance release
+
+ 2006-03-11 release 2.1.4
+ maintenance release
+
+ 2006-05-21 release 2.1.5
+ new switch for %9--babble%9: %9-filter%9
+
+ 2006-10-25 release 2.1.6
+ new switch for %9--babble%9: %9-cancel%9
+
+ 2006-11-25 release 2.2.0
+ new feature: %9--substitute%9
+
+ 2007-03-07 release 2.3.0
+ - new setting: %9dau_daumode_channels%9
+ - new switch for %9--moron%9: %9-level%9
+ - new switch for %9--moron%9: %9-typo%9
+ - new switch for %9--random%9: %9-verbose%9
+
+ 2007-03-08 release 2.3.1
+ maintenance release
+
+ 2007-03-11 release 2.3.2
+ maintenance release
+
+ 2007-03-18 release 2.3.3
+ maintenance release
+
+ 2007-06-02 release 2.4.0
+ - new setting: %9dau_babble_history_size%9
+ - new switch for %9--babble%9: %9-history_size%9
+
+ 2007-06-26 release 2.4.1
+ maintenance release
+
+ 2007-10-11 release 2.4.2
+ maintenance release
+
+ 2008-02-03 release 2.4.3
+ maintenance release
+ END
+
+ return $output;
+}
+
+sub switch_create_files {
+
+ # create directory dau_files_root_directory if not found
+
+ if (-f $option{dau_files_root_directory}) {
+ print_err("$option{dau_files_root_directory} is a _file_ => aborting");
+ return;
+ }
+ if (-d $option{dau_files_root_directory}) {
+ print_out('directory dau_files_root_directory already exists - no need to create it');
+ } else {
+ if (mkpath([$option{dau_files_root_directory}])) {
+ print_out("creating directory $option{dau_files_root_directory}/");
+ } else {
+ print_err("failed creating directory $option{dau_files_root_directory}/");
+ }
+ }
+
+ # create file dau_files_substitute if not found
+
+ my $file1 = "$option{dau_files_root_directory}/$option{dau_files_substitute}";
+
+ if (-e $file1) {
+
+ print_out("file $file1 already exists - no need to create it");
+
+ } else {
+
+ if (open(FH1, ">", $file1)) {
+
+ print FH1 &fix(<<' END');
+ # dau.pl - http://dau.pl/
+ #
+ # This is the file --moron will use for your own substitutions.
+ # You can use any perlcode in here.
+ # $_ contains the text you can work with.
+ # $_ has to contain the data to be returned to dau.pl at the end.
+ END
+
+ print_out("$file1 created. you should edit it now!");
+
+ } else {
+
+ print_err("cannot write $file1: $!");
+
+ }
+
+ if (!close(FH1)) {
+ print_err("cannot close $file1: $!");
+ }
+ }
+
+ # create file dau_files_babble_messages if not found
+
+ my $file2 = "$option{dau_files_root_directory}/$option{dau_files_babble_messages}";
+
+ if (-e $file2) {
+
+ print_out("file $file2 already exists - no need to create it");
+
+ } else {
+
+ if (open(FH1, ">", $file2)) {
+
+ print FH1 &fix(<<' END');
+ END
+
+ print_out("$file2 created. you should edit it now!");
+
+ } else {
+
+ print_err("cannot write $file2: $!");
+
+ }
+
+ if (!close(FH1)) {
+ print_err("cannot close $file2: $!");
+ }
+ }
+
+ # create file dau_files_cool_suffixes if not found
+
+ my $file3 = "$option{dau_files_root_directory}/$option{dau_files_cool_suffixes}";
+
+ if (-e $file3) {
+
+ print_out("file $file3 already exists - no need to create it");
+
+ } else {
+
+ if (open(FH1, ">", $file3)) {
+
+ print FH1 &fix(<<' END');
+ END
+
+ print_out("$file3 created. you should edit it now!");
+
+ } else {
+
+ print_err("cannot write $file3: $!");
+
+ }
+
+ if (!close(FH1)) {
+ print_err("cannot close $file3: $!");
+ }
+ }
+
+ return;
+}
+
+sub switch_daumode {
+ $daumode_activated = 1;
+}
+
+sub switch_help {
+ my $output;
+ my $option_setting = return_option('help', 'setting');
+ $print_message = 1;
+
+ if ($option_setting eq '') {
+ $output = &fix(<<" END");
+ %9OPTIONS%9
+
+ $help{options}
+ END
+ }
+
+ # setting changed/added => change/add them below
+
+ # boolean
+
+ elsif ($option_setting eq 'dau_away_quote_reason') {
+ $output = &fix(<<" END");
+ %9dau_away_quote_reason%9 %Ubool
+
+ If turned on, %9--parse_special%9 will not be able to replace
+ variables which probably aren't one anyway.
+ END
+ }
+ elsif ($option_setting eq 'dau_away_reminder') {
+ $output = &fix(<<" END");
+ %9dau_away_reminder%9 %Ubool
+
+ Turn the reminder message of %9--away%9 on or off.
+ END
+ }
+ elsif ($option_setting eq 'dau_babble_verbose') {
+ $output = &fix(<<" END");
+ %9dau_babble_verbose%9 %Ubool
+
+ Before babbling print a message how many lines will be babbled and
+ when finished a notification message.
+ END
+ }
+ elsif ($option_setting eq 'dau_color_choose_colors_randomly') {
+ $output = &fix(<<" END");
+ %9dau_color_choose_colors_randomly%9 %Ubool
+
+ Choose colors randomly from setting dau_color_codes resp.
+ %9--color -codes%9 or take one by one in the exact order given.
+ END
+ }
+ elsif ($option_setting eq 'dau_cowsay_print_cow') {
+ $output = &fix(<<" END");
+ %9dau_cowsay_print_cow%9 %Ubool
+
+ Print a message which cow will be used.
+ END
+ }
+ elsif ($option_setting eq 'dau_figlet_print_font') {
+ $output = &fix(<<" END");
+ %9dau_figlet_print_font%9 %Ubool
+
+ Print a message which font will be used.
+ END
+ }
+ elsif ($option_setting eq 'dau_silence') {
+ $output = &fix(<<" END");
+ %9dau_silence%9 %Ubool
+
+ Don't print any information message. This does not include
+ error messages.
+ END
+ }
+ elsif ($option_setting eq 'dau_statusbar_daumode_hide_when_off') {
+ $output = &fix(<<" END");
+ %9dau_statusbar_daumode_hide_when_off%9 %Ubool
+
+ Hide statusbar item when daumode is turned off.
+ END
+ }
+ elsif ($option_setting eq 'dau_tab_completion') {
+ $output = &fix(<<" END");
+ %9dau_tab_completion%9 %Ubool
+
+ Perhaps someone wants to disable TAB completion for the
+ ${k}dau-command because he/she doesn't like it or wants
+ to give the CPU a break (don't know whether it has much
+ influence)
+ END
+ }
+
+ # Integer
+
+ elsif ($option_setting eq 'dau_babble_history_size') {
+ $output = &fix(<<" END");
+ %9dau_babble_history_size%9 %Uinteger
+
+ Number of lines to store in the babble history.
+ dau.pl will babble no line the history is holding.
+ END
+ }
+ elsif ($option_setting eq 'dau_babble_verbose_minimum_lines') {
+ $output = &fix(<<" END");
+ %9dau_babble_verbose_minimum_lines%9 %Uinteger
+
+ Minimum lines necessary to produce the output of the verbose
+ information.
+ END
+ }
+ elsif ($option_setting eq 'dau_cool_maximum_line') {
+ $output = &fix(<<" END");
+ %9dau_cool_maximum_line%9 %Uinteger
+
+ Trademarke[tm] or do \$this only %Un%U words per line tops.
+ END
+ }
+ elsif ($option_setting eq 'dau_cool_probability_eol') {
+ $output = &fix(<<" END");
+ %9dau_cool_probability_eol%9 %Uinteger
+
+ Probability that "!!!11one" or something like that will be put at EOL.
+ Set it to 100 and every line will be.
+ Set it to 0 and no line will be.
+ END
+ }
+ elsif ($option_setting eq 'dau_cool_probability_word') {
+ $output = &fix(<<" END");
+ %9dau_cool_probability_word%9 %Uinteger
+
+ Probability that a word will be trademarked[tm].
+ Set it to 100 and every word will be.
+ Set it to 0 and no word will be.
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_babble_interval_accuracy') {
+ $output = &fix(<<" END");
+ %9dau_remote_babble_interval_accuracy%9 %Uinteger
+
+ Value expressed as a percentage how accurate the timer of
+ the babble feature should be.
+
+ Legal values: 1-100
+
+ %U100%U would result in a very accurate timer.
+ END
+ }
+
+ # String
+
+ elsif ($option_setting eq 'dau_away_away_text') {
+ $output = &fix(<<" END");
+ %9dau_away_away_text%9 %Ustring
+
+ The text to say when using %9--away%9.
+
+ Special Variables:
+
+ \$reason: Your away reason.
+ END
+ }
+ elsif ($option_setting eq 'dau_away_back_text') {
+ $output = &fix(<<" END");
+ %9dau_away_back_text%9 %Ustring
+
+ The text to say when you return.
+
+ Special Variables:
+
+ \$reason: Your away reason.
+ \$time: The time you've been away.
+ END
+ }
+ elsif ($option_setting eq 'dau_away_reminder_interval') {
+ $output = &fix(<<" END");
+ %9dau_away_reminder_interval%9 %Ustring
+
+ Remind the channel that you're away! Repeat the message
+ in the given interval.
+ END
+ }
+ elsif ($option_setting eq 'dau_away_reminder_text') {
+ $output = &fix(<<" END");
+ %9dau_away_reminder_text%9 %Ustring
+
+ The text to say when you remind the channel that you're away.
+
+ Special Variables:
+
+ \$reason: Your away reason.
+ \$time: The time you've been away.
+ END
+ }
+ elsif ($option_setting eq 'dau_away_options') {
+ $output = &fix(<<" END");
+ %9dau_away_options%9 %Ustring
+
+ Options %9--away%9 will use.
+ END
+ }
+ elsif ($option_setting eq 'dau_babble_options_line_by_line') {
+ $output = &fix(<<" END");
+ %9dau_babble_options_line_by_line%9 %Ustring
+
+ One single babble may contain several lines. The options
+ specified in this setting are used for every line.
+ END
+ }
+ elsif ($option_setting eq 'dau_babble_options_preprocessing') {
+ $output = &fix(<<" END");
+ %9dau_babble_options_preprocessing%9 %Ustring
+
+ The options specified in this setting are applied to the
+ whole babble before anything else. Later, the options of
+ the setting %9dau_babble_options_line_by_line%9 are
+ applied to every line of the babble.
+ END
+ }
+ elsif ($option_setting eq 'dau_color_codes') {
+ $output = &fix(<<" END");
+ %9dau_color_codes%9 %Ustring
+
+ Specify the color codes to use, seperated by semicolons.
+ Example: %Ugreen; red; blue%U. You may use the color code (one
+ or two digits) or the color names. So either
+ %U2%U or %Ublue%U is ok. You can set a background color too:
+ %Ured,green%U and you will write with red on a green
+ background.
+ For a complete list of the color codes and names look at
+ formats.txt in the irssi documentation.
+ END
+ }
+ elsif ($option_setting eq 'dau_cool_eol_style') {
+ $output = &fix(<<" END");
+ %9dau_cool_eol_style%9 %Ustring
+
+ %Uexclamation_marks%U: !!!11one
+ %Urandom%U: Choose one style randomly
+ %Usuffixes%U: Suffixes from file
+ END
+ }
+ elsif ($option_setting eq 'dau_cowsay_cowlist') {
+ $output = &fix(<<" END");
+ %9dau_cowsay_cowlist%9 %Ustring
+
+ Comma separated list of cows. Checkout
+ %9${k}dau --help -setting dau_cowsay_cowpolicy%9
+ to see what this setting is good for.
+ END
+ }
+ elsif ($option_setting eq 'dau_cowsay_cowpath') {
+ $output = &fix(<<" END");
+ %9dau_cowsay_cowpath%9 %Ustring
+
+ Path to the cowsay-cows (*.cow).
+ END
+ }
+ elsif ($option_setting eq 'dau_cowsay_cowpolicy') {
+ $output = &fix(<<" END");
+ %9dau_cowsay_cowpolicy%9 %Ustring
+
+ Specifies the policy used to handle the cows in
+ dau_cowsay_cowpath. If set to %Uallow%U, all cows available
+ will be used by the command. You can exclude some cows by
+ setting dau_cowsay_cowlist. If set to %Udeny%U, no cows but
+ the ones listed in dau_cowsay_cowlist will be used by the
+ command. Useful if you have many annoying cows in your
+ cowpath and you want to permit only a few of them.
+ END
+ }
+ elsif ($option_setting eq 'dau_cowsay_cowsay_path') {
+ $output = &fix(<<" END");
+ %9dau_cowsay_cowsay_path%9 %Ustring
+
+ Should point to the cowsay executable.
+ END
+ }
+ elsif ($option_setting eq 'dau_cowsay_cowthink_path') {
+ $output = &fix(<<" END");
+ %9dau_cowsay_cowthink_path%9 %Ustring
+
+ Should point to the cowthink executable.
+ END
+ }
+ elsif ($option_setting eq 'dau_daumode_channels') {
+ $output = &fix(<<" END");
+ %9dau_daumode_channels%9 %U<channel>/<network>:<switches>, ...%U
+
+ Automatically enable the daumode for some channels.
+ %U#foo/bar:-modes_out '--substitute'%U would automatically
+ set the daumode on #foo in network bar to modify outgoing
+ messages with --substitute.
+ END
+ }
+ elsif ($option_setting eq 'dau_delimiter_string') {
+ $output = &fix(<<" END");
+ %9dau_delimiter_string%9 %Ustring
+
+ Tell %9--delimiter%9 which delimiter to use.
+ END
+ }
+ elsif ($option_setting eq 'dau_figlet_fontlist') {
+ $output = &fix(<<" END");
+ %9dau_figlet_fontlist%9 %Ustring
+
+ Comma separated list of fonts. Checkout
+ %9${k}dau --help -setting dau_figlet_fontpolicy%9
+ to see what this setting is good for. Use the program
+ `showfigfonts` shipped with figlet to find these fonts.
+ END
+ }
+ elsif ($option_setting eq 'dau_figlet_fontpath') {
+ $output = &fix(<<" END");
+ %9dau_figlet_fontpath%9 %Ustring
+
+ Path to the figlet-fonts (*.flf).
+ END
+ }
+ elsif ($option_setting eq 'dau_figlet_fontpolicy') {
+ $output = &fix(<<" END");
+ %9dau_figlet_fontpolicy%9 %Ustring
+
+ Specifies the policy used to handle the fonts in
+ dau_figlet_fontpath. If set to %Uallow%U, all fonts available
+ will be used by the command. You can exclude some fonts by
+ setting dau_figlet_fontlist. If set to %Udeny%U, no fonts but
+ the ones listed in dau_figlet_fontlist will be used by the
+ command. Useful if you have many annoying fonts in your
+ fontpath and you want to permit only a few of them.
+ END
+ }
+ elsif ($option_setting eq 'dau_figlet_path') {
+ $output = &fix(<<" END");
+ %9dau_figlet_path%9 %Ustring
+
+ Should point to the figlet executable.
+ END
+ }
+ elsif ($option_setting eq 'dau_files_away') {
+ $output = &fix(<<" END");
+ %9dau_files_away%9 %Ustring
+
+ The file with the away messages.
+ _Must_ be in dau_files_root_directory.
+ END
+ }
+ elsif ($option_setting eq 'dau_files_babble_messages') {
+ $output = &fix(<<" END");
+ %9dau_files_babble_messages%9 %Ustring
+
+ The file with the babble messages.
+ _Must_ be in dau_files_root_directory.
+ %9${k}dau --create_files%9 will create it.
+
+ Format of the file: Newline separated plain text.
+ The text will be sent through %9--parse_special%9 as well.
+ END
+ }
+ elsif ($option_setting eq 'dau_files_cool_suffixes') {
+ $output = &fix(<<" END");
+ %9dau_files_cool_suffixes%9 %Ustring
+
+ %9--cool%9 takes randomly one line out of this file
+ and puts it at the end of the line.
+ This file _must_ be in dau_files_root_directory.
+ %9${k}dau --create_files%9 will create it.
+
+ Format of the file: Newline separated plain text.
+ END
+ }
+ elsif ($option_setting eq 'dau_files_root_directory') {
+ $output = &fix(<<" END");
+ %9dau_files_root_directory%9 %Ustring
+
+ Directory in which all files for dau.pl will be stored.
+ %9${k}dau --create_files%9 will create it.
+ END
+ }
+ elsif ($option_setting eq 'dau_files_substitute') {
+ $output = &fix(<<" END");
+ %9dau_files_substitute%9 %Ustring
+
+ Your own substitutions file. _Must_ be in
+ dau_files_root_directory.
+ %9${k}dau --create_files%9 will create it.
+ END
+ }
+ elsif ($option_setting eq 'dau_language') {
+ $output = &fix(<<" END");
+ %9dau_language%9 %Ustring
+
+ %Ude%U: If you are writing in german
+ %Uen%U: If you are writing in english
+ END
+ }
+ elsif ($option_setting eq 'dau_moron_eol_style') {
+ $output = &fix(<<" END");
+ %9dau_moron_eol_style%9 %Ustring
+
+ What to do at End Of Line?
+
+ %Urandom%U:
+ - !!!??!!!!!????!??????????!!!1
+ - =
+ ?
+ - ?¿?
+ %Unothing%U: do nothing
+ END
+ }
+ elsif ($option_setting eq 'dau_parse_special_list_delimiter') {
+ $output = &fix(<<" END");
+ %9dau_parse_special_list_delimiter%9 %Ustring
+
+ Set the list delimiter used for \@nicks and \@opnicks to %Ustring%U.
+ END
+ }
+ elsif ($option_setting eq 'dau_random_options') {
+ $output = &fix(<<" END");
+ %9dau_random_options%9 %Ustring
+
+ Comma separated list of options %9--random%9 will use. It will
+ take randomly one item of the list. If you set it f.e. to
+ %U--uppercase --color,--mixedcase%U,
+ the probability of printing a colored, uppercased string hello
+ will be 50% as well as the probabilty of printing a mixedcased
+ string hello when typing %9${k}dau --random hello%9.
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_babble_channellist') {
+ $output = &fix(<<" END");
+ %9dau_remote_babble_channellist%9 %Ustring
+
+ Comma separated list of channels. You'll have to specify the
+ ircnet too.
+ Format: #channel1/IRCNet,#channel2/EFnet
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_babble_channelpolicy') {
+ $output = &fix(<<" END");
+ %9dau_remote_babble_channelpolicy%9 %Ustring
+
+ Using the default policy %Udeny%U the script won't do anything
+ except in the channels listed in dau_remote_babble_channellist.
+ Using the policy %Uallow%U the script will babble in all
+ channels but the ones listed in dau_remote_babble_channellist.
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_babble_interval') {
+ $output = &fix(<<" END");
+ %9dau_remote_babble_interval%9 %Ustring
+
+ dau.pl will babble text in the given interval.
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_channellist') {
+ $output = &fix(<<" END");
+ %9dau_remote_channellist%9 %Ustring
+
+ Comma separated list of channels. You'll have to specify the
+ ircnet too.
+ Format: #channel1/IRCNet,#channel2/EFnet
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_channelpolicy') {
+ $output = &fix(<<" END");
+ %9dau_remote_channelpolicy%9 %Ustring
+
+ Using the default policy %Udeny%U the script won't do anything
+ except in the channels listed in dau_remote_channellist. Using
+ the policy %Uallow%U the script will reply to all channels but
+ the ones listed in dau_remote_channellist.
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_deop_reply') {
+ $output = &fix(<<" END");
+ %9dau_remote_deop_reply%9 %Ustring
+
+ Comma separated list of messages (it will take randomly one
+ item of the list) sent to channel if someone deops you (mode
+ change -o).
+ The string given will be processed by the same subroutine
+ parsing the %9${k}dau%9 command.
+
+ Special Variables:
+
+ \$nick: contains the nick of the one who changed the mode
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_devoice_reply') {
+ $output = &fix(<<" END");
+ %9dau_remote_devoice_reply%9 %Ustring
+
+ Comma separated list of messages (it will take randomly one
+ item of the list) sent to channel if someone devoices you (mode
+ change -v).
+ The string given will be processed by the same subroutine
+ parsing the %9${k}dau%9 command.
+
+ Special Variables:
+
+ \$nick: contains the nick of the one who changed the mode
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_op_reply') {
+ $output = &fix(<<" END");
+ %9dau_remote_op_reply%9 %Ustring
+
+ Comma separated list of messages (it will take randomly one
+ item of the list) sent to channel if someone ops you (mode
+ change +o).
+ The string given will be processed by the same subroutine
+ parsing the %9${k}dau%9 command.
+
+ Special Variables:
+
+ \$nick: contains the nick of the one who changed the mode
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_permissions') {
+ $output = &fix(<<" END");
+ %9dau_remote_permissions%9 %U[01][01][01][01][01][01]
+
+ Permit or forbid the remote features.
+
+ First Bit:
+ Reply to question
+
+ Second Bit:
+ If someone gives you voice in a channel, thank him!
+
+ Third Bit:
+ If someone gives you op in a channel, thank him!
+
+ Fourth Bit:
+ If devoiced, print message
+
+ Fifth Bit:
+ If deopped, print message
+
+ Sixth Bit:
+ Babble text in certain intervals
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_question_regexp') {
+ $output = &fix(<<" END");
+ %9dau_remote_question_regexp%9 %Ustring
+
+ If someone says something matching that regular expression,
+ act accordingly.
+ The regexp will be sent through %9--parse_special%9.
+ Because of that you will have to escape some characters, f.e.
+ \\s to \\\\s for whitespace.
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_question_reply') {
+ $output = &fix(<<" END");
+ %9dau_remote_question_reply%9 %Ustring
+
+ Comma separated list of reply strings for the question of
+ setting dau_remote_question_regexp (it will randomly choose one
+ item of the list).
+ The string given will be processed by the same subroutine
+ parsing the %9${k}dau%9 command.
+
+ Special Variables:
+
+ \$nick: contains the nick of the one who sent the message to which
+ dau.pl reacts
+ END
+ }
+ elsif ($option_setting eq 'dau_remote_voice_reply') {
+ $output = &fix(<<" END");
+ %9dau_remote_voice_reply%9 %Ustring
+
+ Comma separated list of messages (it will take randomly one
+ item of the list) sent to channel if someone voices you (mode
+ change +v).
+ The string given will be processed by the same subroutine
+ parsing the %9${k}dau%9 command.
+
+ Special Variables:
+
+ \$nick: contains the nick of the one who changed the mode
+ END
+ }
+ elsif ($option_setting eq 'dau_standard_messages') {
+ $output = &fix(<<" END");
+ %9dau_standard_messages%9 %Ustring
+
+ Comma separated list of strings %9${k}dau%9 will use if the user
+ omits the text on the commandline.
+ END
+ }
+ elsif ($option_setting eq 'dau_standard_options') {
+ $output = &fix(<<" END");
+ %9dau_standard_options%9 %Ustring
+
+ Options %9${k}dau%9 will use if the user omits them on the commandline.
+ END
+ }
+ elsif ($option_setting eq 'dau_words_range') {
+ $output = &fix(<<" END");
+ %9dau_words_range%9 %Ui-j
+
+ Setup the range howmany words the command should write per line.
+ 1 <= i <= j <= 9; i, j element { 1, ... , 9 }. If i == j the command
+ will write i words to the active window. Else it takes a random
+ number k (element { i, ... , j }) and writes k words per
+ line.
+ END
+ }
+
+ return $output;
+}
+
+sub switch_long_help {
+ my $output;
+ $print_message = 1;
+
+ $output = &fix(<<" END");
+ %9SYNOPSIS%9
+
+ %9${k}dau [%Uoptions%U] [%Utext%U%9]
+
+ %9DESCRIPTION%9
+
+ dau? What does that mean? It's a german acronym for %9d%9ümmster
+ %9a%9nzunehmender %9u%9ser. In english: stupidest imaginable user.
+
+ With dau.pl every person can write like an idiot on the IRC!
+
+ %9OPTIONS%9
+
+ $help{options}
+ %9EXAMPLES%9
+
+ %9${k}dau --uppercase --mixedcase %Ufoo bar baz%9
+ Will write %Ufoo bar baz%U in mixed case.
+ %Ufoo bar baz%U is sent _first_ to %9--uppercase%9, _then_ to
+ %9--mixedcase%9.
+ The order in which you put the options on the commandline is
+ important!
+ You can see what output a command produces without sending it to
+ the active channel/query by sending it to a non-channel/query
+ window.
+
+ %9${k}dau --color --figlet %Ufoo bar baz%9
+ %9--color%9 is the first to be run and thus color codes will
+ be inserted.
+ The string will look like %U\\00302f\\00303o[...]%U when leaving
+ %9--color%9.
+ %9--figlet%9 uses then that string as its input.
+ So you'll have finally an output like
+ %U02f03o[...]%U in the figlet letters.
+ You'll probably want to use %9--figlet --color%9 instead.
+
+ %9SPECIAL FEATURES%9
+
+ %9Combine the options%9
+ You can combine most of the options! So you can write colored
+ leet messages f.e.. Look in the EXAMPLES section above.
+
+ %9Babble%9
+ dau.pl will babble text for you. It can do this on its own
+ in certain intervals or forced by the user using %9--babble%9.
+
+ Related settings:
+
+ %9dau_babble_options_line_by_line%9
+ %9dau_files_babble_messages%9
+ %9dau_files_root_directory%9
+ %9dau_remote_babble_channellist%9
+ %9dau_remote_babble_channelpolicy%9
+ %9dau_remote_babble_interval%9
+ %9dau_remote_babble_interval_accuracy%9
+ %9dau_remote_permissions%9
+
+ Related switches:
+
+ %9--babble%9
+ %9--create_files%9
+
+ %9Daumode%9
+ Dauify incoming and/or outgoing messages.
+
+ There is a statusbar item available displaying the current
+ status of the daumode. Add it with
+ %9/statusbar <bar> add [-alignment <left|right>] daumode%9
+ You may customize the look of the statusbar item in the
+ theme file:
+
+ sb_daumode = "{sb daumode I: \$0 (\$1) O: \$2 (\$3)}";
+
+ # \$0: will incoming messages be dauified?
+ # \$1: modes for incoming messages
+ # \$2: will outgoing messages be dauified?
+ # \$3: modes for outgoing messages
+
+ %9Remote features%9
+ Don't worry, dau.pl won't do anything automatically unless you
+ unlock these features!
+
+ %9Babble%9
+ dau.pl will babble text for you in certain intervals.
+
+ %9Reply to a question%9
+ Answer a question as a moron would.
+
+ Related settings:
+
+ %9dau_remote_channellist%9
+ %9dau_remote_channelpolicy%9
+ %9dau_remote_permissions%9
+ %9dau_remote_question_regexp%9
+ %9dau_remote_question_reply%9
+
+ %9Say something on (de)op/(de)voice%9
+ Related settings:
+
+ %9dau_remote_channellist%9
+ %9dau_remote_channelpolicy%9
+ %9dau_remote_deop_reply%9
+ %9dau_remote_devoice_reply%9
+ %9dau_remote_op_reply%9
+ %9dau_remote_permissions%9
+ %9dau_remote_voice_reply%9
+
+ %9TAB Completion%9
+ There is a really clever TAB Completion included! Since
+ commands can get very long you definitely want to use it.
+ It will only complete syntactically correct commands so the
+ TAB Completion isn't only a time saver, it's a control
+ instance too. You'll be suprised to see that it even completes
+ the figlet fonts and cows for cowsay that are available on
+ your system.
+
+ %9Website%9
+ $IRSSI{url}:
+ Additional information, DAU.pm, the dauomat and the dauproxy.
+ END
+
+ return $output;
+}
+
+sub switch_random {
+ my ($data, $channel_rec) = @_;
+ my $output;
+ my (@options, $opt, $text);
+
+ # Push each item of dau_random_options in the @options array.
+
+ while ($option{dau_random_options} =~ /\s*([^,]+)\s*,?/g) {
+ my $item = $1;
+ push @options, $item;
+ }
+
+ # More than one item in @options. Choose one randomly but exclude
+ # the last item chosen.
+
+ if (@options > 1) {
+ @options = grep { $_ ne $random_last } @options;
+ $opt = @options[rand(@options)];
+ $random_last = $opt;
+ }
+
+ # Exact one item in @options - take that
+
+ elsif (@options == 1) {
+ $opt = $options[0];
+ $random_last = $opt;
+ }
+
+
+ # No item in @options - call switch_moron()
+
+ else {
+ $opt = '--moron';
+ }
+
+ # dauify it!
+
+ unless (lc(return_option('random', 'verbose')) eq 'off') {
+ print_out("%9--random%9 has chosen %9$opt%9", $channel_rec);
+ }
+ $text .= $opt . ' ' . $data;
+ $output = parse_text($text, $channel_rec);
+
+ return $output;
+}
+
+################################################################################
+# Subroutines (switches, may be combined)
+################################################################################
+
+sub switch_boxes {
+ my $data = shift;
+
+ # handling punctuation marks:
+ # they will be put in their own box later
+
+ $data =~ s%(\w+)([,.?!;:]+)%
+ $1 . ' ' . join(' ', split(//, $2))
+ %egx;
+
+ # separate words (by whitespace) and put them in a box
+
+ $data =~ s/(\s*)(\S+)(\s*)/$1\[$2\]$3/g;
+
+ return $data;
+}
+
+sub switch_bracket {
+ my $data = shift;
+ my $output;
+
+ my $option_left = return_option('bracket', 'left');
+ my $option_right = return_option('bracket', 'right');
+
+ my %brackets = (
+ '((' => '))',
+ '-=(' => ')=-',
+ '-=[' => ']=-',
+ '-={' => '}=-',
+ '-=|(' => ')|=-',
+ '-=|[' => ']|=-',
+ '-=|{' => '}|=-',
+ '.:>' => '<:.',
+ );
+
+ foreach (keys %brackets) {
+ for my $times (2 .. 3) {
+ my $pre = $_;
+ my $post = $brackets{$_};
+ $pre =~ s/(.)/$1 x $times/eg;
+ $post =~ s/(.)/$1 x $times/eg;
+
+ $brackets{$pre} = $post;
+ }
+ }
+
+ $brackets{'!---?['} = ']?---!';
+ $brackets{'(qp=>'} = '<=qp)';
+ $brackets{'----->'} = '<-----';
+
+ my ($left, $right);
+ if ($option_left && $option_right) {
+ $left = $option_left;
+ $right = $option_right;
+ } else {
+ $left = (keys(%brackets))[int(rand(keys(%brackets)))];
+ $right = $brackets{$left};
+ }
+
+ $output = "$left $data $right";
+
+ return $output;
+}
+
+sub switch_chars {
+ my $data = shift;
+ my $output;
+
+ foreach my $char (split //, $data) {
+ $output .= "$char\n";
+ }
+ return $output;
+}
+
+sub switch_command {
+ my ($data, $channel_rec) = @_;
+
+ # -out <command>
+
+ $command_out = return_option('command', 'out');
+ $command_out_activated = 1;
+
+ # -in <command>
+
+ $command_in = '';
+ my $option_command_in = return_option('command', 'in');
+
+ if ($option_command_in) {
+ return unless (defined($channel_rec) && $channel_rec);
+
+ # Deactivate daumode for a brief moment
+ $signal{'send text'} = 0;
+ Irssi::signal_remove('send text', 'signal_send_text');
+
+ # Capture the output
+ Irssi::signal_add_first('command msg', 'signal_command_msg');
+ $channel_rec->command("$option_command_in $data");
+ Irssi::signal_remove('command msg', 'signal_command_msg');
+
+ # Reactivate daumode
+ signal_handling();
+
+ return $command_in;
+ }
+
+ return $data;
+}
+
+sub switch_color {
+ my $data = shift;
+ my (@all_colors, @colors, $output, $split);
+
+ ################################################################################
+ # Hack to support UTF-8
+ ################################################################################
+
+ if (Irssi::settings_get_str('term_charset') =~ /utf-?8/i) {
+ eval {
+ require Encode;
+ $data = Encode::decode("utf-8", $data);
+ };
+ }
+
+ ################################################################################
+ # Get options
+ ################################################################################
+
+ my $option_color_split = return_option('color', 'split', 'words');
+ my $option_color_codes = return_option('color', 'codes', $option{dau_color_codes});
+ my $option_color_random = return_option('color', 'random', $option{dau_color_choose_colors_randomly});
+ if ($option_color_random eq 'on' || $option_color_random == 1) {
+ $option_color_random = 1;
+ } else {
+ $option_color_random = 0;
+ }
+
+ ################################################################################
+ # color name -> color code
+ ################################################################################
+
+ $option_color_codes =~ s/\blight green\b/09/gi;
+ $option_color_codes =~ s/\bgreen\b/03/gi;
+ $option_color_codes =~ s/\blight red\b/04/gi;
+ $option_color_codes =~ s/\bred\b/05/gi;
+ $option_color_codes =~ s/\blight cyan\b/11/gi;
+ $option_color_codes =~ s/\bcyan\b/10/gi;
+ $option_color_codes =~ s/\blight blue\b/12/gi;
+ $option_color_codes =~ s/\bblue\b/02/gi;
+ $option_color_codes =~ s/\blight magenta\b/13/gi;
+ $option_color_codes =~ s/\bmagenta\b/06/gi;
+ $option_color_codes =~ s/\blight grey\b/15/gi;
+ $option_color_codes =~ s/\bgrey\b/14/gi;
+
+ $option_color_codes =~ s/\bwhite\b/00/gi;
+ $option_color_codes =~ s/\bblack\b/01/gi;
+ $option_color_codes =~ s/\borange\b/07/gi;
+ $option_color_codes =~ s/\byellow\b/08/gi;
+
+ ################################################################################
+ # Produce @all_colors
+ ################################################################################
+
+ # <color code>5 shall be a colored 5
+
+ $option_color_codes =~ s/(\d+)/sprintf('%02d', $1)/eg;
+
+ # Fill @all_colors and do error checking
+
+ my @all_colors = split(/\s*;\s*/, $option_color_codes);
+ foreach my $code (@all_colors) {
+ if ($code !~ /^\d+(,\d+)?$/) {
+ print_err("Incorrect color code '$code'!");
+ return $data;
+ }
+ }
+ if (@all_colors == 0) {
+ print_err('No color code found.');
+ return $data;
+ }
+ @colors = @all_colors;
+
+ ################################################################################
+ # "-split capitals"
+ ################################################################################
+
+ if ($option_color_split eq 'capitals') {
+ $output = $data;
+ my ($color1, $color2);
+ if ($option_color_random) {
+ $color1 = $colors[rand(@colors)];
+ @colors = grep { $_ ne $color1 } @colors unless (@colors == 1);
+ $color2 = $colors[rand(@colors)];
+ } else {
+ if (@colors == 1) {
+ $color1 = $color2 = $colors[0];
+ } else {
+ $color1 = $colors[0];
+ $color2 = $colors[1];
+ }
+ }
+
+ $output =~ s/([[:upper:][:punct:]]+|\b\S)/\003${color1}${1}\003${color2}/g;
+
+ # Remove needless color codes
+ $output =~ s/\003(?:$color1|$color2)( *)\003(?:$color1|$color2)/$1/g;
+ $output =~ s/\003(?:$color1|$color2)$//;
+ }
+
+ ################################################################################
+ # Not "-split capitals"
+ ################################################################################
+
+ else {
+ if ($option_color_split eq 'chars') {
+ $split = '';
+ } elsif ($option_color_split eq 'lines') {
+ $split = "\n";
+ } elsif ($option_color_split eq 'words') {
+ $split = '\s+';
+ } elsif ($option_color_split eq 'rchars') {
+ $split = '.' x rand(10);
+ } elsif ($option_color_split eq 'paragraph') {
+ $split = "\n";
+ } else {
+ $split = '\s+';
+ }
+
+ my $i = 0;
+ my $background = 0;
+ my $color;
+ for (split /($split)/, $data) {
+ if (/^\s*$/) {
+ $output .= $_;
+ next;
+ }
+ if ($option_color_random) {
+ $color = $colors[rand(@colors)];
+
+ $output .= "\017" if ($background && $color !~ /,/);
+ $output .= "\003" . $color . $_;
+
+ if ($color =~ /,/) {
+ $background = 1;
+ } else {
+ $background = 0;
+ }
+
+ if ($option_color_split eq 'paragraph') {
+ @colors = ($color);
+ } else {
+ @colors = grep { $_ ne $color } @all_colors unless (@all_colors == 1);
+ }
+ } else {
+ $color = $colors[($i++ % ($#colors + 1))];
+
+ if ($option_color_split eq 'paragraph') {
+ $color = $colors[0];
+ }
+
+ $output .= "\017" if ($background && $color !~ /,/);
+ $output .= "\003" . $color . $_;
+
+ if ($color =~ /,/) {
+ $background = 1;
+ } else {
+ $background = 0;
+ }
+ }
+ }
+ }
+
+ return $output;
+}
+
+sub switch_cool {
+ my ($data, $channel) = @_;
+ my $output;
+
+ ################################################################################
+ # Get the options
+ ################################################################################
+
+ my $option_eol_style = return_option('cool', 'eol_style', $option{dau_cool_eol_style});
+
+ my $option_max = return_option('cool', 'max', $option{dau_cool_maximum_line});
+ if (!defined($option_max) || int($option_max) < 0) {
+ $option_max = INT_MAX;
+ }
+
+ my $option_prob_eol = return_option('cool', 'prob_eol', $option{dau_cool_probability_eol});
+ if (!defined($option_prob_eol) || int($option_prob_eol) < 0 || int($option_prob_eol) > 100) {
+ $option_prob_eol = 20;
+ }
+
+ my $option_prob_word = return_option('cool', 'prob_word', $option{dau_cool_probability_word});
+ if (!defined($option_prob_word) || int($option_prob_word) < 0 || int($option_prob_word) > 100) {
+ $option_prob_word = 20;
+ }
+
+ ################################################################################
+ # Insert the trademarks and dollar signs
+ ################################################################################
+
+ my $max = $option_max;
+ foreach my $line (split /(\n)/, $data) {
+ foreach my $word (split /(\s)/, $line) {
+ if ($max > 0 && (rand(100) <= $option_prob_word) && $word =~ /^(\w+)([[:punct:]])?$/) {
+ $word = "${1}[tm]${2}";
+ $max--;
+ }
+ if ($max > 0 && (rand(100) <= $option_prob_word) && $word =~ /^(\w+(?:\[tm\])?)([[:punct:]])?$/) {
+ $word = "\$${1}${2}";
+ $max--;
+ }
+ $output .= $word;
+ }
+ $max = $option_max;
+ }
+
+ ################################################################################
+ # Reversed smileys
+ ################################################################################
+
+ my $hat = '[(<]';
+ my $eyes = '[:;%]';
+ my $nose = '[-]';
+ my $mouth = '[)(><\[\]{}|]';
+
+ $output =~ s{($hat?$eyes$nose?$mouth+)}{
+ # Supposed to be read from the right to the left.
+ # Therefore reverse all parenthesis characters:
+
+ my $tr = $1;
+ $tr =~ tr/()<>[]\{\}/)(><][\}\{/;
+
+ # Reverse the rest
+
+ reverse($tr);
+ }egox;
+
+ ################################################################################
+ # EOL modifications
+ ################################################################################
+
+ my $style = $option_eol_style;
+ if ($option_eol_style eq 'random') {
+ if (int(rand(2)) && $output !~ /[?!]$/) {
+ $style = 'exclamation_marks';
+ } else {
+ $style = 'suffixes';
+ }
+ }
+
+ # If there is no suffixes file, go for the exclamation marks
+
+ my $file = "$option{dau_files_root_directory}/$option{dau_files_cool_suffixes}";
+ unless (-e $file && -r $file && !(-z $file)) {
+ $style = 'exclamation_marks';
+ }
+
+ # Skip EOL modifications?
+
+ if (int(rand(100)) > $option_prob_eol) {
+ $style = 'none';
+ }
+
+ # Style determined. Act accordingly:
+
+ if ($style eq 'exclamation_marks') {
+ my @eol;
+ if ($option{dau_language} eq 'de') {
+ @eol = ("eins", "shifteins", "elf", "hundertelf", "tausendeinhundertundelf");
+ for (1 .. 5) {
+ push(@eol, "eins");
+ push(@eol, "elf");
+ }
+ } else {
+ @eol = ("one", "shiftone", "eleven");
+ for (1 .. 5) {
+ push(@eol, "one");
+ push(@eol, "eleven");
+ }
+ }
+
+ $output =~ s/\s*([,.?!])*\s*$//;
+ $output .= '!' x (3 + int(rand(3)));
+ $output .= '1' x (3 + int(rand(3)));
+ $output .= $eol[rand(@eol)] x (1 + int(rand(1)));
+ $output .= $eol[rand(@eol)] x (int(rand(2)));
+ } elsif ($style eq 'suffixes') {
+ my $suffix;
+ if (-e $file && -r $file) {
+ local $/ = "\n";
+ @ARGV = ($file);
+ srand;
+ rand($.) < 1 && ($suffix = switch_parse_special($_, $channel)) while <>;
+ }
+ $output =~ s/\s*$//;
+
+ if ($output =~ /^\s*$/) {
+ $output = $suffix;
+ } else {
+ $output .= " " . $suffix;
+ }
+ }
+
+ return $output;
+}
+
+sub switch_cowsay {
+ my $data = shift;
+ my ($binarypath, $output, @cows, %cow, $cow, @cache1, @cache2);
+ my $skip = 1;
+ my $think = return_option('cowsay', 'think');
+
+ my $executable_name;
+ if ($think eq 'on') {
+ $binarypath = $option{dau_cowsay_cowthink_path};
+ $executable_name = 'cowthink';
+ } else {
+ $binarypath = $option{dau_cowsay_cowsay_path};
+ $executable_name = 'cowsay';
+ }
+
+ if (-e $binarypath && !(-f $binarypath)) {
+ print_err("dau_cowsay_${executable_name}_path has to point to the $executable_name executable.");
+ return;
+ } elsif (!(-e $binarypath)) {
+ print_err("$executable_name not found. Install it and set dau_cowsay_${executable_name}_path.");
+ return;
+ }
+
+ if (return_option('cowsay', 'cow')) {
+ $cow = return_option('cowsay', 'cow');
+ } else {
+ while ($option{dau_cowsay_cowlist} =~ /\s*([^,\s]+)\s*,?/g) {
+ $cow{$1} = 1;
+ }
+ foreach my $cow (keys %{ $switches{combo}{cowsay}{cow} }) {
+ if (lc($option{dau_cowsay_cowpolicy}) eq 'allow') {
+ push(@cows, $cow)
+ unless ($cow{$cow});
+ } elsif (lc($option{dau_cowsay_cowpolicy}) eq 'deny') {
+ push(@cows, $cow)
+ if ($cow{$cow});
+ } else {
+ print_err('Invalid value for dau_cowsay_cowpolicy');
+ return;
+ }
+ }
+ if (@cows == 0) {
+ print_err('Cannot find any cowsay cow.');
+ return;
+ }
+ $cow = $cows[rand(@cows)];
+ }
+
+ # Run cowsay or cowthink
+
+ local(*HIS_IN, *HIS_OUT, *HIS_ERR);
+ my @arguments;
+ my $option_arguments = return_option('cowsay', 'arguments');
+ if ($option_arguments) {
+ @arguments = split(/ /, $option_arguments);
+ }
+ my $childpid = open3(*HIS_IN, *HIS_OUT, *HIS_ERR, $binarypath, '-f', $cow, @arguments);
+
+ print HIS_IN $data or return;
+ close(HIS_IN) or return;
+
+ my @errlines = <HIS_ERR>;
+ my @outlines = <HIS_OUT>;
+ close(HIS_ERR) or return;
+ close(HIS_OUT) or return;
+
+ waitpid($childpid, 0);
+ if ($?) {
+ print_err("That child exited with wait status of $?");
+ }
+
+ # Error during execution? Print errors and return
+
+ unless (@errlines == 0) {
+ print_err('Error during execution of cowsay');
+ foreach my $line (@errlines) {
+ print_err($line);
+ }
+ return;
+ }
+
+ if ($option{dau_cowsay_print_cow}) {
+ print_out("Using cowsay cow $cow");
+ }
+
+ foreach (@outlines) {
+ chomp;
+ if (/^\s*$/ && $skip) {
+ next;
+ } else {
+ $skip = 0;
+ }
+ push(@cache1, $_);
+ }
+ $skip = 1;
+ foreach (reverse @cache1) {
+ chomp;
+ if (/^\s*$/ && $skip) {
+ next;
+ } else {
+ $skip = 0;
+ }
+ push(@cache2, $_);
+ }
+ foreach (reverse @cache2) {
+ $output .= "$_\n";
+ }
+
+ return $output;
+}
+
+sub switch_delimiter {
+ my $data = shift;
+ my $output;
+ my $option_delimiter_string = return_option('delimiter', 'string', $option{dau_delimiter_string});
+
+ foreach my $char (split //, $data) {
+ $output .= $char . $option_delimiter_string;
+ }
+ return $output;
+}
+
+sub switch_dots {
+ my $data = shift;
+
+ $data =~ s/[.]*\s+/
+ if (rand(10) < 3) {
+ (rand(10) >= 5 ? ' ' : '')
+ .
+ ('...' . '.' x rand(5))
+ .
+ (rand(10) >= 5 ? ' ' : '')
+ } else { ' ' }
+ /egox;
+ rand(10) >= 5 ? $data .= ' ' : 0;
+ $data .= ('...' . '.' x rand(10));
+
+ return $data;
+}
+
+sub switch_figlet {
+ my $data = shift;
+ my $skip = 1;
+ my ($output, @fonts, %font, $font, @cache1, @cache2);
+
+ if (-e $option{dau_figlet_path} && !(-f $option{dau_figlet_path})) {
+ print_err('dau_figlet_path has to point to the figlet executable.');
+ return;
+ } elsif (!(-e $option{dau_figlet_path})) {
+ print_err('figlet not found. Install it and set dau_figlet_path.');
+ return;
+ }
+
+ if (return_option('figlet', 'font')) {
+ $font = return_option('figlet', 'font');
+ } else {
+ while ($option{dau_figlet_fontlist} =~ /\s*([^,\s]+)\s*,?/g) {
+ $font{$1} = 1;
+ }
+ foreach my $font (keys %{ $switches{combo}{figlet}{font} }) {
+ if (lc($option{dau_figlet_fontpolicy}) eq 'allow') {
+ push(@fonts, $font)
+ unless ($font{$font});
+ } elsif (lc($option{dau_figlet_fontpolicy}) eq 'deny') {
+ push(@fonts, $font)
+ if ($font{$font});
+ } else {
+ print_err('Invalid value for dau_figlet_fontpolicy.');
+ return;
+ }
+ }
+ if (@fonts == 0) {
+ print_err('Cannot find figlet fonts.');
+ return;
+ }
+ $font = $fonts[rand(@fonts)];
+ }
+
+ # Run figlet
+
+ local(*HIS_IN, *HIS_OUT, *HIS_ERR);
+
+ my $childpid = open3(*HIS_IN, *HIS_OUT, *HIS_ERR, $option{dau_figlet_path}, '-f', $font);
+
+ print HIS_IN $data or return;
+ close(HIS_IN) or return;
+
+ my @errlines = <HIS_ERR>;
+ my @outlines = <HIS_OUT>;
+ close(HIS_ERR) or return;
+ close(HIS_OUT) or return;
+
+ waitpid($childpid, 0);
+ if ($?) {
+ print_err("That child exited with wait status of $?");
+ }
+
+ # Error during execution? Print errors and return
+
+ unless (@errlines == 0) {
+ print_err('Error during execution of figlet');
+ foreach my $line (@errlines) {
+ print_err($line);
+ }
+ return;
+ }
+
+ if ($option{dau_figlet_print_font}) {
+ print_out("Using figlet font $font");
+ }
+
+ foreach (@outlines) {
+ chomp;
+ if (/^\s*$/ && $skip) {
+ next;
+ } else {
+ $skip = 0;
+ }
+ push(@cache1, $_);
+ }
+ $skip = 1;
+ foreach (reverse @cache1) {
+ chomp;
+ if (/^\s*$/ && $skip) {
+ next;
+ } else {
+ $skip = 0;
+ }
+ push(@cache2, $_);
+ }
+ foreach (reverse @cache2) {
+ $output .= "$_\n";
+ }
+
+ return $output;
+}
+
+sub switch_leet {
+ my $data = shift;
+
+ $_ = $data;
+
+ s'fucker'f@#$er'gi;
+ s/hacker/h4x0r/gi;
+ s/sucker/sux0r/gi;
+ s/fear/ph34r/gi;
+
+ s/\b(\w+)ude\b/${1}00d/gi;
+ s/\b(\w+)um\b/${1}00m/gi;
+ s/\b(\w{3,})er\b/${1}0r/gi;
+ s/\bdo\b/d00/gi;
+ s/\bthe\b/d4/gi;
+ s/\byou\b/j00/gi;
+
+ tr/lLzZeEaAsSgGtTbBqQoOiIcC/11223344556677889900||((/;
+ s/(\w)/rand(100) < 50 ? "\u$1" : "\l$1"/ge;
+
+ return $_;
+}
+
+sub switch_me {
+ my $data = shift;
+
+ $command_out = 'ACTION';
+
+ return $data;
+}
+
+# &switch_mix by Martin Kihlgren <zond@troja.ath.cx>
+# slightly modified by myself
+
+sub switch_mix {
+ my $data = shift;
+ my $output;
+
+ while ($data =~ s/(\s*)([^\w]*)([\w]+)([^\w]*)(\s+[^\w]*\w+[^\w]*\s*)*/$5/) {
+ my $prespace = $1;
+ my $prechars = $2;
+ my $w = $3;
+ my $postchars = $4;
+ $output = $output . $prespace . $prechars . substr($w,0,1);
+ my $middle = substr($w,1,length($w) - 2);
+ while ($middle =~ s/(.)(.*)/$2/) {
+ if (rand() > 0.1) {
+ $middle = $middle . $1;
+ } else {
+ $output = $output . $1;
+ }
+ }
+ if (length($w) > 1) {
+ $output = $output . substr($w, length($w) - 1, 1);
+ }
+ $output = $output . $postchars;
+ }
+
+ return $output;
+}
+
+sub switch_mixedcase {
+ my $data = shift;
+
+ $data =~ s/([[:alpha:]])/rand(100) < 50 ? uc($1) : lc($1)/ge;
+
+ return $data;
+}
+
+sub switch_moron {
+ my ($data, $channel_rec) = @_;
+ my $output;
+ my $option_eol_style = return_option('moron', 'eol_style', $option{dau_moron_eol_style});
+ my $option_language = $option{dau_language};
+
+ ################################################################################
+ # -omega on
+ ################################################################################
+
+ my $omega;
+
+ if (return_option('moron', 'omega') eq 'on') {
+ my @words = qw(omfg lol wtf);
+
+ foreach (split / (?=\w+\b)/, $data) {
+ if (rand(100) < 20) {
+ $omega .= ' ' . $words[rand(@words)] . " $_";
+ } else {
+ $omega .= ' ' . $_;
+ }
+ }
+
+ $omega =~ s/\s*,\s+\@/ @/g;
+ $omega =~ s/^\s+//;
+ }
+
+ $_ = $omega || $data;
+
+ ################################################################################
+ # 'nick: text' -> 'text @ nick'
+ ################################################################################
+
+ my $old_list_delimiter = $option{dau_parse_special_list_delimiter};
+ $option{dau_parse_special_list_delimiter} = ' ';
+ my @nicks = split(/ /, switch_parse_special('@nicks', $channel_rec));
+ $option{dau_parse_special_list_delimiter} = $old_list_delimiter;
+ @nicks = map { quotemeta($_) } @nicks;
+
+ {
+ local $" = '|';
+ eval { # Catch strange error
+ s/^(@nicks): (.+)/$2 @ $1/;
+ };
+ }
+
+ ################################################################################
+ # Preparations for "EOL modifications" later
+ ################################################################################
+
+ # Remove puntuation marks at EOL and ensure there is a single space at EOL.
+ # This is necessary because the EOL-styles 'new' and 'classic' put them at
+ # EOL. If EOL-style is set to 'nothing' don't do this.
+
+ s/\s*([,;.:?!])*\s*$// unless ($option_eol_style eq 'nothing');
+ my $lastchar = $1;
+
+ # Only whitespace? Remove it.
+
+ s/^\s+$//;
+
+ ################################################################################
+ # Substitutions for every language
+ ################################################################################
+
+ tr/'/`/;
+
+ # Dauify smileys
+
+ {
+ # Use of uninitialized value in concatenation (.) or string at...
+ # (the optional dash ($1) in the regular expressions).
+ # Thus turn off warnings
+
+ no warnings;
+
+ if ($option{dau_language} eq 'de') {
+ if (int(rand(2))) {
+ s/:(-)?\)/^^/go;
+ } else {
+ s/:(-)?\)/':' . $1 . ')))' . (')' x rand(10)) . ('9' x rand(4))/ego;
+ }
+
+ s/;(-)?\)/';' . $1 . ')))' . (')' x rand(10)) . ('9' x rand(4))/ego;
+ s/:(-)?\(/':' . $1 . '(((' . ('(' x rand(10)) . ('8' x rand(4))/ego;
+ s#(^|\s):(-)?/(\s|$)#$1 . ':' . $2 . '///' . ('/' x rand(10)) . ('7' x rand(4)) . $3#ego;
+ } else {
+ if (int(rand(2))) {
+ s/:(-)?\)/^^/go;
+ } else {
+ s/:(-)?\)/':' . $1 . ')))' . (')' x rand(10)) . ('0' x rand(4))/ego;
+ }
+
+ s/;(-)?\)/';' . $1 . ')))' . (')' x rand(10)) . ('0' x rand(4))/ego;
+ s/:(-)?\(/':' . $1 . '(((' . ('(' x rand(10)) . ('9' x rand(4))/ego;
+ }
+ }
+
+ ################################################################################
+ # English text
+ ################################################################################
+
+ if ($option_language eq 'en') {
+ s/\bthe\b/teh/go;
+ }
+
+ ################################################################################
+ # German text
+ ################################################################################
+
+ if ($option_language eq 'de') {
+
+ # '*GG*' -> 'ÜGGÜ'
+ {
+ my @a = ('*', 'Ü');
+ my $a = $a[int(rand(@a))];
+ s/\*g\*/$a . 'ggg' . ('g' x rand(10)) . $a/egio;
+ }
+
+ # verbs
+
+ s/\b(f)reuen\b/$1roien/gio;
+ s/\b(f)reue\b/$1roie/gio;
+ s/\b(f)reust\b/$1roist/gio;
+ s/\b(f)reut\b/$1roit/gio;
+
+ s/\b(f)unktionieren\b/$1unzen/gio;
+ s/\b(f)unktioniere\b/$1unze/gio;
+ s/\b(f)unktionierst\b/$1unzt/gio;
+ s/\b(f)unktioniert\b/$1unzt/gio;
+
+ s/\b(h)olen\b/$1ohlen/gio;
+ s/\b(h)ole\b/$1ohle/gio;
+ s/\b(h)olst\b/$1ohlst/gio;
+ s/\b(h)olt\b/$1ohlt/gio;
+
+ s/\b(k)onfigurieren\b/$1 eq 'k' ? 'confen' : 'Confen'/egio;
+ s/\b(k)onfiguriere\b/$1 eq 'k' ? 'confe' : 'Confe'/egio;
+ s/\b(k)onfigurierst\b/$1 eq 'k' ? 'confst' : 'Confst'/egio;
+ s/\b(k)onfiguriert\b/$1 eq 'k' ? 'conft' : 'Conft'/egio;
+
+ s/\b(l)achen\b/$1ölen/gio;
+ s/\b(l)ache\b/$1öle/gio;
+ s/\b(l)achst\b/$1ölst/gio;
+ s/\b(l)acht\b/$1ölt/gio;
+
+ s/\b(m)achen\b/$1 eq 'm' ? 'tun' : 'Tun'/egio;
+ s/\b(m)ache\b/$1 eq 'm' ? 'tu' : 'Tu'/egio;
+ s/\b(m)achst\b/$1 eq 'm' ? 'tust' : 'Tust'/egio;
+
+ s/\b(n)erven\b/$1erfen/gio;
+ s/\b(n)erve\b/$1erfe/gio;
+ s/\b(n)ervst\b/$1erfst/gio;
+ s/\b(n)ervt\b/$1erft/gio;
+
+ s/\b(p)rojizieren\b/$1rojezieren/gio;
+ s/\b(p)rojiziere\b/$1rojeziere/gio;
+ s/\b(p)rojizierst\b/$1rojezierst/gio;
+ s/\b(p)rojiziert\b/$1rojeziert/gio;
+
+ s/\b(r)egistrieren\b/$1egestrieren/gio;
+ s/\b(r)egistriere\b/$1egestriere/gio;
+ s/\b(r)egistrierst\b/$1egestrierst/gio;
+ s/\b(r)egistriert\b/$1egestriert/gio;
+
+ s/\b(s)pazieren\b/$1patzieren/gio;
+ s/\b(s)paziere\b/$1patziere/gio;
+ s/\b(s)pazierst\b/$1patzierst/gio;
+ s/\b(s)paziert\b/$1patziert/gio;
+
+ # other
+
+ s/\bdanke\b/
+ if (int(rand(2)) == 0) {
+ 'thx'
+ } else {
+ 'danks'
+ }
+ /ego;
+ s/\bDanke\b/
+ if (int(rand(2)) == 0) {
+ 'Thx'
+ } else {
+ 'Danks'
+ }
+ /ego;
+
+ s/\blol\b/
+ if (int(rand(2)) == 0) {
+ 'löl'
+ } else {
+ 'löllens'
+ }
+ /ego;
+ s/\bLOL\b/
+ if (int(rand(2)) == 0) {
+ 'LÖL'
+ } else {
+ 'LÖLLENS'
+ }
+ /ego;
+
+ s/\br(?:ü|ue)ckgrat\b/
+ if (int(rand(3)) == 0) {
+ 'rückgrad'
+ } elsif (int(rand(3)) == 1) {
+ 'rückrad'
+ } else {
+ 'rückrat'
+ }
+ /ego;
+ s/\bR(?:ü|ue)ckgrat\b/
+ if (int(rand(3)) == 0) {
+ 'Rückgrad'
+ } elsif (int(rand(3)) == 1) {
+ 'Rückrad'
+ } else {
+ 'Rückrat'
+ }
+ /ego;
+
+ s/\b(i)st er\b/$1ssa/gio;
+ s/\bist\b/int(rand(2)) ? 'is' : 'iss'/ego;
+ s/\bIst\b/int(rand(2)) ? 'Is' : 'Iss'/ego;
+
+ s/\b(d)a(?:ss|ß) du\b/$1asu/gio;
+ s/\b(d)a(?:ss|ß)\b/$1as/gio;
+
+ s/\b(s)ag mal\b/$1amma/gio;
+ s/\b(n)ochmal\b/$1omma/gio;
+ s/(m)al\b/$1a/gio;
+
+ s/\b(u)nd nun\b/$1nnu/gio;
+ s/\b(n)un\b/$1u/gio;
+
+ s/\b(s)oll denn\b/$1olln/gio;
+ s/\b(d)enn\b/$1en/gio;
+
+ s/\b(s)o eine\b/$1onne/gio;
+ s/\b(e)ine\b/$1 eq 'e' ? 'ne' : 'Ne'/egio;
+
+ s/\bkein problem\b/NP/gio;
+ s/\b(p)roblem\b/$1rob/gio;
+ s/\b(p)robleme\b/$1robs/gio;
+
+ s/\b(a)ber\b/$1bba/gio;
+ s/\b(a)chso\b/$1xo/gio;
+ s/\b(a)dresse\b/$1ddresse/gio;
+ s/\b(a)ggressiv\b/$1gressiv/gio;
+ s/\b([[:alpha:]]{2,})st du\b/${1}su/gio;
+ s/\b(a)nf(?:ä|ae)nger\b/$1 eq 'a' ? 'n00b' : 'N00b'/egio;
+ s/\b(a)sozial\b/$1ssozial/gio;
+ s/\b(a)u(?:ss|ß)er\b/$1user/gio;
+ s/\b(a)utor/$1uthor/gio;
+ s/\b(b)asta\b/$1 eq 'b' ? 'pasta' : 'Pasta'/egio;
+ s/\b(b)illard\b/$1illiard/gio;
+ s/\b(b)i(?:ss|ß)chen\b/$1ischen/gio;
+ s/\b(b)ist\b/$1is/gio;
+ s/\b(b)itte\b/$1 eq 'b' ? 'plz' : 'Plz'/egio;
+ s/\b(b)lo(?:ss|ß)\b/$1los/gio;
+ s/\b(b)(?:ox|(?:ü|ue)chse)\b/$1yxe/gio;
+ s/\b(b)rillant\b/$1rilliant/gio;
+ s/\b(c)hannel\b/$1 eq 'c' ? 'kanal' : 'Kanal'/egio;
+ s/\b(c)hat\b/$1hatt/gio;
+ s/\b(c)ool\b/$1 eq 'c' ? 'kewl' : 'Kewl'/egio;
+ s/\b(d)(?:ä|ae)mlich\b/$1ähmlich/gio;
+ s/\b(d)etailliert\b/$1etailiert/gio;
+ s/\b(d)ilettantisch\b/$1illetantisch/gio;
+ s/\b(d)irekt\b/$1ireckt/gio;
+ s/\b(d)iskussion\b/$1isskusion/gio;
+ s/\b(d)istribution/$1ystrubution/gio;
+ s/\b(e)igentlich\b/$1igendlich/gio;
+ s/\b(e)inzige\b/$1inzigste/gio;
+ s/\b(e)nd/$1nt/gio;
+ s/\b(e)ntschuldigung\b/$1 eq 'e' ? 'sry' : 'Sry'/egio;
+ s/\b(f)ilm\b/$1 eq 'f' ? 'movie' : 'Movie'/egio;
+ s/\b(f)lachbettscanner\b/$1lachbrettscanner/gio;
+ s/\b(f)reu\b/$1roi/gio;
+ s/\b(g)alerie\b/$1allerie/gio;
+ s/\b(g)ay\b/$1hey/gio;
+ s/\b(g)ebaren\b/$1ebahren/gio;
+ s/\b(g)elatine\b/$1elantine/gio;
+ s/\b(g)eratewohl\b/$1eradewohl/gio;
+ s/\b(g)ibt es\b/$1ibbet/gio;
+ s/\bgra([dt])/$1 eq 'd' ? 'grat' : 'grad'/ego;
+ s/\bGra([dt])/$1 eq 'd' ? 'Grat' : 'Grad'/ego;
+ s/\b(h)(?:ä|ae)ltst\b/$1älst/gio;
+ s/\b(h)(?:ä|ae)sslich/$1äslich/gio;
+ s/\b(h)aneb(?:ü|ue)chen\b/$1ahneb$2chen/gio;
+ s/\b(i)mmobilie/$1mobilie/gio;
+ s/\b(i)nteressant\b/$1nterressant/gio;
+ s/\b(i)ntolerant\b/$1ntollerant/gio;
+ s/\b(i)rgend/$1rgent/gio;
+ s/\b(j)a\b/$1oh/gio;
+ s/\b(j)etzt\b/$1ez/gio;
+ s/\b(k)affee\b/$1affe/gio;
+ s/\b(k)aputt\b/$1aput/gio;
+ s/\b(k)arussell\b/$1arussel/gio;
+ s/\b(k)iste\b/$1 eq 'k' ? 'byxe' : 'Byxe'/egio;
+ s/\b(k)lempner\b/$1lemptner/gio;
+ s/\b(k)r(?:ä|ae)nker\b/$1ranker/gio;
+ s/\b(k)rise\b/$1riese/gio;
+ s/\b(l)etal\b/$1ethal/gio;
+ s/\b(l)eute\b/$1 eq 'l' ? 'ppl' : 'Ppl'/egio;
+ s/\b(l)ibyen\b/$1ybien/gio;
+ s/\b(l)izenz\b/$1izens/gio;
+ s/\b(l)oser\b/$1ooser/gio;
+ s/\b(l)ustig/$1ölig/gio;
+ s/\b(m)aschine\b/$1aschiene/gio;
+ s/\b(m)illennium\b/$1illenium/gio;
+ s/\b(m)iserabel\b/$1ieserabel/gio;
+ s/\b(m)it dem\b/$1im/gio;
+ s/\b(m)orgendlich\b/$1orgentlich/gio;
+ s/\b(n)(?:ä|ae)mlich\b/$1ähmlich/gio;
+ s/\b(n)ein\b/$1eh/gio;
+ s/\bnett\b/n1/gio;
+ s/\b(n)ewbie\b/$100b/gio;
+ s/\bnicht\b/int(rand(2)) ? 'net' : 'ned'/ego;
+ s/\bNicht\b/int(rand(2)) ? 'Net' : 'Ned'/ego;
+ s/\b(n)iveau/$1iwo/gio;
+ s/\bok(?:ay)?\b/K/gio;
+ s/\b(o)riginal\b/$1rginal/gio;
+ s/\b(p)aket\b/$1acket/gio;
+ s/\b(p)l(?:ö|oe)tzlich\b/$1lözlich/gio;
+ s/\b(p)ogrom\b/$1rogrom/gio;
+ s/\b(p)rogramm\b/$1roggie/gio;
+ s/\b(p)rogramme\b/$1roggies/gio;
+ s/\b(p)sychiater\b/$1sychater/gio;
+ s/\b(p)ubert(?:ä|ae)t\b/$1upertät/gio;
+ s/\b(q)uarz\b/$1uartz/gio;
+ s/\b(q)uery\b/$1uerry/gio;
+ s/\b(r)eferenz\b/$1efferenz/gio;
+ s/\b(r)eparatur\b/$1eperatur/gio;
+ s/\b(r)eply\b/$1eplay/gio;
+ s/\b(r)essource\b/$1esource/gio;
+ s/\b(r)(o)(t?fl)\b/$1 . ($2 eq 'o' ? 'ö' : 'Ö') . $3/egio;
+ s/\b(r)(o)(t?fl)(o)(l)\b/$1 . ($2 eq 'o' ? 'ö' : 'Ö') . $3 . ($4 eq 'o' ? 'ö' : 'Ö') . $5/egio;
+ s/\b(s)atellit\b/$1attelit/gio;
+ s/\b(s)cherz\b/$1chertz/gio;
+ s/\bsei([dt])\b/$1 eq 'd' ? 'seit' : 'seid'/ego;
+ s/\bSei([dt])\b/$1 eq 'd' ? 'Seit' : 'Seid'/ego;
+ s/\b(s)elig\b/$1eelig/gio;
+ s/\b(s)eparat\b/$1eperat/gio;
+ s/\b(s)eriosit(?:ä|ae)t\b/$1erösität/gio;
+ s/\b(s)onst\b/$1onnst/gio;
+ s/\b(s)orry\b/$1ry/gio;
+ s/\b(s)pelunke\b/$1ilunke/gio;
+ s/\b(s)piel\b/$1 eq 's' ? 'game' : 'Game'/egio;
+ s/\b(s)tabil\b/$1tabiel/gio;
+ s/\b(s)tandard\b/$1tandart/gio;
+ s/\b(s)tegreif\b/$1tehgreif/gio;
+ s/\b(s)ympathisch\b/$1ymphatisch/gio;
+ s/\b(s)yntax\b/$1ynthax/gio;
+ s/\b(t)era/$1erra/gio;
+ s/\b(t)oler/$1oller/gio;
+ s/\bto([td])/$1 eq 't' ? 'tod' : 'tot'/ego;
+ s/\bTo([td])/$1 eq 't' ? 'Tod' : 'Tot'/ego;
+ s/\b(u)ngef(?:ä|ae)hr\b/$1ngefär/gio;
+ s/\bviel gl(?:ü|ue)ck\b/GL/gio;
+ s/\b(v)ielleicht\b/$1ileicht/gio;
+ s/\b(v)oraus/$1orraus/gio;
+ s/\b(w)(?:ä|ae)re\b/$1ähre/gio;
+ s/\bwa(h)?r/$1 eq 'h' ? 'war' : 'wahr'/ego;
+ s/\bWa(h)?r/$1 eq 'h' ? 'War' : 'Wahr'/ego;
+ s/\b(w)as du\b/$1asu/gio;
+ s/\b(w)eil du\b/$1eilu/gio;
+ s/\bweis(s)?/$1 eq 's' ? 'weis' : 'weiss'/ego;
+ s/\bWeis(s)?/$1 eq 's' ? 'Weis' : 'Weiss'/ego;
+ s/\b(w)enn du\b/$1ennu/gio;
+ s/\b(w)ider/$1ieder/gio;
+ s/\b(w)ieso\b/$1iso/gio;
+ s/\b(z)iemlich\b/$1iehmlich/gio;
+ s/\b(z)umindest\b/$1umindestens/gio;
+
+ tr/üÜ/yY/;
+ s/ei(?:ss?|ß)e?/ice/go;
+ s/eife?/ive/go;
+
+ if(return_option('moron', 'level') >= 1) {
+ s/\b(u)nd\b/$1nt/gio;
+ s/\b(h)at\b/$1att/gio;
+ s/\b(n)ur\b/$1uhr/gio;
+ s/\b(v)er(\w+)/$1 eq 'V' ? "Fa$2" : "fa$2"/egio;
+ s/\b([[:alpha:]]+[b-np-tv-z])er\b/${1}a/go;
+ s/\b([[:alpha:]]+)ck/${1}q/go;
+
+ s/\b([fv])(?=[[:alpha:]]{2,})/
+ if (rand(10) <= 4) {
+ if ($1 eq 'f') {
+ 'v'
+ }
+ else {
+ 'f'
+ }
+ } else {
+ $1
+ }
+ /egox;
+ s/\b([FV])(?=[[:alpha:]]{2,})/
+ if (rand(10) <= 4) {
+ if ($1 eq 'F') {
+ 'V'
+ }
+ else {
+ 'F'
+ }
+ } else {
+ $1
+ }
+ /egox;
+ s#\b([[:alpha:]]{2,})([td])\b#
+ my $begin = $1;
+ my $end = $2;
+ if (rand(10) <= 4) {
+ if ($end eq 't' && $begin !~ /t$/) {
+ "${begin}d"
+ } elsif ($end eq 'd' && $begin !~ /d$/) {
+ "${begin}t"
+ } else {
+ "${begin}${end}"
+ }
+ } else {
+ "${begin}${end}"
+ }
+ #egox;
+ s/\b([[:alpha:]]{2,})ie/
+ if (rand(10) <= 4) {
+ "$1i"
+ } else {
+ "$1ie"
+ }
+ /egox;
+ }
+ }
+
+ $data = $_;
+
+ ################################################################################
+ # Swap characters with characters near at the keyboard
+ ################################################################################
+
+ my %mark;
+ my %chars;
+ if ($option{dau_language} eq 'de') {
+ %chars = (
+ 'a' => [ 's' ],
+ 'b' => [ 'v', 'n' ],
+ 'c' => [ 'x', 'v' ],
+ 'd' => [ 's', 'f' ],
+ 'e' => [ 'w', 'r' ],
+ 'f' => [ 'd', 'g' ],
+ 'g' => [ 'f', 'h' ],
+ 'h' => [ 'g', 'j' ],
+ 'i' => [ 'u', 'o' ],
+ 'j' => [ 'h', 'k' ],
+ 'k' => [ 'j', 'l' ],
+ 'l' => [ 'k', 'ö' ],
+ 'm' => [ 'n' ],
+ 'n' => [ 'b', 'm' ],
+ 'o' => [ 'i', 'p' ],
+ 'p' => [ 'o', 'ü' ],
+ 'q' => [ 'w' ],
+ 'r' => [ 'e', 't' ],
+ 's' => [ 'a', 'd' ],
+ 't' => [ 'r', 'z' ],
+ 'u' => [ 'z', 'i' ],
+ 'v' => [ 'c', 'b' ],
+ 'w' => [ 'q', 'e' ],
+ 'x' => [ 'y', 'c' ],
+ 'y' => [ 'x' ],
+ 'z' => [ 't', 'u' ],
+ );
+ } else {
+ %chars = (
+ 'a' => [ 's' ],
+ 'b' => [ 'v', 'n' ],
+ 'c' => [ 'x', 'v' ],
+ 'd' => [ 's', 'f' ],
+ 'e' => [ 'w', 'r' ],
+ 'f' => [ 'd', 'g' ],
+ 'g' => [ 'f', 'h' ],
+ 'h' => [ 'g', 'j' ],
+ 'i' => [ 'u', 'o' ],
+ 'j' => [ 'h', 'k' ],
+ 'k' => [ 'j', 'l' ],
+ 'l' => [ 'k', 'ö' ],
+ 'm' => [ 'n' ],
+ 'n' => [ 'b', 'm' ],
+ 'o' => [ 'i', 'p' ],
+ 'p' => [ 'o', 'ü' ],
+ 'q' => [ 'w' ],
+ 'r' => [ 'e', 't' ],
+ 's' => [ 'a', 'd' ],
+ 't' => [ 'r', 'z' ],
+ 'u' => [ 'z', 'i' ],
+ 'v' => [ 'c', 'b' ],
+ 'w' => [ 'q', 'e' ],
+ 'x' => [ 'y', 'c' ],
+ 'y' => [ 't', 'u' ],
+ 'z' => [ 'x' ],
+ );
+ }
+
+ # Do not replace one character twice
+ # Therefore every replace-position will be marked
+
+ unless (lc(return_option('moron', 'typo')) eq 'off') {
+ for (0 .. length($data)) {
+ $mark{$_} = 0;
+ }
+
+ for (0 .. rand(length($data))/20) {
+ my $pos = int(rand(length($data)));
+ pos $data = $pos;
+ unless ($mark{$pos} == 1) {
+ no locale;
+ if ($data =~ /\G([A-Za-z])/g) {
+ my $matched = $1;
+ my $replacement;
+ if ($matched eq lc($matched)) {
+ $replacement = $chars{$matched}[int(rand(@{ $chars{$matched} }))];
+ } else {
+ $replacement = uc($chars{$matched}[int(rand(@{ $chars{$matched} }))]);
+ }
+ if ($replacement !~ /^\s*$/) {
+ substr($data, $pos, 1, $replacement);
+ $mark{$pos} = 1;
+ }
+ }
+ }
+ }
+ }
+
+ ################################################################################
+ # Mix in some typos (swapping characters)
+ ################################################################################
+
+ unless (lc(return_option('moron', 'typo')) eq 'off') {
+ foreach my $word (split /([\s\n])/, $data) {
+ if ((rand(100) <= 20) && length($word) > 1) {
+ my $position_swap = int(rand(length($word)));
+ if ($position_swap == 0) {
+ $position_swap = 1;
+ } elsif ($position_swap == length($word)) {
+ $position_swap = length($word) - 1;
+ }
+ if (substr($word, $position_swap - 1, 1) eq uc(substr($word, $position_swap - 1, 1)) &&
+ substr($word, $position_swap, 1) eq lc(substr($word, $position_swap, 1)))
+ {
+ (substr($word, $position_swap, 1), substr($word, $position_swap - 1, 1)) =
+ (lc(substr($word, $position_swap - 1, 1)), uc(substr($word, $position_swap, 1)));
+ } else {
+ (substr($word, $position_swap, 1), substr($word, $position_swap - 1, 1)) =
+ (substr($word, $position_swap - 1, 1), substr($word, $position_swap, 1));
+ }
+ }
+ $output .= $word;
+ }
+ } else {
+ $output = $_;
+ }
+
+ ################################################################################
+ # plenk
+ ################################################################################
+
+ $output =~ s/(\w+)([,;.:?!]+)(\s+|$)/
+ if (rand(10) <= 8 || $3 eq '') {
+ "$1 $2$3"
+ } else {
+ "$1$2"
+ }
+ /egox;
+
+ ################################################################################
+ # default behaviour: uppercase text
+ ################################################################################
+
+ $output = uc($output) unless (return_option('moron', 'uppercase') eq 'off');
+
+ ################################################################################
+ # do something at EOL
+ ################################################################################
+
+ if ($option_eol_style ne 'nothing') {
+ my $random = int(rand(100));
+
+ $output .= ' ' unless ($output =~ /^\s*$/);
+
+ # !!!!!!??????????!!!!!!!!!!11111
+
+ if ($random <= 70 || $lastchar eq '!') {
+ my @punct = qw(? !);
+ $output .= $punct[rand(@punct)] x int(rand(5))
+ for (1..15);
+
+ if ($lastchar eq '?') {
+ $output .= '?' x (int(rand(4))+1);
+ } elsif ($lastchar eq '!') {
+ $output .= '!' x (int(rand(4))+1);
+ }
+
+ if ($output =~ /\?$/) {
+ if ($option{dau_language} eq 'de') {
+ $output .= "ß" x int(rand(10));
+ } else {
+ $output .= "/" x int(rand(10));
+ }
+ } elsif ($output =~ /!$/) {
+ $output .= "1" x int(rand(10));
+ }
+ }
+
+ # ?¿?
+
+ elsif ($random <= 85) {
+ $output .= '?¿?';
+ }
+
+ # "=\n?"
+
+ else {
+ $output .= "=\n?";
+ }
+ }
+
+ return $output;
+}
+
+sub switch_nothing {
+ my $data = shift;
+
+ return $data;
+}
+
+sub switch_parse_special {
+ my ($text, $channel) = @_;
+
+ local $" = return_option('parse_special', 'list_delimiter', $option{dau_parse_special_list_delimiter});
+
+ # Build nick array with every nick in channel and
+ # opnick array with every op in the channel
+
+ my @nicks = ();
+ my @opnicks = ();
+ if (defined($channel) && $channel && $channel->{type} eq 'CHANNEL') {
+ foreach my $nick ($channel->nicks()) {
+ next if ($channel->{server}->{nick} eq $nick->{nick});
+ push(@nicks, $nick->{nick});
+ push(@opnicks, $nick->{nick}) if ($nick->{op});
+ }
+ }
+ @nicks = sort { lc($a) cmp lc($b) } @nicks;
+ @opnicks = sort { lc($a) cmp lc($b) } @opnicks;
+
+ # Substitution: \n to a real newline
+
+ $text =~ s/(?<![\\])\\n/\n/g;
+
+ # Substitution: @nicks to all nicks of channel
+
+ $text =~ s/(?<![\\])\@nicks/@nicks/gc;
+
+ # Substitution: @opnicks to all nicks of channel
+
+ $text =~ s/(?<![\\])\@opnicks/@opnicks/gc;
+
+ # Substitution: $nick1..$nickn
+
+ while ($text =~ /(?<![\\])\$nick(\d+)/g) {
+ my $substitution = $nicks[rand(@nicks)];
+ $text =~ s/(?<![\\])\$nick$1([^\d]|$)/${substitution}$1/g;
+ @nicks = grep { $_ ne $substitution } @nicks;
+ last if (@nicks == 0);
+ }
+
+ # Substitution: $opnick1..$opnickn
+
+ while ($text =~ /(?<![\\])\$opnick(\d+)/g) {
+ my $substitution = $opnicks[rand(@opnicks)];
+ $text =~ s/(?<![\\])\$opnick$1([^\d]|$)/${substitution}$1/g;
+ @opnicks = grep { $_ ne $substitution } @opnicks;
+ last if (@opnicks == 0);
+ }
+
+ # Substitution: $?{ code }
+
+ my $np; # (nested pattern)
+ $np = qr{
+ {
+ (?:
+ (?> [^{}]+ ) # Non-capture group w/o backtracking
+ |
+ (??{ $np }) # Group with matching parens
+ )*
+ }
+ }x;
+
+ while ($text =~ /(?<![\\])\$\?($np)/g) {
+ {
+ no strict;
+ my $replacement = eval $1;
+ if ($@) {
+ print_err('Invalid code used in construct $?{ code }. Details:');
+ print_err($@);
+ return;
+ } else {
+ chomp($replacement);
+ $text =~ s/(?<![\\])\$\?($np)/$replacement/;
+ }
+ }
+ }
+
+ # Substitution: irssi's special variables
+
+ if ((defined($channel) && $channel &&
+ ($channel->{type} eq 'CHANNEL' || $channel->{type} eq 'QUERY')) &&
+ !(lc(return_option('parse_special', 'irssi_variables')) eq 'off'))
+ {
+ $text = $channel->parse_special($text);
+ }
+
+ return $text;
+}
+
+sub switch_reverse {
+ my $data = shift;
+
+ $data = reverse($data);
+
+ return $data;
+}
+
+sub switch_stutter {
+ my $data = shift;
+ my $output;
+ my @words = qw(eeeh oeeeh aeeeh);
+
+ foreach (split / (?=\w+\b)/, $data) {
+ if (rand(100) < 20) {
+ $output .= ' ' . $words[rand(@words)] . ", $_";
+ } else {
+ $output .= ' ' . $_;
+ }
+ }
+
+ $output =~ s/\s*,\s+\@/ @/g;
+
+ for (1 .. rand(length($output)/5)) {
+ pos $output = rand(length($output));
+ $output =~ s/\G ([[:alpha:]]+)\b/ $1, $1/;
+ }
+ for (1 .. rand(length($output)/10)) {
+ pos $output = rand(length($output));
+ $output =~ s/\G([[:alpha:]])/$1 . ($1 x rand(3))/e;
+ }
+
+ $output =~ s/^\s+//;
+
+ return $output;
+}
+
+sub switch_substitute {
+ $_ = shift;
+
+ my $file = "$option{dau_files_root_directory}/$option{dau_files_substitute}";
+
+ if (-e $file && -r $file) {
+ my $return = do $file;
+
+ if ($@) {
+ print_err("parsing $file failed: $@");
+ }
+ unless (defined($return)) {
+ print_err("'do $file' failed");
+ }
+ }
+
+ return $_;
+}
+
+sub switch_underline {
+ my $data = shift;
+
+ $data = "\037$data\037";
+
+ return $data;
+}
+
+sub switch_uppercase {
+ my $data = shift;
+
+ $data = uc($data);
+
+ return $data;
+}
+
+sub switch_words {
+ my $data = shift;
+ my $output;
+ my @numbers;
+
+ if ($option{dau_words_range} =~ /^([1-9])-([1-9])$/) {
+ my $x = $1;
+ my $y = $2;
+ unless ($x <= $y) {
+ print_err('Invalid value for setting dau_words_range.');
+ return;
+ }
+ if ($x == $y) {
+ push(@numbers, $x);
+ } elsif ($x < $y) {
+ for (my $i = $x; $i <= $y; $i++) {
+ push(@numbers, $i);
+ }
+ }
+ } else {
+ print_err('Invalid value for dau_words_range.');
+ return;
+ }
+ my $random = $numbers[rand(@numbers)];
+ while ($data =~ /((?:.*?(?:\s+|$)){1,$random})/g) {
+ $output .= "$1\n"
+ unless (length($1) == 0);
+ $random = $numbers[rand(@numbers)];
+ }
+
+ $output =~ s/\s*$//;
+
+ return $output;
+}
+
+################################################################################
+# Subroutines (signals)
+################################################################################
+
+sub signal_channel_destroyed {
+ my ($channel) = @_;
+
+ my $channel_name = $channel->{name};
+ my $network_name = $channel->{server}->{tag};
+
+ $daumode{channels_in}{$network_name}{$channel_name} = 0;
+ $daumode{channels_out}{$network_name}{$channel_name} = 0;
+ $daumode{channels_in_modes}{$network_name}{$channel_name} = '';
+ $daumode{channels_out_modes}{$network_name}{$channel_name} = '';
+}
+
+sub signal_channel_joined {
+ my ($channel) = @_;
+
+ # Resume babbles
+
+ if (defined($babble{timer_writing})) {
+ if ($babble{channel}->{name} eq $channel->{name} &&
+ $babble{channel}->{server}->{tag} eq $channel->{server}->{tag})
+ {
+ $channel->print('%9dau.pl:%9 Continuing babble...');
+ timer_babble_writing();
+ }
+ }
+
+ # Automatically set daumode
+
+ daumode_channels();
+}
+
+sub signal_command_msg {
+ my ($args, $server, $witem) = @_;
+
+ $args =~ /^(?:-\S+\s)?(?:\S*)\s(.*)/;
+ my $data = $1;
+
+ $command_in .= "$data\n";
+
+ Irssi::signal_stop();
+}
+
+sub signal_complete_word {
+ my ($list, $window, $word, $linestart, $want_space) = @_;
+
+ # Parsing the commandline for dau.pl is relatively complicated.
+ # TAB completion depends on commandline parsing in dau.pl.
+ # Script autors looking for a simple example for irssi's
+ # TAB completion are wrong here.
+
+ my $server = Irssi::active_server();
+ my $channel = $window->{active};
+ my @switches_combo = map { $_ = "--$_" } keys %{ $switches{combo} };
+ my @switches_nocombo = map { $_ = "--$_" } keys %{ $switches{nocombo} };
+ my @nicks = ();
+
+ # Only complete when the commandline starts with '${k}dau'.
+ # If not, let irssi do the work
+
+ return unless ($linestart =~ /^\Q${k}\Edau/i);
+
+ # Remove everything syntactically correct thing of $linestart.
+ # If there is anything else but whitespace at the end of
+ # commandline parsing, we have an syntax error.
+ # If we have a syntax error, complete only nicks.
+
+ $linestart =~ s/^\Q${k}\Edau ?//i;
+
+ # Generate list of nicks in current channel for later use
+
+ if (defined($channel->{type}) && $channel->{type} eq 'CHANNEL') {
+ foreach my $nick ($channel->nicks()) {
+ if ($nick->{nick} =~ /^\Q$word\E/i &&
+ $window->{active_server}->{nick} ne $nick->{nick})
+ {
+ push(@nicks, $nick->{nick});
+ }
+ }
+ }
+
+ # Variables
+
+ my $combo = 0; # Boolean: True if last switch was one of keys %{ $switches{combo} }
+ my $syntax_error = 0; # Boolean: True if syntax error found
+ my $counter = 0; # Integer: Counts first level options
+ my $first_level_option = ''; # String: Last first level option
+ my $second_level_option = ''; # String: Last second level option
+ my $third_level_option = 0; # Boolean: True if found a third level option
+
+ # Parsing commandline now. Set variables accordingly.
+
+ OUTER: while ($linestart =~ /^--(\w+) ?/g) {
+
+ $second_level_option = '';
+ $third_level_option = 0;
+
+ # Found a first level option (combo)
+
+ if (ref($switches{combo}{$1}{'sub'})) {
+ $first_level_option = $1;
+ $combo = 1;
+ }
+
+ # Found a first level option (nocombo)
+
+ elsif (ref($switches{nocombo}{$1}{'sub'}) && $counter == 0) {
+ $first_level_option = $1;
+ $combo = 0;
+ }
+
+ # Not a first level option => Syntax error
+
+ else {
+ $syntax_error = 1;
+ last OUTER;
+ }
+
+ # Syntactically correct => remove it
+
+ $linestart =~ s/^--\w+ ?//;
+
+ # Checkout if there are Second- or third level options
+
+ INNER: while ($linestart =~ /^-(\w+)(?: ('.*?(?<![\\])'|\S+))? ?/g) {
+
+ my $second_level = $1;
+ my $third_level = $2 || '';
+
+ $third_level =~ s/^'//;
+ $third_level =~ s/'$//;
+ $third_level =~ s/\\'/'/g;
+
+ # Do the same for combo and nocombo-options. They have to be
+ # handled separately anyway.
+
+ # combo...
+
+ if ($combo) {
+
+ # Found a second level option
+
+ if ($switches{combo}{$first_level_option}{$second_level}) {
+ $second_level_option = $second_level;
+ }
+
+ # Not a second level option => Syntax error
+
+ else {
+ $syntax_error = 1;
+ last OUTER;
+ }
+
+ # Syntactically correct => remove it
+
+ $linestart =~ s/^-\w+//;
+
+ # Found something in the regexp of the INNER-while-loop-condition,
+ # which is perhaps a third level option
+
+ if ($third_level) {
+
+ # Found a third level option
+
+ if ($switches{combo}{$first_level_option}{$second_level_option}{$third_level} ||
+ $switches{combo}{$first_level_option}{$second_level_option}{'*'})
+ {
+ $third_level_option = 1;
+
+ # Syntactically correct => remove it
+
+ $linestart =~ s/^(?: ('.*?(?<![\\])'|\S+))? ?//;
+ }
+
+ # Not a third level option => Syntax error
+
+ else {
+ $syntax_error = 1;
+ last OUTER;
+ }
+
+ # Nothing found which comes into question for a third level option.
+ # The commandline has to be empty now (remember: everything
+ # syntactically correct has been removed) or we have a syntax error.
+
+ } else {
+
+ # Empty! Later we will complete to third level options
+
+ if ($linestart =~ /^\s*$/) {
+ $third_level_option = 0;
+ }
+
+ # Not empty => Syntax error
+
+ else {
+ $syntax_error = 1;
+ last OUTER;
+ }
+ }
+
+ # nocombo...
+
+ } else {
+
+ # Found a second level option
+
+ if ($switches{nocombo}{$first_level_option}{$second_level}) {
+ $second_level_option = $second_level;
+ }
+
+ # Not a second level option => Syntax error
+
+ else {
+ $syntax_error = 1;
+ last OUTER;
+ }
+
+ # Syntactically correct => remove it
+
+ $linestart =~ s/^-\w+//;
+
+ # Found something in the regexp of the INNER while loop condition,
+ # which is perhaps a third level option
+
+ if ($third_level) {
+
+ # Found a third level option
+
+ if ($switches{nocombo}{$first_level_option}{$second_level_option}{$third_level} ||
+ $switches{nocombo}{$first_level_option}{$second_level_option}{'*'})
+ {
+ $third_level_option = 1;
+
+ # Syntactically correct => remove it
+
+ $linestart =~ s/^(?: ('.*?(?<![\\])'|\S+))? ?//;
+ }
+
+ # Not a third level option => Syntax error
+
+ else {
+ $syntax_error = 1;
+ last OUTER;
+ }
+
+ # Nothing found which comes into question for a third level option.
+ # The commandline has to be empty now (remember: everything
+ # syntactically correct has been removed) or we have a syntax error.
+
+ } else {
+
+ # Empty! Later we will complete to third level options
+
+ if ($linestart =~ /^\s*$/) {
+ $third_level_option = 0;
+ }
+
+ # Not empty => Syntax error
+
+ else {
+ $syntax_error = 1;
+ last OUTER;
+ }
+ }
+ }
+ }
+ } continue {
+ $counter++;
+ }
+
+ # End of commandline-parsing.
+ # Everything syntactically correct removed.
+ # If commandline is not empty now, we have a syntax error.
+
+ if ($linestart !~ /^\s*$/) {
+ $syntax_error = 1;
+ }
+
+ # Do the TAB completion
+
+ @$list = ();
+
+ if ($syntax_error) {
+ foreach my $x (sort @nicks) {
+ if($x =~ /^$word/i) {
+ push(@$list, $x);
+ }
+ }
+ }
+ elsif ($counter == 0) {
+ foreach my $x ((sort(@switches_combo, @switches_nocombo), sort(@nicks))) {
+ if($x =~ /^$word/i) {
+ push(@$list, $x);
+ }
+ }
+ }
+ elsif (($combo && $first_level_option && $second_level_option && $third_level_option) ||
+ ($combo && $first_level_option && !$second_level_option && !$third_level_option))
+ {
+ my @switches_second_level = grep !/^-sub$/, map { $_ = "-$_" }
+ keys %{ $switches{combo}{$first_level_option} };
+
+ foreach my $x ((sort(@switches_second_level), sort(@switches_combo), sort(@nicks))) {
+ if($x =~ /^$word/i) {
+ push(@$list, $x);
+ }
+ }
+ }
+ elsif ((!$combo && $counter == 1 && $first_level_option && $second_level_option && $third_level_option) ||
+ (!$combo && $counter == 1 && $first_level_option && !$second_level_option && !$third_level_option))
+ {
+ my @switches_second_level = grep !/^-sub$/, map { $_ = "-$_" }
+ keys %{ $switches{nocombo}{$first_level_option} };
+
+ foreach my $x (sort(@switches_second_level)) {
+ if($x =~ /^$word/i) {
+ push(@$list, $x);
+ }
+ }
+ }
+ elsif ($combo && $first_level_option && $second_level_option && !$third_level_option) {
+ my @switches_third_level = grep !/^\*$/,
+ keys %{ $switches{combo}{$first_level_option}{$second_level_option} };
+
+ foreach my $x (sort(@switches_third_level)) {
+ if($x =~ /^$word/i) {
+ push(@$list, $x);
+ }
+ }
+ }
+ elsif (!$combo && $counter == 1 && $first_level_option && $second_level_option && !$third_level_option) {
+ my @switches_third_level = grep !/^\*$/,
+ keys %{ $switches{nocombo}{$first_level_option}{$second_level_option} };
+
+ foreach my $x ((sort(@switches_third_level), sort(@nicks))) {
+ if($x =~ /^$word/i) {
+ push(@$list, $x);
+ }
+ }
+ }
+
+ Irssi::signal_stop();
+}
+
+sub signal_event_404 {
+ my ($server, $message, $network_name) = @_;
+
+ if ($message =~ /^(?:\S+) (\S+) :Cannot send to channel$/) {
+ my $channel_name = $1;
+
+ if ($server->{tag} eq $babble{channel}->{server}->{tag} &&
+ $babble{channel}->{name} eq $channel_name &&
+ defined($babble{timer_writing}))
+ {
+ Irssi::timeout_remove($babble{timer_writing});
+ undef($babble{timer_writing});
+ print_out("%9dau.pl:%9 Could not send message to $babble{channel}->{name}/$babble{channel}->{server}->{tag}. Cancelling babble.");
+ return;
+ }
+ }
+
+ if ($message =~ /^(?:\S+) (\S+) :(.*)/) {
+ Irssi::print("$1 $2");
+ } else {
+ Irssi::print($message);
+ }
+}
+
+sub signal_event_privmsg {
+ my ($server, $data, $nick, $hostmask) = @_;
+ my ($channel_name, $text) = split / :/, $data, 2;
+ my $channel_rec = $server->channel_find($channel_name);
+ $channel_name = lc($channel_name);
+ my $server_name = lc($server->{tag});
+ my %lookup;
+
+ while ($option{dau_remote_channellist} =~ /\s*([^\/]+)\/([^,]+)\s*,?/g) {
+ my $channel = $1;
+ $channel = lc($channel);
+ my $ircnet = $2;
+ $ircnet = lc($ircnet);
+ $lookup{$ircnet}{$channel} = 1;
+ }
+ if (lc($option{dau_remote_channelpolicy}) eq 'allow') {
+ return if ($lookup{$server_name}{$channel_name});
+ } elsif (lc($option{dau_remote_channelpolicy}) eq 'deny') {
+ return unless ($lookup{$server_name}{$channel_name});
+ } else {
+ return;
+ }
+
+ # Remove formatting so dau.pl can reply to a colored, underlined, ...
+ # question
+
+ $text =~ s/\003\d?\d?(?:,\d?\d?)?|\002|\006|\007|\016|\01f|\037//g;
+
+ my $regexp = switch_parse_special($option{dau_remote_question_regexp}, $channel_rec);
+ if ($text =~ /$regexp/) {
+ my $reply = return_random_list_item($option{dau_remote_question_reply});
+ $reply =~ s/(?<![\\])\$nick/$nick/g;
+ $reply = parse_text($reply, $channel_rec);
+
+ output_text($server, $channel_name, $reply);
+ }
+}
+
+sub signal_nick_mode_changed {
+ my ($channel, $nick, $setby, $mode, $type) = @_;
+ my ($reply, %lookup);
+ my $channel_name = lc($channel->{name});
+ my $network_name = lc($channel->{server}->{tag});
+ my $op = $nick_mode{$network_name}{$channel_name}{op}; # mode before nick change
+ my $voice = $nick_mode{$network_name}{$channel_name}{voice}; # mode before nick change
+
+ return if ($channel->{server}->{nick} ne $nick->{nick});
+ if ($nick->{nick} eq $setby || $setby eq 'irc.psychoid.net') {
+ build_nick_mode_struct();
+ return;
+ }
+
+ # Only act in channels where the user wants dau.pl to act
+
+ while ($option{dau_remote_channellist} =~ /\s*([^\/]+)\/([^,]+)\s*,?/g) {
+ my $channel = $1;
+ $channel = lc($channel);
+ my $ircnet = $2;
+ $ircnet = lc($ircnet);
+ $lookup{$ircnet}{$channel} = 1;
+ }
+ if (lc($option{dau_remote_channelpolicy}) eq 'allow') {
+ if ($lookup{$network_name}{$channel_name}) {
+ build_nick_mode_struct();
+ return;
+ }
+ } elsif (lc($option{dau_remote_channelpolicy}) eq 'deny') {
+ unless ($lookup{$network_name}{$channel_name}) {
+ build_nick_mode_struct();
+ return;
+ }
+ } else {
+ build_nick_mode_struct();
+ return;
+ }
+
+ # Now we are in the right channel
+
+ if ($option{dau_remote_permissions} =~ /^[01]1[01][01][01][01]$/) {
+ if ($mode eq '+' && $type eq '+' && (!$voice && !$op)) {
+ $reply = return_random_list_item($option{dau_remote_voice_reply});
+ $reply =~ s/(?<![\\])\$nick/$setby/g;
+ $reply = parse_text($reply, $channel);
+ }
+ }
+ if ($option{dau_remote_permissions} =~ /^[01][01]1[01][01][01]$/) {
+ if ($mode eq '@' && $type eq '+' && !$op) {
+ $reply = return_random_list_item($option{dau_remote_op_reply});
+ $reply =~ s/(?<![\\])\$nick/$setby/g;
+ $reply = parse_text($reply, $channel);
+ }
+ }
+ if ($option{dau_remote_permissions} =~ /^[01][01][01]1[01][01]$/) {
+ if ($mode eq '+' && $type eq '-' && ($voice && !$op)) {
+ $reply = return_random_list_item($option{dau_remote_devoice_reply});
+ $reply =~ s/(?<![\\])\$nick/$setby/g;
+ $reply = parse_text($reply, $channel);
+ }
+ }
+ if ($option{dau_remote_permissions} =~ /^[01][01][01][01]1[01]$/) {
+ if ($mode eq '@' && $type eq '-' && $op) {
+ $reply = return_random_list_item($option{dau_remote_deop_reply});
+ $reply =~ s/(?<![\\])\$nick/$setby/g;
+ $reply = parse_text($reply, $channel);
+ }
+ }
+
+ # rebuild nick mode struct and print out the reply
+
+ build_nick_mode_struct();
+ output_text($channel, $channel->{name}, $reply);
+}
+
+sub signal_send_text {
+ my ($data, $server, $witem) = @_;
+ my $output;
+
+ return unless (defined($server) && $server && $server->{connected});
+ return unless (defined($witem) && $witem &&
+ ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY'));
+
+ if ($daumode{channels_out}{$server->{tag}}{$witem->{name}} == 1) {
+ if ($daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} eq '') {
+ $output = parse_text($daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} . $data, $witem);
+ } else {
+ $output = parse_text($daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} . ' ' . $data, $witem);
+ }
+
+ output_text($witem, $witem->{name}, $output);
+
+ Irssi::signal_stop();
+ }
+}
+
+sub signal_setup_changed {
+ set_settings();
+
+ # setting changed/added => change/add it here
+
+ # setting cmdchars
+
+ $k = Irssi::parse_special('$k');
+
+ # babble history
+
+ if (defined($babble{history}) && ref($babble{history}) eq 'ARRAY') {
+ my @history;
+ my $i = 1;
+ foreach (@{ $babble{history} } ) {
+ if ($i++ <= $option{dau_babble_history_size}) {
+ push(@history, $_);
+ }
+ }
+ @{ $babble{history} } = @history;
+ }
+
+ # setting dau_cowsay_cowpath
+
+ cowsay_cowlist($option{dau_cowsay_cowpath});
+
+ # setting dau_figlet_fontpath
+
+ figlet_fontlist($option{dau_figlet_fontpath});
+
+ # setting dau_daumode_channels
+
+ daumode_channels();
+
+ # setting dau_statusbar_daumode_hide_when_off
+
+ Irssi::statusbar_items_redraw('daumode');
+
+ # timer for the babble feature
+
+ timer_remote_babble_reset();
+
+ # signal handling
+
+ signal_handling();
+}
+
+sub signals_daumode_in {
+ my ($server, $data, $nick, $hostmask, $target) = @_;
+ my $channel_rec = $server->channel_find($target);
+ my $i_channel = $daumode{channels_in}{$server->{tag}}{$target};
+ my $i_modes = $daumode{channels_in_modes}{$server->{tag}}{$target};
+ my $modified_msg;
+
+ return unless (defined($server) && $server && $server->{connected});
+
+ # Not one of the channels where daumode for incoming messages is turned on.
+ # In those channels print out the message as it is and leave the subroutine
+
+ if (!$i_channel) {
+ return;
+ }
+
+ # Evil Hack?
+ # I had to dauify every incoming messages. Using &signal_continue was
+ # not possible because --words f.e. generates output over multiple lines. So I
+ # had to create multiple messages using &signal_emit. Those just created
+ # messages shouldn't be dauified again when entering this subroutine. I
+ # couldn't prevent irssi from entering this subroutine again after
+ # dauifying the text so the messages had to be 'marked'. Marked
+ # messages will not be dauified again. I think \x02 at the beginning of the
+ # message is ok for that.
+
+ if ($data =~ s/^\x02//) {
+ Irssi::signal_continue($server, $data, $nick, $hostmask, $target);
+ } else {
+ if ($i_modes ne '') {
+ $modified_msg = parse_text($i_modes . ' ' . $data, $channel_rec);
+ } else {
+ $modified_msg = parse_text($data, $channel_rec);
+ }
+
+ if ($modified_msg =~ /\n/) {
+ for my $line (split /\n/, $modified_msg) {
+ Irssi::signal_emit(Irssi::signal_get_emitted(), $server, "\x02$line", $nick, $hostmask, $target);
+ Irssi::signal_stop();
+ }
+ } else {
+ Irssi::signal_emit(Irssi::signal_get_emitted(), $server, "\x02$modified_msg", $nick, $hostmask, $target);
+ Irssi::signal_stop();
+ }
+ }
+}
+
+################################################################################
+# Subroutines (statusbar)
+################################################################################
+
+sub statusbar_daumode {
+ my ($item, $get_size_only) = @_;
+ my ($status_in, $status_out, $modes_in, $modes_out);
+ my $server = Irssi::active_server();
+ my $witem = Irssi::active_win()->{active};
+ my $theme = Irssi::current_theme();
+ my $format = $theme->format_expand('{sb_daumode}');
+
+ if ($witem && ref($witem) &&
+ $server && ref($server) &&
+ ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY'))
+ {
+ if (defined($daumode{channels_in}{$server->{tag}}{$witem->{name}}) &&
+ $daumode{channels_in}{$server->{tag}}{$witem->{name}} == 1)
+ {
+ $status_in = 'ON';
+ } else {
+ $status_in = 'OFF';
+ }
+
+ if (defined($daumode{channels_out}{$server->{tag}}{$witem->{name}}) &&
+ $daumode{channels_out}{$server->{tag}}{$witem->{name}} == 1)
+ {
+ $status_out = 'ON';
+ } else {
+ $status_out = 'OFF';
+ }
+
+ # Hide statusbaritem if setting dau_statusbar_daumode_hide_when_off
+ # is turned on and daumode is turned off
+
+ if ($status_in eq 'OFF' && $status_out eq 'OFF' && $option{dau_statusbar_daumode_hide_when_off}) {
+ $item->{min_size} = $item->{max_size} = 0;
+ return;
+ }
+
+ if ($status_in eq 'ON') {
+ $modes_in = $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} || $option{dau_standard_options};
+ } else {
+ $modes_in = '';
+ }
+ if ($status_out eq 'ON') {
+ $modes_out = $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} || $option{dau_standard_options};
+ } else {
+ $modes_out = '';
+ }
+
+ if ($format) {
+ $format = $theme->format_expand("{sb_daumode $status_out $modes_out $status_in $modes_in}");
+ } else {
+ if ($status_in eq 'OFF' && $status_out eq 'OFF') {
+ $format = $theme->format_expand("{sb daumode: <- $status_in | -> $status_out}");
+ }
+ elsif ($status_in eq 'OFF' && $status_out eq 'ON') {
+ $format = $theme->format_expand("{sb daumode: <- $status_in | -> $status_out ($modes_out)}");
+ }
+ elsif ($status_in eq 'ON' && $status_out eq 'OFF') {
+ $format = $theme->format_expand("{sb daumode: <- $status_in ($modes_in) | -> $status_out}");
+ }
+ elsif ($status_in eq 'ON' && $status_out eq 'ON') {
+ $format = $theme->format_expand("{sb daumode: <- $status_in ($modes_in) | -> $status_out ($modes_out)}");
+ }
+ }
+ } else {
+ $item->{min_size} = $item->{max_size} = 0;
+ return;
+ }
+
+ $item->default_handler($get_size_only, $format, '', 1);
+}
+
+################################################################################
+# Subroutines (timer)
+################################################################################
+
+# for the babble remote feature
+
+sub timer_away_reminder {
+ my $id = shift;
+ $id =~ m{^([^/]+)/(.+)};
+ my $channel = $1;
+ my $network = $2;
+
+ my $server_rec = Irssi::server_find_tag($network);
+
+ unless (defined($server_rec) && $server_rec) {
+ return;
+ }
+
+ my $channel_rec = $server_rec->channel_find($channel);
+
+ unless (defined($channel_rec) && $channel_rec &&
+ ($channel_rec->{type} eq 'CHANNEL' || $channel_rec->{type} eq 'QUERY'))
+ {
+ return;
+ }
+
+ ################################################################################
+ # Open file
+ ################################################################################
+
+ my $file = "$option{dau_files_root_directory}/$option{dau_files_away}";
+ my @file;
+ unless (tie(@file, 'Tie::File', $file)) {
+ print_err("Cannot tie $file!");
+ return;
+ }
+
+ ################################################################################
+ # Go through file
+ ################################################################################
+
+ # Format:
+ # channel | network | time | options | reminder | interval | reason
+
+ my ($time, $options, $reminder, $interval, $reason);
+ foreach my $line (@file) {
+ if ($line =~ m{^$channel\x02$network\x02(\d+)\x02([^\x02]*)\x02(\d)\x02(\d+)\x02(.*)}) {
+ $time = $1;
+ $options = $2;
+ $reminder = $3;
+ $interval = $4;
+ $reason = $5;
+ last;
+ }
+ }
+
+ ################################################################################
+ # Special variables
+ ################################################################################
+
+ my $output = $option{dau_away_reminder_text};
+
+ # $time
+
+ my $difference = time_diff_verbose(time, $time);
+ $output =~ s/\$time/$difference/g;
+
+ # $reason
+
+ if ($option{dau_away_quote_reason}) {
+ $reason =~ s/\\/\\\\/g;
+ $reason =~ s/\$/\\\$/g;
+ }
+ $output =~ s/\$reason/$reason/g;
+
+ ################################################################################
+ # Write text to channels. Write changes back to file
+ ################################################################################
+
+ untie(@file);
+
+ $output = parse_text("$options $output", $channel_rec);
+
+ output_text($channel_rec, $channel_rec->{name}, $output);
+}
+
+# all babbles: the writing to the channel
+
+sub timer_babble_writing {
+
+ # check if we are still on the channel
+
+ my $onChannel = 0;
+ foreach my $server (Irssi::servers()) {
+ if ($server->{tag} eq $babble{channel}->{server}->{tag}) {
+ foreach my $channel ($server->channels()) {
+ if ($babble{channel}->{name} eq $channel->{name}) {
+ if ($babble{channel} != $channel) {
+ $babble{channel} = $channel;
+ }
+ $onChannel = 1;
+ }
+ }
+ }
+ }
+ if (!$onChannel) {
+ Irssi::timeout_remove($babble{timer_writing});
+ print_out("%9dau.pl:%9 You are not on $babble{channel}->{name}/$babble{channel}->{server}->{tag}. Stalling babble.");
+ return;
+ }
+
+ # restore the variables
+
+ $command_out = $babble{command_out_history}{$babble{counter}};
+ $command_out_activated = $babble{command_out_history_switch}{$babble{counter}};
+
+ # then output text
+
+ output_text($babble{channel}, $babble{channel}->{name}, $babble{line});
+
+ # And go to the "managing" subroutine...
+
+ timer_babble_writing_reset();
+}
+
+# all babbles: the timer for the next writing
+
+sub timer_babble_writing_reset {
+ my $interval = 0;
+
+ # Remove used writing timer, if existent (at the first run we don't have any timer)
+
+ Irssi::timeout_remove($babble{timer_writing}) if (defined($babble{timer_writing}));
+
+ # At each run of this managing subroutine remove one line of text
+
+ $babble{text} =~ s/^(.*?)\n//;
+ $babble{line} = $1;
+
+ if ($babble{line} =~ s/^BABBLE_INTERVAL=(\d+)\x02//) {
+ $interval = $1;
+ $babble{line} = parse_text("$option{dau_babble_options_line_by_line} $babble{line}");
+ my $counter = $babble{counter} + 1;
+ $babble{command_out_history}{$counter} = $command_out;
+ $babble{command_out_history_switch}{$counter} = $command_out_activated;
+ }
+
+ # If there is still some text left, add a new timer for the next line
+
+ if (length($babble{text}) != 0 || length($babble{line}) != 0) {
+
+ if ($babble{counter}++ == 0) {
+ if ($option{dau_babble_verbose} && $babble{numberoflines} >= $option{dau_babble_verbose_minimum_lines}) {
+ $babble{channel}->print("%9dau.pl:%9 Babbling $babble{numberoflines} line" . ($babble{numberoflines} > 1 ? 's' : '') . ' now:');
+ }
+ $interval = 50;
+ }
+
+ if ($interval < 10) {
+ # Calculate the writing breaks
+ # The longer the next line is the longer the break will be
+
+ $interval = 1000 + rand(2000) +
+ 50 * length($babble{line}) +
+ rand(25 * length($babble{line}));
+
+ # Some characters need more time to write
+
+ while ($babble{line} =~ /[^a-z ]/gio) {
+ $interval += (75 + rand(25));
+ }
+
+ $interval = int($interval);
+ }
+
+ # Set timer
+
+ $babble{timer_writing} = Irssi::timeout_add($interval, \&timer_babble_writing, '');
+ }
+
+ # No text left?
+
+ else {
+ if ($option{dau_babble_verbose} && $babble{numberoflines} >= $option{dau_babble_verbose_minimum_lines}) {
+ $babble{channel}->print('%9dau.pl:%9 Finished babbling.');
+ }
+
+ # remove the timer
+
+ undef($babble{timer_writing});
+
+ if ($babble{remote}) {
+ timer_remote_babble_reset();
+ }
+ }
+}
+
+# remote babble: initialize
+
+sub timer_remote_babble {
+ my $text;
+
+ # Push all channels where it's ok to babble text in @channels
+
+ my %lookup;
+ while ($option{dau_remote_babble_channellist} =~ /\s*([^\/]+)\/([^,]+)\s*,?/g) {
+ my $channel = $1;
+ $channel = lc($channel);
+ my $ircnet = $2;
+ $ircnet = lc($ircnet);
+ $lookup{$ircnet}{$channel} = 1;
+ }
+
+ my @channels;
+ foreach my $server (Irssi::servers()) {
+ my $server_name = lc($server->{tag});
+
+ foreach my $channel ($server->channels()) {
+ my $channel_name = lc($channel->{name});
+
+ if (lc($option{dau_remote_babble_channelpolicy}) eq 'allow' &&
+ !$lookup{$server_name}{$channel_name})
+ {
+ push(@channels, $channel);
+ }
+ elsif (lc($option{dau_remote_babble_channelpolicy}) eq 'deny' &&
+ $lookup{$server_name}{$channel_name})
+ {
+ push(@channels, $channel);
+ }
+ }
+ }
+
+ # No channels found => return
+
+ return if (@channels == 0);
+
+ # Choose one of the @channels
+
+ my $channel = $channels[rand(@channels)];
+
+ # If something is babbling right now, stop
+
+ if (defined($babble{timer_writing})) {
+ return;
+ }
+
+ # else get text from file
+
+ else {
+ my @filter = ();
+ $text = &babble_get_text($channel, \@filter, undef, $option{dau_babble_history_size});
+ }
+
+ # Stop the timer for the big breaks.
+
+ Irssi::timeout_remove($babble{timer_remote}) if (defined($babble{timer_remote}));
+
+ # Start the writing.
+
+ babble_start($channel, $text, 1);
+}
+
+# remote babble: reset
+
+sub timer_remote_babble_reset {
+ Irssi::timeout_remove($babble{timer_remote}) if (defined($babble{timer_remote}));
+
+ # Do not set the timer, if the permission-bit is not set
+
+ return unless ($option{dau_remote_permissions} =~ /^[01][01][01][01][01]1$/);
+
+ # Calculate interval
+
+ my $interval = babble_set_interval($option{dau_remote_babble_interval}, $option{dau_remote_babble_interval_accuracy});
+
+ # Set timer
+
+ if ($interval != 0) {
+ $babble{timer_remote} = Irssi::timeout_add($interval, \&timer_remote_babble, '');
+ }
+}
+
+################################################################################
+# Helper subroutines
+################################################################################
+
+sub babble_get_text {
+ my ($channel, $filter, $nicks, $history_size) = @_;
+ my $output;
+
+ # Return a random line from the dau_files_babble_messages file
+
+ my ($text, @file, @filterindex);
+ my $file = "$option{dau_files_root_directory}/$option{dau_files_babble_messages}";
+
+ if (-e $file && -r $file) {
+ unless (tie(@file, 'Tie::File', $file)) {
+ print_err("Cannot tie $file!");
+ return;
+ }
+ } else {
+ print_err("Couldn't access babble file '$file'!");
+ return;
+ }
+
+ my @nicks_channel = ();
+ my @opnicks_channel = ();
+ if (defined($channel) && $channel && $channel->{type} eq 'CHANNEL') {
+ foreach my $nick ($channel->nicks()) {
+ next if ($channel->{server}->{nick} eq $nick->{nick});
+ push(@nicks_channel, $nick->{nick});
+ push(@opnicks_channel, $nick->{nick}) if ($nick->{op});
+ }
+ }
+
+ my @compiled_patterns_filter;
+ eval { # possible user input here
+ @compiled_patterns_filter = map { qr/$_/i } @$filter;
+ };
+ if ($@) {
+ print_err("The %9-filter%9 you gave wasn't a valid regular expression.");
+ print_err($@);
+ return;
+ }
+ my $compiled_pattern_nicks = qr/(?<![\\])\$nick(\d+)/;
+ my $compiled_pattern_ops = qr/(?<![\\])\$opnick(\d+)/;
+
+ my $i = 0;
+ foreach my $line (@file) {
+ my $add = 1;
+
+ # Every filter has to match
+
+ FILTER: foreach my $filter (@compiled_patterns_filter) {
+ if ($line !~ /$filter/) {
+ $add = 0;
+ last FILTER;
+ }
+ }
+
+ # Check against history
+
+ if ($add) {
+ my $i = 1;
+ foreach (@{ $babble{history} }) {
+ if ($i++ <= $history_size) {
+ if ($line eq $_) {
+ $add = 0;
+ }
+ }
+ }
+ }
+
+ # Don't babble at non-existent nicks
+
+ if ($add) {
+ my $minimum_number_nicks = 0;
+ while ($line =~ /$compiled_pattern_nicks/g) {
+ if ($1 > $minimum_number_nicks) {
+ $minimum_number_nicks = $1;
+ }
+ }
+ if (defined($nicks) && @$nicks > 0) {
+ if (scalar(@$nicks) < $minimum_number_nicks) {
+ $add = 0;
+ }
+ } else {
+ if (scalar(@nicks_channel) < $minimum_number_nicks) {
+ $add = 0;
+ }
+ }
+ }
+
+ # Don't babble at non-existent channel operators
+
+ if ($add) {
+ if ($line =~ /$compiled_pattern_ops/) {
+ my $minimum_number_ops = 0;
+ while ($line =~ /$compiled_pattern_ops/g) {
+ if ($1 > $minimum_number_ops) {
+ $minimum_number_ops = $1;
+ }
+ }
+ if (defined($nicks) && @$nicks > 0) {
+ if (scalar(@$nicks) < $minimum_number_ops) {
+ $add = 0;
+ }
+ } else {
+ if (scalar(@opnicks_channel) < $minimum_number_ops) {
+ $add = 0;
+ }
+ }
+ }
+ }
+
+ # Add the line as it passed all the tests
+
+ if ($add) {
+ push(@filterindex, $i);
+ }
+ $i++;
+ }
+ $text = $file[$filterindex[int(rand(@filterindex))]];
+
+ if (@filterindex == 0) {
+ print_err("Babble failed. Possible reasons: a) Too restrictive %9-filter%9 in place b) No matching lines in the babble file c) babble history holding that babble d) Not enough people in the channel");
+ return;
+ }
+
+ if (!$text) {
+ print_err("No text to babble.");
+ return;
+ }
+
+ # Put babble in global history and shorten it, if necessary
+
+ @{ $babble{history} } = ($text, @{ $babble{history} });
+ if (scalar(@{ $babble{history} }) > $option{dau_babble_history_size}) {
+ pop(@{ $babble{history} });
+ }
+
+ # dauify $text and return the dauified $output
+
+ my $options = $option{dau_babble_options_line_by_line};
+
+ # We have to keep track of the command history. --me and the --command
+ # switch change the variables $command_out and $command_out_activated.
+ # Because they are reset after every run of parse_text() they have to be kept
+ # in a struct so that the writing timers later can do their job correctly.
+
+ my $counter = 1;
+ $babble{command_out_history} = ();
+ $babble{command_out_history_switch} = ();
+
+ # parse for special characters and substitute them
+
+ if (defined($nicks)) {
+ if (@$nicks > 0) {
+ for (my $i = 1; $i <= @$nicks; $i++) {
+ $text =~ s/(?<![\\])\$nick$i/@$nicks[$i - 1]/g;
+ }
+ }
+ $text = switch_parse_special($text, $channel);
+ } else {
+ $text = switch_parse_special($text, $channel);
+ }
+
+ # Preprocessing options
+
+ if ($option{dau_babble_options_preprocessing} !~ /^\s*$/) {
+ $text = parse_text("$option{dau_babble_options_preprocessing} \x02$text");
+ $text =~ s/^\x02//;
+ }
+
+ # Process $text line by line
+
+ $text =~ s/\\n/\n/g;
+ $text =~ s/\n$//;
+ while ($text =~ /(.*?)(\n|$)/g) {
+ my $line = $1;
+
+ # Exit while loop when finished
+
+ last if ($2 ne "\n" && $1 eq "");
+
+ # Dauify text
+
+ my $newtext = parse_text("$options $line") . "\n";
+
+ $output .= $newtext;
+
+ # The parsed text ($newtext) can contain more than one line.
+ # All $newtext lines have the same command.
+ # The command (MSG, ACTION, ...) has to be remembered.
+
+ while ($newtext =~ /\n/g) {
+ $babble{command_out_history}{$counter} = $command_out;
+ $babble{command_out_history_switch}{$counter} = $command_out_activated;
+ $counter++;
+ }
+ }
+
+ # Lines are separated by newline characters. Maybe there are to many of
+ # them at the end of the string (probably produced by --figlet, --cowsay, ...).
+ # That's disturbing the number of lines calculation later.
+
+ $output =~ s/\n{2,}$/\n/;
+
+ # $output contains now the text to be babbled. It will be split by
+ # newlines by the babble subroutines and each line will be babbled with
+ # the correct commands restored.
+
+ return $output;
+}
+
+sub babble_interval {
+ return "BABBLE_INTERVAL=" . babble_set_interval(@_) . "\x02";
+}
+
+sub babble_set_interval {
+ my ($time, $accuracy) = @_;
+
+ my $interval = time_parse($time);
+
+ my $addend;
+ if ($accuracy == 100) {
+ $addend = 0;
+ } elsif ($accuracy > 0 && $accuracy < 100) {
+ $addend = rand($interval - ($interval * ($accuracy / 100)));
+ } else {
+ print_err('Invalid accuracy value');
+ return;
+ }
+
+ if (int(rand(2))) {
+ $interval = $interval + $addend;
+ } else {
+ $interval = $interval - $addend;
+ }
+
+ $interval = int($interval);
+
+ if ($interval < 10 || $interval > 1000000000) {
+ print_err('Invalid interval value');
+ return 0;
+ }
+
+ return $interval;
+}
+
+sub babble_start {
+ my ($channel_rec, $text, $remote) = @_;
+
+ # These are some global variables for the writing timer
+
+ $babble{channel} = $channel_rec;
+ $babble{counter} = 0;
+ $babble{text} = "$text\n";
+ $babble{numberoflines} = 0;
+ $babble{numberoflines}++ while ($babble{text} =~ /\n/g);
+ $babble{numberoflines} -= 1;
+ $babble{remote} = $remote;
+
+ Irssi::timeout_remove($babble{timer_writing}) if (defined($babble{timer_writing}));
+
+ timer_babble_writing_reset();
+}
+
+sub build_nick_mode_struct {
+ undef(%nick_mode);
+
+ foreach my $server (Irssi::servers()) {
+ my $network_name = lc($server->{tag});
+
+ foreach my $channel ($server->channels()) {
+ my $channel_name = lc($channel->{name});
+ my $op = $channel->{ownnick}{op};
+ my $voice = $channel->{ownnick}{voice};
+
+ $nick_mode{$network_name}{$channel_name}{op} = $op;
+ $nick_mode{$network_name}{$channel_name}{voice} = $voice;
+ }
+ }
+}
+
+sub daumode_channels {
+ my @items;
+ my $item;
+ while ($option{dau_daumode_channels} =~ /([^,]+)/g) {
+ my $match = $1;
+ if ($match =~ s/\\$//) {
+ $item .= "$match,";
+ } else {
+ $item .= $match;
+ $item =~ s/^\s*//;
+ $item =~ s/\s*$//;
+ push @items, $item unless ($item =~ /^\s*$/);
+ $item = "";
+ }
+ }
+
+ foreach my $server (Irssi::servers()) {
+ my $network_name = $server->{tag};
+ foreach my $channel ($server->channels()) {
+ my $channel_name = $channel->{name};
+ foreach my $daumode (@items) {
+ $daumode =~ m#^([^/]+)/([^:]+):(.*)#;
+ my $item_channel = $1;
+ my $item_network = $2;
+ my $item_switches = $3;
+
+ if (lc($item_channel) eq lc($channel_name) &&
+ lc($item_network) eq lc($network_name))
+ {
+ unless ($daumode{channels_in}{$network_name}{$channel_name} ||
+ $daumode{channels_out}{$network_name}{$channel_name})
+ {
+ $channel->print("%9dau.pl%9: Activating daumode according to setting dau_daumode_channels");
+ }
+ $channel->command("dau --daumode $item_switches");
+ }
+ }
+ }
+ }
+}
+
+sub def_dau_cowsay_cowpath {
+ my $cowsay = $ENV{COWPATH} || '/usr/share/cowsay/cows';
+ chomp($cowsay);
+ return $cowsay;
+}
+
+sub def_dau_cowsay_cowsay_path {
+ my $cowsay = `which cowsay`;
+ chomp($cowsay);
+ return $cowsay;
+}
+
+sub def_dau_cowsay_cowthink_path {
+ my $cowthink = `which cowthink`;
+ chomp($cowthink);
+ return $cowthink;
+}
+
+sub def_dau_figlet_fontpath {
+ my $figlet = `figlet -I2`;
+ chomp($figlet);
+ return $figlet;
+}
+
+sub def_dau_figlet_path {
+ my $figlet = `which figlet`;
+ chomp($figlet);
+ return $figlet;
+}
+
+sub cowsay_cowlist {
+ my $cowsay_cowpath = shift;
+
+ # clear cowlist
+
+ %{ $switches{combo}{cowsay}{cow} } = ();
+
+ # generate new list
+
+ while (<$cowsay_cowpath/*.cow>) {
+ my $cow = (fileparse($_, qr/\.[^.]*/))[0];
+ $switches{combo}{cowsay}{cow}{$cow} = 1;
+ }
+}
+
+sub figlet_fontlist {
+ my $figlet_fontpath = shift;
+
+ # clear fontlist
+
+ %{ $switches{combo}{figlet}{font} } = ();
+
+ # generate new list
+
+ while (<$figlet_fontpath/*.flf>) {
+ my $font = (fileparse($_, qr/\..*/))[0];
+ $switches{combo}{figlet}{font}{$font} = 1;
+ }
+}
+
+sub fix {
+ my $string = shift;
+ $string =~ s/^\t+//gm;
+ return $string;
+}
+
+sub output_text {
+ my ($thing, $target, $text) = @_;
+
+ foreach my $line (split /\n/, $text) {
+
+ # prevent "-!- Irssi: Not enough parameters given"
+ $line = ' ' if ($line eq '');
+
+ # --command -out <command>?
+
+ if ($command_out_activated) {
+ if (defined($thing) && $thing) {
+ $thing->command("$command_out $line");
+ } else {
+ my $server = Irssi::active_server();
+
+ if (defined($server) && $server && $server->{connected}) {
+ $server->command("$command_out $line");
+ } else {
+ print CLIENTCRAP $line;
+ }
+ }
+ }
+
+ # Not a channel/query window, --help, --changelog, ...
+
+ elsif ($print_message) {
+ print CLIENTCRAP $line;
+ }
+
+ # MSG or ACTION to channel or query
+
+ elsif ($command_out eq 'ACTION' || $command_out eq 'MSG') {
+ $thing->command("$command_out $target $line");
+ }
+
+ # weird things happened...
+
+ else {
+ print CLIENTCRAP $line;
+ }
+ }
+}
+
+sub parse_text {
+ my ($data, $channel_rec) = @_;
+ my $output;
+
+ $command_out_activated = 0;
+ $command_out = 'MSG';
+ $counter_switches = 0;
+ $daumode_activated = 0;
+ $print_message = 0;
+ %queue = ();
+
+ OUTER: while ($data =~ /^--(\w+) ?/g) {
+
+ my $first_level_option = $1;
+
+ # If its the first time we are in the OUTER loop, check
+ # if the first level option is one of the few options,
+ # which must not be combined.
+
+ if (ref($switches{nocombo}{$first_level_option}{'sub'}) && $counter_switches == 0) {
+
+ $data =~ s/^--\w+ ?//;
+
+ # found a first level option
+
+ $queue{$counter_switches}{$first_level_option} = { };
+
+ # Check for second level options and third level options.
+ # Get all of them and put theme in the
+ # $queue hash
+
+ while ($data =~ /^-(\w+) ('.*?(?<![\\])'|\S+) ?/g) {
+
+ my $second_level_option = $1;
+ my $third_level_option = $2;
+
+ $third_level_option =~ s/^'//;
+ $third_level_option =~ s/'$//;
+ $third_level_option =~ s/\\'/'/g;
+
+ # If $switches{nocombo}{$first_level_option}{$second_level_option}{'*'}:
+ # The user can give any third_level_option on the commandline
+
+ my $any_option =
+ $switches{nocombo}{$first_level_option}{$second_level_option}{'*'} ? 1 : 0;
+
+ if ($switches{nocombo}{$first_level_option}{$second_level_option}{$third_level_option} ||
+ $any_option)
+ {
+ $queue{$counter_switches}{$first_level_option}{$second_level_option} = $third_level_option;
+ }
+
+ $data =~ s/^-(\w+) ('.*?(?<![\\])'|\S+) ?//;
+ }
+
+ # initialize some values
+
+ foreach my $second_level_option (keys(%{ $switches{nocombo}{$first_level_option} })) {
+ if (!defined($queue{'0'}{$first_level_option}{$second_level_option})) {
+ $queue{'0'}{$first_level_option}{$second_level_option} = '';
+ }
+ }
+
+ # All done. Run the subroutine
+
+ $output = &{ $switches{nocombo}{$first_level_option}{'sub'} }($data, $channel_rec);
+
+ return $output;
+ }
+
+ # Check for all those options that can be combined.
+
+ elsif (ref($switches{combo}{$first_level_option}{'sub'})) {
+
+ $data =~ s/^--\w+ ?//;
+
+ # found a first level option
+
+ $queue{$counter_switches}{$first_level_option} = { };
+
+ # Check for second level options and
+ # third level options. Get all of them and put them
+ # in the $queue hash
+
+ while ($data =~ /^-(\w+) ('.*?(?<![\\])'|\S+) ?/g) {
+
+ my $second_level_option = $1;
+ my $third_level_option = $2;
+
+ $third_level_option =~ s/^'//;
+ $third_level_option =~ s/'$//;
+ $third_level_option =~ s/\\'/'/g;
+
+ # If $switches{combo}{$first_level_option}{$second_level_option}{'*'}:
+ # The user can give any third_level_option on the commandline
+
+ my $any_option =
+ $switches{combo}{$first_level_option}{$second_level_option}{'*'} ? 1 : 0;
+
+ # known option => Put it in the hash
+
+ if ($switches{combo}{$first_level_option}{$second_level_option}{$third_level_option}
+ || $any_option)
+ {
+ $queue{$counter_switches}{$first_level_option}{$second_level_option} = $third_level_option;
+ $data =~ s/^-(\w+) ('.*?(?<![\\])'|\S+) ?//;
+ } else {
+ last OUTER;
+ }
+ }
+
+ # increase counter
+
+ $counter_switches++;
+ }
+
+ else {
+ last OUTER;
+ }
+ }
+
+ # initialize some values
+
+ for (my $i = 0; $i < $counter_switches; $i++) {
+ foreach my $first_level (keys(%{ $queue{$i} })) {
+ if (ref($switches{combo}{$first_level})) {
+ foreach my $second_level (keys(%{ $switches{combo}{$first_level} })) {
+ if (!defined($queue{$i}{$first_level}{$second_level})) {
+ $queue{$i}{$first_level}{$second_level} = '';
+ }
+ }
+ }
+ }
+ }
+
+ # text to subroutines
+
+ $output = $data;
+
+ # If theres no text left over, take one item of dau_random_messages
+
+ if ($output eq '') {
+ $output = return_random_list_item($option{dau_standard_messages});
+ }
+
+ # No options? Get options from setting dau_standard_options and run
+ # parse_text() again
+
+ if (keys(%queue) == 0) {
+
+ if (!$counter_subroutines) {
+ print_out("No options given, hence using the value of the setting %9dau_standard_options%9 and that is %9$option{dau_standard_options}%9", $channel_rec);
+ $counter_subroutines++;
+ $output = parse_text("$option{dau_standard_options} $output", $channel_rec);
+ } else {
+ print_err('Invalid value for setting dau_standard_options. ' .
+ 'Will use %9--moron%9 instead!');
+ $output =~ s/^\Q$option{dau_standard_options}\E //;
+ $output = parse_text("--moron $output", $channel_rec);
+ }
+
+ } else {
+
+ $counter_switches = 0;
+
+ for (keys(%queue)) {
+ my ($first_level_option) = keys %{ $queue{$counter_switches} };
+ $output = &{ $switches{combo}{$first_level_option}{'sub'} }($output, $channel_rec);
+ $counter_switches++;
+ }
+ }
+
+ # reset subcounter
+
+ $counter_subroutines = 0;
+
+ # return text
+
+ return $output;
+}
+
+sub print_err {
+ my $text = shift;
+
+ foreach my $line (split /\n/, $text) {
+ print CLIENTCRAP "%Rdau.pl error%n: $line";
+ }
+}
+
+sub print_out {
+ my ($text, $channel_rec) = @_;
+
+ if ($option{dau_silence}) {
+ return;
+ }
+
+ foreach my $line (split /\n/, $text) {
+ my $message = "%9dau.pl%9: $line";
+ if (defined($channel_rec) && $channel_rec) {
+ $channel_rec->print($message);
+ } else {
+ print CLIENTCRAP $message;
+ }
+ }
+}
+
+# return_option('firstlevel', 'secondlevel'):
+#
+# If "--firstlevel -secondlevel value" given on the commandline, return 'value'.
+#
+# return_option('firstlevel', 'secondlevel', 'default value'):
+#
+# If "--firstlevel -secondlevel value" not given on the commandline, return
+# 'default value'.
+sub return_option {
+ if (@_ == 2) {
+ return $queue{$counter_switches}{$_[0]}{$_[1]};
+ } elsif (@_ == 3) {
+ if (length($queue{$counter_switches}{$_[0]}{$_[1]}) > 0) {
+ return $queue{$counter_switches}{$_[0]}{$_[1]};
+ } else {
+ return $_[2];
+ }
+ } else {
+ return 0;
+ }
+}
+
+sub return_random_list_item {
+ my $arg = shift;
+ my @strings;
+
+ my $item;
+ while ($arg =~ /([^,]+)/g) {
+ my $match = $1;
+ if ($match =~ s/\\$//) {
+ $item .= "$match,";
+ } else {
+ $item .= $match;
+ $item =~ s/^\s*//;
+ $item =~ s/\s*$//;
+ push @strings, $item;
+ $item = "";
+ }
+ }
+
+ if (@strings == 0) {
+ return;
+ } else {
+ return $strings[rand(@strings)];
+ }
+}
+
+sub set_settings {
+ # setting changed/added => change/add it here
+
+ # boolean
+ $option{dau_away_quote_reason} = Irssi::settings_get_bool('dau_away_quote_reason');
+ $option{dau_away_reminder} = Irssi::settings_get_bool('dau_away_reminder');
+ $option{dau_babble_verbose} = Irssi::settings_get_bool('dau_babble_verbose');
+ $option{dau_color_choose_colors_randomly} = Irssi::settings_get_bool('dau_color_choose_colors_randomly');
+ $option{dau_cowsay_print_cow} = Irssi::settings_get_bool('dau_cowsay_print_cow');
+ $option{dau_figlet_print_font} = Irssi::settings_get_bool('dau_figlet_print_font');
+ $option{dau_silence} = Irssi::settings_get_bool('dau_silence');
+ $option{dau_statusbar_daumode_hide_when_off} = Irssi::settings_get_bool('dau_statusbar_daumode_hide_when_off');
+ $option{dau_tab_completion} = Irssi::settings_get_bool('dau_tab_completion');
+
+ # Integer
+ $option{dau_babble_history_size} = Irssi::settings_get_int('dau_babble_history_size');
+ $option{dau_babble_verbose_minimum_lines} = Irssi::settings_get_int('dau_babble_verbose_minimum_lines');
+ $option{dau_cool_maximum_line} = Irssi::settings_get_int('dau_cool_maximum_line');
+ $option{dau_cool_probability_eol} = Irssi::settings_get_int('dau_cool_probability_eol');
+ $option{dau_cool_probability_word} = Irssi::settings_get_int('dau_cool_probability_word');
+ $option{dau_remote_babble_interval_accuracy} = Irssi::settings_get_int('dau_remote_babble_interval_accuracy');
+
+ # String
+ $option{dau_away_away_text} = Irssi::settings_get_str('dau_away_away_text');
+ $option{dau_away_back_text} = Irssi::settings_get_str('dau_away_back_text');
+ $option{dau_away_options} = Irssi::settings_get_str('dau_away_options');
+ $option{dau_away_reminder_interval} = Irssi::settings_get_str('dau_away_reminder_interval');
+ $option{dau_away_reminder_text} = Irssi::settings_get_str('dau_away_reminder_text');
+ $option{dau_babble_options_line_by_line} = Irssi::settings_get_str('dau_babble_options_line_by_line');
+ $option{dau_babble_options_preprocessing} = Irssi::settings_get_str('dau_babble_options_preprocessing');
+ $option{dau_color_codes} = Irssi::settings_get_str('dau_color_codes');
+ $option{dau_cool_eol_style} = Irssi::settings_get_str('dau_cool_eol_style');
+ $option{dau_cowsay_cowlist} = Irssi::settings_get_str('dau_cowsay_cowlist');
+ $option{dau_cowsay_cowpath} = Irssi::settings_get_str('dau_cowsay_cowpath');
+ $option{dau_cowsay_cowpolicy} = Irssi::settings_get_str('dau_cowsay_cowpolicy');
+ $option{dau_cowsay_cowsay_path} = Irssi::settings_get_str('dau_cowsay_cowsay_path');
+ $option{dau_cowsay_cowthink_path} = Irssi::settings_get_str('dau_cowsay_cowthink_path');
+ $option{dau_daumode_channels} = Irssi::settings_get_str('dau_daumode_channels');
+ $option{dau_delimiter_string} = Irssi::settings_get_str('dau_delimiter_string');
+ $option{dau_figlet_fontlist} = Irssi::settings_get_str('dau_figlet_fontlist');
+ $option{dau_figlet_fontpath} = Irssi::settings_get_str('dau_figlet_fontpath');
+ $option{dau_figlet_fontpolicy} = Irssi::settings_get_str('dau_figlet_fontpolicy');
+ $option{dau_figlet_path} = Irssi::settings_get_str('dau_figlet_path');
+ $option{dau_files_away} = Irssi::settings_get_str('dau_files_away');
+ $option{dau_files_babble_messages} = Irssi::settings_get_str('dau_files_babble_messages');
+ $option{dau_files_cool_suffixes} = Irssi::settings_get_str('dau_files_cool_suffixes');
+ $option{dau_files_root_directory} = Irssi::settings_get_str('dau_files_root_directory');
+ $option{dau_files_substitute} = Irssi::settings_get_str('dau_files_substitute');
+ $option{dau_language} = Irssi::settings_get_str('dau_language');
+ $option{dau_moron_eol_style} = Irssi::settings_get_str('dau_moron_eol_style');
+ $option{dau_parse_special_list_delimiter} = Irssi::settings_get_str('dau_parse_special_list_delimiter');
+ $option{dau_random_options} = Irssi::settings_get_str('dau_random_options');
+ $option{dau_remote_babble_channellist} = Irssi::settings_get_str('dau_remote_babble_channellist');
+ $option{dau_remote_babble_channelpolicy} = Irssi::settings_get_str('dau_remote_babble_channelpolicy');
+ $option{dau_remote_babble_interval} = Irssi::settings_get_str('dau_remote_babble_interval');
+ $option{dau_remote_channellist} = Irssi::settings_get_str('dau_remote_channellist');
+ $option{dau_remote_channelpolicy} = Irssi::settings_get_str('dau_remote_channelpolicy');
+ $option{dau_remote_deop_reply} = Irssi::settings_get_str('dau_remote_deop_reply');
+ $option{dau_remote_devoice_reply} = Irssi::settings_get_str('dau_remote_devoice_reply');
+ $option{dau_remote_op_reply} = Irssi::settings_get_str('dau_remote_op_reply');
+ $option{dau_remote_permissions} = Irssi::settings_get_str('dau_remote_permissions');
+ $option{dau_remote_question_regexp} = Irssi::settings_get_str('dau_remote_question_regexp');
+ $option{dau_remote_question_reply} = Irssi::settings_get_str('dau_remote_question_reply');
+ $option{dau_remote_voice_reply} = Irssi::settings_get_str('dau_remote_voice_reply');
+ $option{dau_standard_messages} = Irssi::settings_get_str('dau_standard_messages');
+ $option{dau_standard_options} = Irssi::settings_get_str('dau_standard_options');
+ $option{dau_words_range} = Irssi::settings_get_str('dau_words_range');
+}
+
+sub signal_handling {
+ # complete word
+
+ if ($option{dau_tab_completion}) {
+ if ($signal{'complete word'} != 1) {
+ Irssi::signal_add_last('complete word', 'signal_complete_word');
+ }
+ $signal{'complete word'} = 1;
+ } else {
+ if ($signal{'complete word'} != 0) {
+ Irssi::signal_remove('complete word', 'signal_complete_word');
+ }
+ $signal{'complete word'} = 0;
+ }
+
+ # event privmsg
+
+ if ($option{dau_remote_permissions} =~ /^1[01][01][01][01][01]$/) {
+ if ($signal{'event privmsg'} != 1) {
+ Irssi::signal_add_last('event privmsg', 'signal_event_privmsg');
+ }
+ $signal{'event privmsg'} = 1;
+ } else {
+ if ($signal{'event privmsg'} != 0) {
+ Irssi::signal_remove('event privmsg', 'signal_event_privmsg');
+ }
+ $signal{'event privmsg'} = 0;
+ }
+
+ # nick mode changed
+
+ if ($option{dau_remote_permissions} =~ /^[01]1[01][01][01][01]$/ ||
+ $option{dau_remote_permissions} =~ /^[01][01]1[01][01][01]$/ ||
+ $option{dau_remote_permissions} =~ /^[01][01][01]1[01][01]$/ ||
+ $option{dau_remote_permissions} =~ /^[01][01][01][01]1[01]$/)
+ {
+ if ($signal{'nick mode changed'} != 1) {
+ Irssi::signal_add_last('channel joined', 'build_nick_mode_struct');
+ Irssi::signal_add_last('nick mode changed', 'signal_nick_mode_changed');
+ }
+ $signal{'nick mode changed'} = 1;
+ } else {
+ if ($signal{'nick mode changed'} != 0) {
+ Irssi::signal_remove('channel joined', 'build_nick_mode_struct');
+ Irssi::signal_remove('nick mode changed', 'signal_nick_mode_changed');
+ }
+ $signal{'nick mode changed'} = 0;
+ }
+
+ # daumode: outgoing messages
+
+ my $daumode_out = 0;
+
+ foreach my $server (keys %{ $daumode{channels_out} }) {
+ foreach my $channel (keys %{ $daumode{channels_out}{$server} }) {
+ if ($daumode{channels_out}{$server}{$channel} == 1) {
+ $daumode_out = 1;
+ }
+ }
+ }
+
+ if ($daumode_out) {
+ if ($signal{'send text'} != 1) {
+ Irssi::signal_add_first('send text', 'signal_send_text');
+ }
+ $signal{'send text'} = 1;
+ } else {
+ if ($signal{'send text'} != 0) {
+ Irssi::signal_remove('send text', 'signal_send_text');
+ }
+ $signal{'send text'} = 0;
+ }
+
+ # daumode: incoming messages
+
+ my $daumode_in = 0;
+
+ foreach my $server (keys %{ $daumode{channels_in} }) {
+ foreach my $channel (keys %{ $daumode{channels_in}{$server} }) {
+ if ($daumode{channels_in}{$server}{$channel} == 1) {
+ $daumode_in = 1;
+ }
+ }
+ }
+
+ if ($daumode_in) {
+ if ($signal{'daumode in'} != 1) {
+ Irssi::signal_add_last('message public', 'signals_daumode_in');
+ Irssi::signal_add_last('message irc action', 'signals_daumode_in');
+ }
+ $signal{'daumode in'} = 1;
+ } else {
+ if ($signal{'daumode in'} != 0) {
+ Irssi::signal_remove('message public', 'signals_daumode_in');
+ Irssi::signal_remove('message irc action', 'signals_daumode_in');
+ }
+ $signal{'daumode in'} = 0;
+ }
+
+ # continuing babbles, setting daumode
+
+ if ($signal{'channel joined'} != 1) {
+ Irssi::signal_add_last('channel joined', 'signal_channel_joined');
+ Irssi::signal_add_last('channel destroyed', 'signal_channel_destroyed');
+ $signal{'channel joined'} = 1;
+ }
+
+ # Cancel babble when message could not be sent to channel
+
+ if ($signal{'event 404'} != 1) {
+ Irssi::signal_add_last('event 404', 'signal_event_404');
+ $signal{'event 404'} = 1;
+ }
+}
+
+sub time_diff_verbose {
+ my ($sub1, $sub2) = @_;
+
+ my $difference = $sub1 - $sub2;
+ $difference *= (-1) if ($difference < 0);
+ my $seconds = $difference % 60;
+ $difference = ($difference - $seconds) / 60;
+ my $minutes = $difference % 60;
+ $difference = ($difference - $minutes) / 60;
+ my $hours = $difference % 24;
+ $difference = ($difference - $hours) / 24;
+ my $days = $difference % 7;
+ my $weeks = ($difference - $days) / 7;
+
+ my $time;
+ $time = "$weeks week" . ($weeks == 1 ? "" : "s") . ", " if ($weeks);
+ $time .= "$days day" . ($days == 1 ? "" : "s") . ", " if ($weeks || $days);
+ $time .= "$hours hour" . ($hours == 1 ? "" : "s") . ", " if ($weeks || $days || $hours);
+ $time .= "$minutes minute" . ($minutes == 1 ? "" : "s") . ", " if ($weeks || $days || $hours || $minutes);
+ $time .= "$seconds second" . ($seconds == 1 ? "" : "s") if ($weeks || $days || $hours || $minutes || $seconds);
+
+ return $time;
+}
+
+sub time_parse {
+ my $time = $_[0];
+ my $parsed_time = 0;
+
+ # milliseconds
+ while ($time =~ s/(\d+)\s*(?:milliseconds|ms)//g) {
+ $parsed_time += $1;
+ }
+ # seconds
+ while ($time =~ s/(\d+)\s*s(?:econds?)?//g) {
+ $parsed_time += $1 * 1000;
+ }
+ # minutes
+ while ($time =~ s/(\d+)\s*m(?:inutes?)?//g) {
+ $parsed_time += $1 * 1000 * 60;
+ }
+ # hours
+ while ($time =~ s/(\d+)\s*h(?:ours?)?//g) {
+ $parsed_time += $1 * 1000 * 60 * 60;
+ }
+ # days
+ while ($time =~ s/(\d+)\s*d(?:ays?)?//g) {
+ $parsed_time += $1 * 1000 * 60 * 60 * 24;
+ }
+ # weeks
+ while ($time =~ s/(\d+)\s*w(?:eeks?)?//g) {
+ $parsed_time += $1 * 1000 * 60 * 60 * 24 * 7;
+ }
+
+ if ($time !~ /^\s*$/) {
+ print_err('Error while parsing the date!');
+ return 0;
+ }
+
+ return $parsed_time;
+}
+
+################################################################################
+# Debugging
+################################################################################
+
+sub debug_message {
+ open(DEBUG, ">>", "$ENV{HOME}/.dau/.debug");
+
+ print DEBUG $_[0];
+
+ close (DEBUG);
+}
+
+#BEGIN {
+# use warnings;
+#
+# open(STDERR, ">>", $ENV{HOME}/.dau/.STDERR");
+#}
diff --git a/scripts/dcc_ip.pl b/scripts/dcc_ip.pl
new file mode 100644
index 0000000..3c7e8b8
--- /dev/null
+++ b/scripts/dcc_ip.pl
@@ -0,0 +1,117 @@
+#!/usr/bin/perl -w
+# dcc_ip.pl v0.5 - Copyright (c) ak5 2004
+# License: Public Domain :-)
+#
+# this scripts gets the current IP before sending a dcc..
+# useful, if you connect through a BNC f.e.
+# just load it and it will do it's job if dcc_ip_interface is set correct.
+#
+
+# This means: If you are connecting through a router:
+# /set dcc_ip_interface router
+# (NOT the IP of your router, just the word "router".
+#
+# If you're on dialup or something other and you see your external
+# IP address listed in 'ifconfig's output,
+# /set dcc_ip_interface <interface>
+# (for example ppp0)
+#
+# requires: /sbin/ifconfig ;) If you have a router, you need lynx also.
+#
+##########
+
+use strict;
+use Irssi;
+use Socket;
+use vars qw($VERSION %IRSSI);
+ $VERSION = '0.6';
+ %IRSSI = (
+ authors => 'ak5, bw1',
+ contact => 'meister@hq.kroenk.remove-this-because-of-spam.de',
+ name => 'dcc_ip',
+ description => 'This script sets dcc_own_ip when starting a DCC send or chat.'.
+ 'set dcc_ip_interface to your external interface, f.e. ppp0.'.
+ 'If you are connecting though a router, set it to "router"',
+ license => 'Public Domain',
+ url => 'http://hq.kroenk.de/?gnu/irssi',
+ source => 'http://hq.kroenk.de/?gnu/irssi/dcc_ip.pl/plaintext',
+ changed => '2019-02-17',
+ );
+
+# ip of the nat interface as a string;
+my $router_ip;
+# state of whois
+my $router_c=0;
+# arguments of the dcc command
+my $router_args;
+
+sub dcc_ip {
+ my ($args, $shash, $c, $iface, $cmd, @arg, @ip) = @_;
+ @arg = split(" ", $args);
+ if (@arg[0] eq "send" || @arg[0] eq "chat") {
+ $iface = Irssi::settings_get_str('dcc_ip_interface');
+ if ($router_c == 0) {
+ if ($iface eq "router") {
+ mywhois($args, $shash, $c);
+ Irssi::signal_stop();
+ $router_c=1;
+ $router_args = $args;
+ return;
+ } else {
+ $cmd = `/sbin/ifconfig $iface | head -n 2 | tail -n 1`;
+ $cmd =~ s/^[a-zA-Z\ ]*\://;
+ $cmd =~ s/\ .*$//;
+ $cmd =~ s/\n//;
+ }
+ Irssi::command("^set dcc_own_ip ".$cmd);
+ } else {
+ $router_c =0;
+ }
+ }
+};
+
+sub mywhois {
+ my ($args, $server, $witem) = @_;
+ my $nick =$server->{nick};
+ $server->redirect_event("whois", 1, $nick, 0, undef, {
+ "event 311" => "redir whos",
+ "event 318" => "redir whosend",
+ "" => "event empty"}
+ );
+ $server->send_raw("WHOIS " . $nick);
+}
+
+sub sig_whos {
+ my ($server, $data) = @_;
+ my @r = split(/\s/,$data);
+ $router_ip = $r[3];
+}
+
+sub sig_whosend {
+ my ($server, $data) = @_;
+
+ if ( defined $router_ip ) {
+ if ( !( $router_ip =~ m/\d+\.\d+\.\d+\.\d+/ ||
+ ($router_ip =~ m/[0-9a-fA-F:]+/ && $router_ip =~ m/:.*:/ ))) {
+ my $packed_ip = gethostbyname($router_ip);
+ if (defined $packed_ip) {
+ $router_ip = inet_ntoa($packed_ip);
+ } else {
+ $router_ip = undef;
+ }
+ }
+ }
+ if ( defined $router_ip ) {
+ Irssi::settings_set_str("dcc_own_ip", $router_ip);
+ $server->command('dcc '.$router_args );
+ }
+}
+
+Irssi::signal_add('redir whos', \&sig_whos);
+Irssi::signal_add('redir whosend', \&sig_whosend);
+
+Irssi::settings_add_str('dcc_ip', 'dcc_ip_interface', "ppp0");
+Irssi::command_bind ('dcc', 'dcc_ip');
+#EOF
+
+# vim:set ts=8 sw=4 expandtab:
diff --git a/scripts/dccmove.pl b/scripts/dccmove.pl
new file mode 100644
index 0000000..c6790fc
--- /dev/null
+++ b/scripts/dccmove.pl
@@ -0,0 +1,43 @@
+#
+# Copyright (C) 2003-2021 by Peder Stray <peder.stray@gmail.com>
+#
+
+use strict;
+use Irssi;
+use vars qw{$VERSION %IRSSI};
+($VERSION) = '$Revision: 1.4.1 $' =~ / (\d+(\.\d+)+) /;
+%IRSSI = (
+ name => 'dccmove',
+ authors => 'Peder Stray',
+ contact => 'peder.stray@gmail.com',
+ url => 'https://github.com/pstray/irssi-dccmove',
+ license => 'GPL',
+ description => 'Move completed dcc gets to the subfolder done',
+ );
+
+sub sig_dcc_closed {
+ my($dcc) = @_;
+ my($dir,$file);
+
+ return unless $dcc->{type} eq 'GET';
+ return unless -f $dcc->{file};
+
+ ($dir,$file) = $dcc->{file} =~ m,(.*)/(.*),;
+ $dir .= "/done";
+
+ if ($dcc->{transfd} < $dcc->{size}) {
+ printf('%%gDCC aborted %%_%s%%_, %%R%d%%%%%%g remaining%%n',
+ $file,
+ $dcc->{size} ? 100 - $dcc->{transfd}/$dcc->{size}*100 : 0,
+ );
+ return;
+ }
+
+ mkdir $dir, 0755 unless -d $dir;
+ rename $dcc->{file}, "$dir/$file";
+
+ printf('%%gDCC moved %%_%s%%_ to %%_%s%%_%%n', $file, $dir);
+
+}
+
+Irssi::signal_add_last('dcc closed', 'sig_dcc_closed');
diff --git a/scripts/dccself.pl b/scripts/dccself.pl
new file mode 100644
index 0000000..1a6ccea
--- /dev/null
+++ b/scripts/dccself.pl
@@ -0,0 +1,38 @@
+use strict;
+use vars qw/%IRSSI $VERSION/;
+use Irssi qw(command_bind active_server);
+
+$VERSION= "0.1";
+%IRSSI = (
+ authors => "David Leadbeater",
+ contact => "dgl\@dgl.cx",
+ name => "dccself",
+ description => "/dccself ip port, starts a dcc chat with yourself on that
+ host/port, best used with /set dcc_autochat_masks.",
+ license => "GPL",
+);
+
+# I tried using Juerd's style for this script - seems to make it easier to read
+# :)
+
+command_bind('dccself', sub {
+ my $data = shift;
+ my($ip,$port) = split / |:/, $data, 2;
+
+ return unless ref active_server;
+ my $nick = active_server->{nick};
+ $ip = dcc_ip($ip);
+ active_server->command("ctcp $nick DCC CHAT CHAT $ip $port");
+} );
+
+sub dcc_ip {
+ my $ip = shift;
+ # This could block!
+ $ip = sprintf("%d.%d.%d.%d", unpack('C4',(gethostbyname($ip))[4]))
+ unless $ip =~ /\d$/;
+
+ my @a = split /\./, $ip, 4;
+ # Thanks to perlguy/grifferz/AndrewR
+ return $a[0]*0x1000000 + $a[1]*0x10000 + $a[2]*0x100 + $a[3];
+}
+
diff --git a/scripts/dccstat.pl b/scripts/dccstat.pl
new file mode 100644
index 0000000..7b7dfd0
--- /dev/null
+++ b/scripts/dccstat.pl
@@ -0,0 +1,501 @@
+use strict;
+use Irssi::Irc;
+use Irssi 20020217; # Irssi 0.8.0
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.52";
+%IRSSI = (
+ authors => "Matti 'qvr' Hiljanen",
+ contact => 'matti\@hiljanen.com',
+ contributors => 'stefan@pico.ruhr.de, dieck@gmx.de, peder@ifi.uio.no',
+ name => "dccstat",
+ description => "Shows verbose or short information of dcc send/gets on statusbar (speed, size, eta etc.)",
+ license => "GPL, Version 2",
+ url => "http://matin.maapallo.org/softa/irssi",
+ sbitems => "dccstat"
+);
+
+# Theme settings:
+# sb_dccstat = "{sb $0-}";
+# $0 = sb_ds_short(_waiting)/sb_ds_normal(_waiting)
+# sb_ds_short = "$0%G:%n$1%Y@%n$2kB/s%G:%n$4%G:%n$3";
+# $0 = G/S
+# $1 = filename
+# $2 = transfer speed
+# $3 = percent
+# $4 = progressbar
+# sb_ds_short_waiting = "$0%G:%n$1 $2 $3 waiting";
+# $0 = G/S
+# $1 = filename
+# $2 = to/from
+# $3 = nick
+# sb_ds_normal = "$0 $1: '$2' $3 of $4 [$8] $9 ($5) $6kB/s ETA: $7";
+# $0 = GET/SEND
+# $1 = nick
+# $2 = filename
+# $3 = transferred amount
+# $4 = full filesize
+# $5 = percent
+# $6 = speed
+# $7 = ETA
+# $8 = progressbar
+# $9 = rotator thingy :)
+# sb_ds_normal_waiting = "$0 $1: '$2' $3 $4 $5 waiting";
+# $0 = GET/SEND
+# $1 = nick
+# $2 = filename
+# $3 = full filesize
+# $4 = to/from
+# $5 = nick
+# sb_ds_separator = ", ";
+#
+# TODO:
+# new ideas more than welcome :)
+#
+# FAQ:
+# Q: my input line gets cleared every time dcc send/get starts or ends,
+# why's that?!
+# A: it's a bug in irssi which is already fixed in cvs (2002-03-24 Sunday 20:06)
+# so the solution: upgrade to cvs or live with it and wait until the next stable release
+#
+
+
+use Irssi::TextUI;
+use strict;
+
+my $dccstat_refresh=5;
+my ($refresh_tag, $old_refresh, $new_refresh, $displayed_since);
+my $visible = -1;
+my $displaying = 0;
+my @rot_bar = ('|', '/', '-', '\\\\\\\\');
+my $rot_bar_n = 0;
+my %dccstat;
+
+sub cmd_print_help {
+ Irssi::print(
+ "%_Dccstat.pl Help:%_\n\n".
+ "Statusbar called dccstat should have appeared when you loaded this script,\n".
+ "now you need to add the dccstat item into that statusbar:\n".
+ " /statusbar dccstat add dccstat\n".
+ " /save\n\n".
+ " The default verbose mode will produce output like this: \n".
+ " [GET nick: 'foobar.avi' 5500kB of 11MB (50%) 99kB/s ETA: 00:03:00]\n".
+ " and the short mode looks like this:\n".
+ " [G:foobar.avi\@99kB/s:(50%)]\n\n".
+ " %_/SETs:%_\n".
+ " /set dccstat_refresh <secs> (default: 5)\n".
+ " /set dccstat_short_mode <ON/OFF> (default: OFF)\n".
+ " shorter output and doesn't show DCCs: None when there are no GET/SENDs\n".
+ " /set dccstat_hide_sbar_when_inactive <ON/OFF> (default: OFF)\n".
+ " hides the statusbar called dccstat when there are no GET/SENDs\n".
+ " /set dccstat_auto_short_limit (default: 2)\n".
+ " amount of dcc sends/gets we can have before we automagically switch to short mode\n".
+ " (when all the info wouldn't fit to statusbar). setting it to 0 will disable it.\n".
+ " /set dccstat_progbar_width (default: 10)\n".
+ " progressbar width in chars\n".
+ " /set dccstat_progbar_transferred (default: '%%g=%%n')\n".
+ " /set dccstat_progbar_position (default: '%%y>%%n')\n".
+ " /set dccstat_progbar_remaining (default: '%%r-%%n')\n".
+ " /set dccstat_cycle_through_transfers (default: OFF)\n".
+ " cycle trough the transfers (ON) or show all transfers at the same time (OFF, default)\n".
+ " /set dccstat_cycle_through_transfers_refresh <secs> (default: 5)\n".
+ " how long to show one transfer at a time\n".
+ " /set dccstat_filename_max_length (default: 17)\n".
+ " /set dccstat_filename_max_length_shortmode (default: 10)\n".
+ " how much to show of a filename in normal and short modes\n\n".
+ " /set dccstat_EXPERIMENTAL_fast_refresh (default: OFF)\n".
+ " use very experimental and super fast refreshing, will probably consume all cpu power,\n".
+ " depending on your connection speed. but hey, it's fun :)\n".
+ " /set dccstat_debug (default: OFF)\n".
+ " show debug messages\n".
+ " \n".
+ "\nSee also: STATUSBAR, DCC and theme help in the actual script"
+ ,MSGLEVEL_CRAP);
+}
+
+sub debug {
+ my ($text) = @_;
+ return unless Irssi::settings_get_bool('dccstat_debug');
+ my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+ localtime(time);
+ $sec = sprintf("%02d", $sec);
+ $min = sprintf("%02d", $min);
+ $hour = sprintf("%02d", $hour);
+ Irssi::print("DEBUG(%_Dccstat.pl%_): ".$text." [$hour:$min:$sec]");
+}
+
+sub startup_check {
+ debug("START-UP - DEBUG IS ON");
+ my @dccs = Irssi::Irc::dccs();
+ my $act;
+ foreach my $dcc (@dccs) { $act=$dcc if $dcc->{type} eq "SEND" || $dcc->{type} eq "GET"; };
+ dcc_connected($act);
+}
+
+sub dcc_connected {
+ debug("entering dcc_connected");
+ my ($dcc) = @_;
+ return unless $dcc->{type} eq "SEND" || $dcc->{type} eq "GET";
+ debug("removing dcc connected -signal");
+ Irssi::signal_remove('dcc connected', 'dcc_connected');
+ my $refresh_msecs = (Irssi::settings_get_int('dccstat_refresh')*1000);
+ $refresh_msecs = ($dccstat_refresh*1000) if $refresh_msecs < 1000;
+ debug("adding normal timeout..");
+ $refresh_tag=Irssi::timeout_add($refresh_msecs, 'refresh_dccstat', undef);
+ $old_refresh=Irssi::settings_get_int('dccstat_refresh');
+ Irssi::signal_add_last('dcc destroyed', 'dcc_checklast');
+ refresh_dccstat();
+}
+
+sub dcc_setupcheck {
+ $new_refresh = Irssi::settings_get_int('dccstat_refresh');
+ if ($new_refresh != $old_refresh) {
+ debug("setting a new refresh timeout");
+ $new_refresh = ($new_refresh*1000);
+ Irssi::timeout_remove($refresh_tag);
+ $new_refresh = ($dccstat_refresh*1000) if $new_refresh < 1000;
+ $refresh_tag=Irssi::timeout_add($new_refresh, 'refresh_dccstat', undef);
+ $old_refresh=Irssi::settings_get_int('dccstat_refresh');
+ }
+ refresh_dccstat();
+}
+
+sub dcc_checklast {
+ my @dccs = Irssi::Irc::dccs();
+ my $count = dcc_getcount();
+ debug("check for last, count is '$count'");
+ return unless $count == 0;
+ debug("was last, removing timeout '$refresh_tag'");
+ Irssi::timeout_remove($refresh_tag);
+ Irssi::signal_remove('dcc destroyed', 'dcc_checklast');
+ Irssi::signal_add('dcc connected', 'dcc_connected');
+ refresh_dccstat();
+}
+
+# this function calculates the average speed of the last 10 seconds.
+# i think that's better than irssis default way of calculating the
+# average speed from the whole transfer
+sub dcc_calcSpeed {
+ my @dccs = Irssi::Irc::dccs();
+ foreach my $dcc (@dccs) {
+ next unless $dcc->{type} eq "SEND" || $dcc->{type} eq "GET";
+ my $id = "$dcc->{created}" . "$dcc->{addr}" . "$dcc->{port}";
+ if (defined($dccstat{$id}{'speed'})) {
+ my $old = $dccstat{$id}{'position'};
+ my $current = $dcc->{transfd};
+ my $speed = (($current-$old)/10);
+ unless ($dccstat{$id}{'speed'} == "-1" && ($current-$old) == 0) {
+ $dccstat{$id}{'speed'} = $speed;
+ }
+ $dccstat{$id}{'position'} = $current;
+ } else {
+ # new dcc
+ my $id = "$dcc->{created}" . "$dcc->{addr}" . "$dcc->{port}";
+ debug("creating dcc hash '$id'");
+ $dccstat{$id}{'speed'} = "-1";
+ $dccstat{$id}{'position'} = "0";
+ }
+ }
+
+ # let's remove old hashes
+ foreach my $hash (keys %dccstat) {
+ my $keep = 0;
+ foreach my $dcc (@dccs) {
+ my $id = "$dcc->{created}" . "$dcc->{addr}" . "$dcc->{port}";
+ $keep = 1 if ($hash == $id);
+ }
+ if ($keep) {
+ debug("dcc '$hash' is still active, it's speed is '" . $dccstat{$hash}{'speed'} . "'");
+ } else {
+ debug("deleting dcc '$hash'");
+ delete $dccstat{$hash};
+ }
+ }
+}
+
+### this function originally implemented by dieck@gmx.de
+sub dcc_calculateETA {
+ my $dcc = $_[0];
+ my ($dccspeed, $dccleft, $going, $dccsecs, $dcctime);
+
+ # calculate current speed
+ $going=(time-$dcc->{starttime});
+ $going=1 if $going==0;
+ my $id = "$dcc->{created}" . "$dcc->{addr}" . "$dcc->{port}";
+ if (defined($dccstat{$id})) {
+ $dccspeed=$dccstat{$id}{'speed'};
+ } else {
+ $dccspeed = -1;
+ }
+ ## speed in bytes/sec
+ if ($dccspeed > 0) {
+
+ # calculate left transfer size
+ $dccleft = ($dcc->{size}-$dcc->{transfd});
+ ## size left in byte
+
+ $dccspeed=1 if $dccspeed==0;
+ $dccsecs = $dccleft / $dccspeed;
+
+ $dcctime = sprintf("%02d:%02d:%02d", int($dccsecs/60/60), int($dccsecs/60%60), int($dccsecs%60));
+ } elsif ($dccspeed == "0") {
+ $dcctime = "stalled";
+ } elsif ($dccspeed == "-1") {
+ $dcctime = "???";
+ } else {
+ # panic!
+ $dcctime = "error!";
+ }
+ return $dcctime;
+}
+
+### this function originally implemented by stefan_tomanek@web.de
+sub dcc_progbar {
+ my ($dcc) = @_;
+ my ($filebar, $nobar);
+ my $barwidth = Irssi::settings_get_int('dccstat_progbar_width');
+ my $char1 = Irssi::settings_get_str('dccstat_progbar_transferred');
+ my $char2 = Irssi::settings_get_str('dccstat_progbar_position');
+ my $char3 = Irssi::settings_get_str('dccstat_progbar_remaining');
+ if ($dcc->{size} > 0) {
+ my $width_per_size = ($barwidth) / $dcc->{size};
+ my $transf_chars = sprintf("%.0f",($width_per_size * $dcc->{transfd}));
+ $filebar = $char1 x $transf_chars;
+ $nobar = $char3 x ($barwidth - $transf_chars - 1);
+ return "${filebar}${char2}${nobar}";
+ } else {
+ return $barwidth x $char3;
+ }
+}
+
+sub dcc_calculateSIZE {
+ my $fsize = $_[0];
+ my ($size, $unit, $div);
+
+ if ($fsize >= 1024*1024*1024) { $size = $fsize/1024/1024/1024; $unit = "GB"; $div = 2; }
+ elsif ($fsize >= 1024*1024) { $size = $fsize/1024/1024; $unit = "MB"; $div = 2; }
+ elsif ($fsize >= 1024) { $size = $fsize/1024; $unit = "kB"; $div = 0; }
+ else { $size = $fsize; $unit = "B"; $div = 0; }
+ $size = sprintf("%.${div}f", $size);
+ return "${size}${unit}";
+}
+
+sub dcc_getcount {
+ my @dccs = Irssi::Irc::dccs();
+ my $count = 0;
+ foreach my $dcc (@dccs) { $count++ if $dcc->{type} eq "GET" || $dcc->{type} eq "SEND"; }
+ return $count;
+}
+
+sub dccstat {
+ #debug("going into main function");
+ my ($item, $get_size_only) = @_;
+ my @dccs=Irssi::Irc::dccs();
+ my (@results, $results);
+ my $mode = Irssi::settings_get_bool('dccstat_short_mode');
+ my $exp_flags = Irssi::EXPAND_FLAG_IGNORE_EMPTY | Irssi::EXPAND_FLAG_IGNORE_REPLACES;
+ my $theme = Irssi::current_theme();
+ my $format = $theme->format_expand("{sb_dccstat}");
+ my $count = dcc_getcount();
+ if ($count>0) {
+ my $sendcount=0;
+ my $getcount=0;
+ my (
+ $dccpercent, $dccspeed, $dcctype, $going,
+ $dccnick, $dccfile, $FooOfBar, $str,
+ $fsize, $transize, $dcceta, $from,
+ $to, $direction, $prep, $autolimit,
+ $separator, $dccprogbar, $dccrotbar
+ );
+ foreach my $dcc (@dccs) {
+ next unless $dcc->{type} eq "SEND" || $dcc->{type} eq "GET";
+ # if count is above the autolimit, we'll force the mode to short
+ # but not if we're cycling through transfers.
+ if (not Irssi::settings_get_bool('dccstat_cycle_through_transfers')) {
+ $autolimit=Irssi::settings_get_int('dccstat_auto_short_limit');
+ $mode=1 if $count > $autolimit && $autolimit > 0;
+ }
+
+ $sendcount++ if $dcc->{type} eq "SEND";
+ $getcount++ if $dcc->{type} eq "GET";
+
+ $dccpercent = ($dcc->{size} == 0) ? "(0%)" : sprintf("%.1f", $dcc->{transfd}/$dcc->{size}*100)."%%";
+
+ $going = (time-$dcc->{starttime});
+ $going = 1 if $going==0;
+
+ my $id = "$dcc->{created}" . "$dcc->{addr}" . "$dcc->{port}";
+ if (defined($dccstat{$id})) {
+ $dccspeed = $dccstat{$id}{'speed'};
+ } else {
+ $dccspeed = -1;
+ }
+ if ($dccspeed >= 0) {
+ $dccspeed = sprintf("%.2f", ($dccspeed/1024));
+ } else {
+ $dccspeed = sprintf("%.2f", ($dcc->{transfd}-$dcc->{skipped})/$going/1024);
+ }
+
+ $dcctype = $dcc->{type};
+
+ $dccnick = $dcc->{nick};
+ $dccnick =~ s/\\/\\\\/g;
+ $dccfile = $dcc->{arg};
+ $dccfile =~ s/ /\240/g;
+ $dccfile =~ s/\\/\\\\/g;
+
+ # if filename is longer than 17 chars, we'll show only the first 15 chars
+ # and in short mode we'll show only 8 chars
+ # (lengths are now configurable, but the idea is the same)
+ my $max_normal = Irssi::settings_get_int('dccstat_filename_max_length');
+ my $max_short = Irssi::settings_get_int('dccstat_filename_max_length_shortmode');
+ if (!$mode) {
+ $dccfile=substr($dccfile, 0, $max_normal-2).".." if (length($dccfile) > $max_normal);
+ } else {
+ $dccfile=substr($dccfile, 0, $max_short-2).".." if (length($dccfile) > $max_short);
+ }
+
+ $fsize = dcc_calculateSIZE($dcc->{size});
+ $transize = dcc_calculateSIZE($dcc->{transfd});
+ $dccprogbar = dcc_progbar($dcc);
+ $dccprogbar =~ s/ /\240/g;
+ $dcceta = dcc_calculateETA($dcc);
+
+ if ($dcctype eq "GET") { $direction = "G"; $prep = "from"; }
+ if ($dcctype eq "SEND") { $direction = "S"; $prep = "to"; }
+
+ $dccrotbar = $rot_bar[$rot_bar_n];
+
+ # short mode?
+ if ($mode) {
+ # theme?
+ if ($format) {
+ if ($dcc->{starttime} > 0) {
+ $str = $theme->format_expand("{sb_ds_short $direction $dccfile $dccspeed $dccpercent $dccprogbar $dccrotbar}", $exp_flags);
+ } else {
+ $str = $theme->format_expand("{sb_ds_short_waiting $direction $dccfile $prep $dccnick}", $exp_flags);
+ }
+ } else {
+ $str = "$direction%G:%n$dccfile";
+ $str .= ($dcc->{starttime} > 0) ? "%G@%n${dccspeed}kB/s%G:%n$dccprogbar%G:%n$dccrotbar%G:%n$dccpercent" : " $prep $dccnick waiting";
+ }
+ } else {
+ if ($format) {
+ if ($dcc->{starttime} > 0) {
+ $str = $theme->format_expand("{sb_ds_normal $dcctype $dccnick $dccfile $transize $fsize $dccpercent $dccspeed $dcceta $dccprogbar $dccrotbar}", $exp_flags);
+ } else {
+ $str = $theme->format_expand("{sb_ds_normal_waiting $dcctype $dccnick $dccfile $fsize $prep $dccnick}", $exp_flags);
+ }
+ } else {
+ $str = "$dcctype $dccnick: '$dccfile'";
+ $str .= ($dcc->{starttime} > 0) ? " $transize of $fsize [$dccprogbar] $dccrotbar ($dccpercent) ${dccspeed}kB/s ETA: $dcceta" : " $fsize $prep $dccnick waiting";
+ }
+ }
+ push @results,$str;
+ }
+ if (not Irssi::settings_get_bool('dccstat_cycle_through_transfers')) {
+ $separator = ($theme->format_expand("{sb_ds_separator}")) ? $theme->format_expand("{sb_ds_separator}") : ", ";
+ $results = join("$separator", @results);
+ } else {
+ if (scalar(@results)-1 < $displaying) { $displaying = 0 };
+ $results = @results[$displaying];
+ if (not $get_size_only) {
+ if ((time-$displayed_since) >= (Irssi::settings_get_int('dccstat_cycle_through_transfers_refresh'))) {
+ debug("refreshing cycle display");
+ $displaying++;
+ $displayed_since = time;
+ }
+ }
+ }
+ } else {
+ $results="%_DCCs:%_ None" if !$mode;
+ }
+ if ($format) {
+ if ($count > 0) {
+ $results = "{sb_dccstat $results}"
+ } else {
+ $results = "{sb_dccstat $results}" unless $mode;
+ }
+ } else {
+ if ($count > 0) {
+ $results = "{sb $results}";
+ } else {
+ $results = "{sb $results}" unless $mode;
+ }
+ }
+ $item->default_handler($get_size_only, "$results", undef, 1);
+}
+
+sub refresh_dccstat {
+ #debug("refreshing item");
+ my $hide = Irssi::settings_get_bool('dccstat_hide_sbar_when_inactive');
+ my $count = dcc_getcount();
+
+ if ($hide && $count == 0) {
+ if ($visible == -1 || $visible == 1) {
+ Irssi::command("statusbar dccstat disable");
+ debug("disabling statusbar");
+ $visible = 0;
+ }
+ return;
+ }
+ if ($visible == 0 || $visible == -1) {
+ Irssi::command("statusbar dccstat enable");
+ debug("enabling statusbar");
+ $visible = 1;
+ }
+ Irssi::statusbar_items_redraw('dccstat');
+ $rot_bar_n++;
+ $rot_bar_n %= @rot_bar;
+
+}
+
+my $fref = 0;
+sub dcc_fast_refresh {
+ if (Irssi::settings_get_bool('dccstat_EXPERIMENTAL_fast_refresh'))
+ {
+ refresh_dccstat();
+ $fref++;
+ debug("transfer updated! ($fref)");
+ }
+}
+
+Irssi::settings_add_int($IRSSI{'name'}, "dccstat_refresh", $dccstat_refresh);
+Irssi::settings_add_bool($IRSSI{'name'}, 'dccstat_short_mode', 0);
+Irssi::settings_add_bool($IRSSI{'name'}, 'dccstat_hide_sbar_when_inactive', 0);
+Irssi::settings_add_int($IRSSI{'name'}, 'dccstat_auto_short_limit', 2);
+Irssi::settings_add_int($IRSSI{'name'}, 'dccstat_progbar_width', 10);
+Irssi::settings_add_str($IRSSI{'name'}, 'dccstat_progbar_transferred', '%g=%n');
+Irssi::settings_add_str($IRSSI{'name'}, 'dccstat_progbar_position', '%y>%n');
+Irssi::settings_add_str($IRSSI{'name'}, 'dccstat_progbar_remaining', '%r-%n');
+Irssi::settings_add_bool($IRSSI{'name'}, 'dccstat_cycle_through_transfers', 0);
+Irssi::settings_add_int($IRSSI{'name'}, 'dccstat_cycle_through_transfers_refresh', 10);
+Irssi::settings_add_bool($IRSSI{'name'}, 'dccstat_EXPERIMENTAL_fast_refresh', 0);
+Irssi::settings_add_bool($IRSSI{'name'}, 'dccstat_debug', 0);
+Irssi::settings_add_int($IRSSI{'name'}, 'dccstat_filename_max_length', 17);
+Irssi::settings_add_int($IRSSI{'name'}, 'dccstat_filename_max_length_shortmode', 10);
+
+Irssi::command_bind('dccstat', 'cmd_print_help');
+
+Irssi::statusbar_item_register('dccstat', undef, 'dccstat');
+Irssi::timeout_add('10000', 'dcc_calcSpeed', undef);
+Irssi::signal_add('dcc connected', 'dcc_connected');
+Irssi::signal_add(
+ {
+ 'setup changed' => \&dcc_setupcheck,
+ 'dcc request' => \&refresh_dccstat,
+ 'dcc created' => \&refresh_dccstat,
+ 'dcc destroyed' => \&refresh_dccstat,
+ 'dcc transfer update' => \&dcc_fast_refresh,
+ }
+ );
+
+# Startup
+startup_check();
+refresh_dccstat();
+
+# lets save some global variables
+$old_refresh = Irssi::settings_get_int('dccstat_refresh');
+
+Irssi::print("Dccstat.pl loaded - /dccstat for help");
+
+# EOF
diff --git a/scripts/defaultchanmode.pl b/scripts/defaultchanmode.pl
new file mode 100644
index 0000000..2fd8a8f
--- /dev/null
+++ b/scripts/defaultchanmode.pl
@@ -0,0 +1,98 @@
+#!/usr/bin/perl -w
+
+# USAGE:
+#
+# /SET default_chanmode <modes>
+# - sets the desired default chanmodes
+#
+# Written by Jakub Jankowski <shasta@atn.pl>
+# for Irssi 0.7.98.CVS
+#
+# please report any bugs
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.1";
+%IRSSI = (
+ authors => 'Jakub Jankowski',
+ contact => 'shasta@atn.pl',
+ name => 'Default Chanmode',
+ description => 'Allows your client to automatically set desired chanmode upon a join to an empty channel.',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.atn.pl/',
+);
+
+use Irssi 20011211.0107 ();
+use Irssi::Irc;
+
+# defaults
+my $default_chanmode = "";
+
+# str parse_mode($string)
+# gets +a-e+bc-fg xyz
+# returns +abc-efg xyz
+sub parse_mode {
+ my ($string) = @_;
+ my ($modeStr, $rest) = split(/ +/, $string, 2);
+ my @modeParams = split(/ +/, $rest);
+ my $ptr = 0;
+ my ($mode, $plusmodes, $minusmodes, $args, $finalstring);
+
+ # processing the default_chanmode setting
+ foreach my $char (split(//, $modeStr)) {
+ if ($char eq "+") {
+ $mode = "+";
+ } elsif ($char eq "-") {
+ $mode = "-";
+ } else {
+ if ($mode eq "+") {
+ $plusmodes .= $char;
+ } elsif ($mode eq "-") {
+ $minusmodes .= $char;
+ }
+ if ($char =~ /[beIqoOdhvk]/ || ($char eq "l" && $mode eq "+")) {
+ # those are modes with arguments, so increase the pointer
+ $args .= " ".$modeParams[$ptr++];
+ }
+ }
+ }
+
+ # concatenating results
+ $finalstring .= "+".$plusmodes if (length($plusmodes) > 0);
+ $finalstring .= "-".$minusmodes if (length($minusmodes) > 0);
+ $finalstring .= $args if (length($args) > 0);
+
+ # debug stuff if you want
+ # Irssi::print("parse_mode($string) returning '$finalstring'");
+
+ return $finalstring;
+}
+
+# void event_channel_sync($channel)
+# triggered on join
+sub event_channel_sync {
+ my ($channel) = @_;
+
+ # return unless default_chanmode contains something valuable
+ my $mode = parse_mode(Irssi::settings_get_str('default_chanmode'));
+ return unless $mode;
+
+ # return unless $channel is active, synced, not modeless, and we're a chanop
+ return unless ($channel && $channel->{synced} && $channel->{chanop} && !$channel->{no_modes});
+
+ # check if we're the only one visitor
+ my @nicks = $channel->nicks();
+ return unless (scalar(@nicks) == 1);
+
+ # final stage: issue the MODE
+ $channel->command("/MODE ".$channel->{name}." ".$mode);
+}
+
+Irssi::settings_add_str('misc', 'default_chanmode', $default_chanmode);
+Irssi::signal_add_last('channel sync', 'event_channel_sync');
+
+# changes:
+#
+# 25.01.2002: Initial release (v1.0)
+# 24.02.2002: splitted into two subroutines, minor cleanups (v1.1)
diff --git a/scripts/desktop-notify.pl b/scripts/desktop-notify.pl
new file mode 100644
index 0000000..c41a9f4
--- /dev/null
+++ b/scripts/desktop-notify.pl
@@ -0,0 +1,120 @@
+# Copyright (C) 2015 Felipe F. Tonello <eu@felipetonello.com>
+#
+# Based on fnotify.pl 0.0.5 by Thorsten Leemhuis, James Shubin and
+# Serge van Ginderachter
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+# NOTE:
+# This program requires libnotify, perl-glib-object-introspection and
+# perl-html-parser packages
+
+use strict;
+use Irssi;
+use HTML::Entities;
+use Glib::Object::Introspection; # Ignore 'late INIT' warning message if autoloading
+use Encode;
+
+our $VERSION = '1.0.1';
+our %IRSSI = (
+ authors => 'Felipe F. Tonello',
+ contact => 'eu@felipetonello.com',
+ name => 'desktop-notify',
+ description => 'Sends notification using the Desktop Notifications Specification.',
+ license => 'GPL v3+',
+);
+
+# /set notify_icon <icon-name>
+# List of standard icons can be found here:
+# http://standards.freedesktop.org/icon-naming-spec/icon-naming-spec-latest.html#names
+my $notify_icon;
+my $term_charset;
+
+my $help = '
+/set notify_icon <icon-name>
+ Change notificationicon (default is mail-message-new). A complete list of standard ' .
+'icons can be found here: ' .
+'http://standards.freedesktop.org/icon-naming-spec/icon-naming-spec-latest.html#names
+';
+
+sub init {
+ Glib::Object::Introspection->setup(
+ basename => 'Notify',
+ version => '0.7',
+ package => 'Notify');
+ Notify::init('Irssi');
+}
+
+sub UNLOAD {
+ Notify::uninit();
+}
+
+sub setup_changed {
+ $notify_icon = Irssi::settings_get_str('notify_icon');
+ $term_charset = Irssi::settings_get_str('term_charset');
+}
+
+sub priv_msg {
+ my ($server, $msg, $nick, $address) = @_;
+ my $window = Irssi::active_win();
+
+ # We shouldn't notify if active window is the same as the private message
+ if ($window->{active}->{name} eq $nick) {
+ return;
+ }
+
+ my $msg = HTML::Entities::encode_entities(Irssi::strip_codes($msg), "\<>&'");
+ my $network = $server->{tag};
+ my $noti = Notify::Notification->new($nick . '@' . $network, decode($term_charset, $msg), $notify_icon);
+ $noti->show();
+}
+
+sub hilight {
+ my ($dest, $text, $stripped) = @_;
+ my $server = $dest->{server};
+ my $window = Irssi::active_win();
+
+ # Check if we should notify user of message:
+ # * if message is notice or highligh type
+ # * if the channel belongs to the current server
+ # * if the user is not focused on the channel window
+ if (!($server &&
+ $dest->{level} & (MSGLEVEL_HILIGHT | MSGLEVEL_NOTICES) &&
+ $server->ischannel($dest->{target}) &&
+ $window->{refnum} != $dest->{window}->{refnum})) {
+ return;
+ }
+
+ my $network = $server->{tag};
+ my $msg = HTML::Entities::encode_entities($stripped, "\'<>&");
+ my $noti = Notify::Notification->new($dest->{target} . '@' . $network, decode($term_charset, $msg), $notify_icon);
+ $noti->show();
+}
+
+Irssi::settings_add_str('desktop-notify', 'notify_icon', 'mail-message-new');
+
+Irssi::signal_add('setup changed' => \&setup_changed);
+Irssi::signal_add_last('message private' => \&priv_msg);
+Irssi::signal_add_last('print text' => \&hilight);
+
+Irssi::command_bind('help', sub {
+ if ($_[0] eq $IRSSI{name}) {
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop();
+ }
+ }
+);
+
+init();
+setup_changed();
diff --git a/scripts/df.pl b/scripts/df.pl
new file mode 100644
index 0000000..852cdee
--- /dev/null
+++ b/scripts/df.pl
@@ -0,0 +1,157 @@
+use Irssi;
+use Irssi::TextUI;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION="0.1.0";
+%IRSSI = (
+ authors=> 'Jochem Meyers',
+ contact=> 'jochem.meyers@gmail.com',
+ name=> 'df',
+ description=> 'Adds an item which displays the current disk usage.',
+ sbitems=> 'df',
+ license=> 'GPL v2 or later',
+ url=> 'http://kaede.kicks-ass.net/irssi.html',
+);
+
+#########
+# INFO
+###
+#
+# Type this to add the item:
+#
+# /statusbar window add df
+#
+# See
+#
+# /help statusbar
+#
+# for more help on how to custimize your statusbar.
+#
+# If you want to change the way the item looks, browse down to where it reads
+#
+# $output .= ' [' . $device . ': A: ' . $avail{$device} . ' U%%: ' . $use{$device} . ']';
+#
+# and add or remove any of the following:
+# $size{$device} is the total size of the drive
+# $used{$device} is the total amount of used space
+# $avail{$device} is the amount of available space
+# $use{$device} is the percentage of space used
+# $mount{$device} is the mount point
+#
+# Next version, if I ever get around to making one, will have an easier system of changing the
+# way the statusbar item looks.
+#
+# There's a command defined, /dfupdate, which will instantly update the statusbar item. If you
+# want this information printed in the statuswindow, use /exec df -h in any window :).
+#
+############
+# OPTIONS
+######
+#
+# The irssi command /set can be used to change these settings (more to follow):
+# * df_refresh_time (default: 60)
+# The number of seconds between updates.
+#
+###
+#########
+# TODO
+###
+#
+# - Add format support so the display is more easily customizable.
+# - Add a list of devices to display.
+# - Add a setting that'll let user define the switches to pass to df?
+#
+#########
+
+#definte variables
+my $output;
+my ($df_refresh_tag);
+my $sbitem;
+my (%size, %used, %avail, %use, %mount);
+
+#get information about the harddrives
+sub getDiskInfo()
+{
+ my @list;
+ my $skip_line_one = 1;
+
+ open(FID, "-|", "/bin/df");
+ while (<FID>)
+ {
+ if ($skip_line_one > 0)
+ {
+ $skip_line_one--;
+ next;
+ }
+ my $line = $_;
+ $line =~ s/[\s:]/ /g;
+ @list = split(" ", $line);
+ $list[0] =~ s/\/dev\///g;
+ $size{$list[0]} = $list[1];
+ $used{$list[0]} = $list[2];
+ $avail{$list[0]} = $list[3];
+ $use{$list[0]} = $list[4];
+ $mount{$list[0]} = $list[5];
+ $skip_line_one--;
+ if ($skip_line_one < -100) {
+ Irssi::print("More than 100 drives, this can't be.");
+ return;
+ }
+ }
+ close(FID);
+}
+
+#called by irssi to get the statusbar item
+sub sb_df()
+{
+ my ($item, $get_size_only) = @_;
+ $item->default_handler($get_size_only, "{sb $sbitem}", undef, 1);
+}
+
+sub test()
+{
+ refresh_df();
+}
+#refresh the statusbar item
+sub refresh_df()
+{
+ getDiskInfo();
+ $output = "";
+ $sbitem = "";
+ my @devices = keys(%size);
+ my $device;
+ foreach $device (@devices)
+ {
+ $output .= ' [' . $device . ': A: ' . $avail{$device} . ' U%%: ' . $use{$device} . ']';
+ }
+ $sbitem = 'DF' . $output;
+ Irssi::statusbar_items_redraw('df');
+ if ($df_refresh_tag)
+ {
+ Irssi::timeout_remove($df_refresh_tag)
+ }
+ my $time = Irssi::settings_get_int('df_refresh_time');
+ $df_refresh_tag = Irssi::timeout_add($time*1000, 'refresh_df', undef);
+}
+
+#register the statusbar item
+Irssi::statusbar_item_register('df', undef, 'sb_df');
+
+#add settings
+Irssi::settings_add_int('misc', 'df_refresh_time', 60);
+
+Irssi::command_bind('dfupdate','test');
+
+#run refresh_df() once so sbitem has a value
+refresh_df();
+
+################
+###
+# Changelog
+# Version 0.1.0
+# - initial release
+#
+###
+################
diff --git a/scripts/dice.pl b/scripts/dice.pl
new file mode 100644
index 0000000..5368184
--- /dev/null
+++ b/scripts/dice.pl
@@ -0,0 +1,191 @@
+# dice / A RP Dice Simulator
+#
+# What is this?
+#
+# I often Dungeon Master on our Neverwinternights Servers called "Bund der
+# alten Reiche" (eng. "Alliance of the old realms") at bundderaltenreiche.de
+# (German Site) Often idling in our Channel I thought it might be Fun to have
+# a script to dice. Since I found nothing for irssi I wrote this little piece
+# of script. The script assumes, that if a 'd' for english dice is given it
+# should print the output in english. On the other hand if a 'w' for german
+# "Würfel" is given it prints the output in german.
+#
+# Usage.
+#
+# Anyone on the Channel kann ask "!dice" to toss the dice for him. He just has
+# to say what dice he want to use. The notation should be well known from
+# RP :-) Thus
+#
+# Write: !dice: <quantity of dice>d[or w for german users]<sides on dice>
+#
+# Here are some examples
+#
+# !dice: 2d20
+# !dice: 3d6
+#
+# OK, I think you got it already :-)
+#
+# Write: !dice version
+# For Version Information
+#
+# Write: !dice help
+# For Information about how to use it
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi qw(command_bind signal_add);
+use IO::File;
+$VERSION = '0.00.04';
+%IRSSI = (
+ authors => 'Marcel Kossin',
+ contact => 'mkossin@enumerator.org',
+ name => 'dice',
+ description => 'A Dice Simulator for Roleplaying in Channels or just for fun.',
+ license => 'GNU GPL Version 2 or later',
+ url => 'http://www.enumerator.org/component/option,com_docman/task,view_category/Itemid,34/subcat,7/'
+);
+
+sub own_question {
+ my ($server, $msg, $nick, $address, $target) = @_;
+ question($server, $msg, $nick, $target);
+}
+
+sub public_question {
+ my ($server, $msg, $nick, $address, $target) = @_;
+ question($server, $msg, $nick, $target);
+}
+
+sub question($server, $msg, $nick, $target) {
+ my ($server, $msg, $nick, $target) = @_;
+ $_ = $msg;
+
+ if (!/^!dice/i) { return 0; }
+
+ if (/^!dice:.+[d|w]\d+/i) {
+ my $value;
+ my $rnd;
+ my $forloop;
+ my $sides;
+ my $lang;
+ my @dice = split(/ /,$_,2);
+ my @dices = split(/[d|w|D|W]/,$dice[1],2);
+ if ($_ = /^.*[w|W].*/i) {
+ $lang = "DE";
+ } else {
+ $lang = "EN";
+ }
+ SWITCH: {
+ if ($lang eq "DE") {
+ $server->command('msg '.$target.' '.$nick.' würfelt mit dem '.$dice[1].'..... ');
+ last SWITCH;
+ }
+ if ($lang eq "EN") {
+ $server->command('msg '.$target.' '.$nick.' tosses with the '.$dice[1].'..... ');
+ last SWITCH;
+ }
+ }
+ if($dices[1] > 1) {
+ if($dices[1] < 100) {
+ if($dices[0] < 11) {
+ if($dices[0] < 1) {
+ $dices[0] = 1;
+ }
+ for($forloop = 1; $forloop <= $dices[0]; $forloop++) {
+ $rnd = int(rand($dices[1]-1));
+ if($rnd == 0){
+ $rnd = $dices[1];
+ }
+ $value = $value + $rnd;
+ SWITCH: {
+ if ($lang eq "DE") {
+ $server->command('msg '.$target.' '.$nick.' würfelt beim '.$forloop.'. Wurf eine '.$rnd);
+ last SWITCH;
+ }
+ if ($lang eq "EN") {
+ $server->command('msg '.$target.' '.$nick.' tosses at his '.$forloop.'. try a '.$rnd);
+ last SWITCH;
+ }
+ }
+ }
+ SWITCH: {
+ if ($lang eq "DE") {
+ $server->command('msg '.$target.' '.$nick.' ist fertig mit Würfeln. Sein Ergebnis lautet: '.$value);
+ last SWITCH;
+ }
+ if ($lang eq "EN") {
+ $server->command('msg '.$target.' '.$nick.' finished. His result reads: '.$value);
+ last SWITCH;
+ }
+ }
+ } else {
+ SWITCH: {
+ if ($lang eq "DE") {
+ $server->command('msg '.$target.' '.$nick.' meint wohl in d'.$dices[1].'´s baden zu müssen... Mal im Ernst versuch es mit weniger Würfeln!' );
+ last SWITCH;
+ }
+ if ($lang eq "EN") {
+ $server->command('msg '.$target.' '.$nick.' seems to wanna take a bath in d'.$dices[1].'´s... Seriously! Try less dice' );
+ last SWITCH;
+ }
+ }
+ }
+ } else {
+ SWITCH: {
+ if ($lang eq "DE") {
+ $server->command('msg '.$target.' '.$nick.' baut uns bald einen riiiiiesigen d'.$dices[1].'... Mal im Ernst versuch es mit weniger Augen!' );
+ last SWITCH;
+ }
+ if ($lang eq "EN") {
+ $server->command('msg '.$target.' '.$nick.' soon will build us a biiiiiiiiiig d'.$dices[1].'... Seriously! Try less sides' );
+ last SWITCH;
+ }
+ }
+ }
+ } else {
+ if($dices[1] == "0") {
+ SWITCH: {
+ if ($lang eq "DE") {
+ $server->command('msg '.$target.' '.$nick.' ist dumm wie Knäckebrot... Oder hat jemand schonmal einen Würfel ohne Seiten gesehen?' );
+ last SWITCH;
+ }
+ if ($lang eq "EN") {
+ $server->command('msg '.$target.' '.$nick.' is chuckleheaded... Or has anybody ever seen a dice without sides?' );
+ last SWITCH;
+ }
+ }
+ }
+ if($dices[1] == "1") {
+ SWITCH: {
+ if ($lang eq "DE") {
+ $server->command('msg '.$target.' '.$nick.' ist dumm wie Dosenthunfisch... Oder hat jemand schonmal einen Würfel mit einer Seite gesehen?' );
+ last SWITCH;
+ }
+ if ($lang eq "EN") {
+ $server->command('msg '.$target.' '.$nick.' plays possum... Or has anybody ever seen a dice with only one side?' );
+ last SWITCH;
+ }
+ }
+ }
+ }
+ return 0;
+ } elsif (/^!dice: version$/i){
+ $server->command('msg '.$target.' dice Version: '.$VERSION.' by mkossin');
+ return 0;
+ } elsif (/^!dice: help$/i){
+ $server->command('msg '.$target.' '.$nick.' Please explain which dice you want to toss: "!dice: <quantity of dice>d<sides on dice>" e. g. "!dice: 2d20"');
+ return 0;
+ } elsif (/^!dice: hilfe$/i){
+ $server->command('msg '.$target.' '.$nick.' Sag mir welchen Würfel du werfen möchtest: "!dice: <Anzahl der Würfel>w<Augen des Würfels>" z. B. "!dice: 2w20"');
+ return 0;
+ } else {
+ if(!/^!dice.*:/i){
+ $server->command('msg '.$target.' '.$nick.' "!dice: help" - gives you the english help');
+ $server->command('msg '.$target.' '.$nick.' "!dice: hilfe" - zeigt die Deutsche Hilfe an');
+ return 0;
+ }
+ }
+}
+
+signal_add("message public", "public_question");
+signal_add("message own_public", "own_question");
diff --git a/scripts/dictcomplete.pl b/scripts/dictcomplete.pl
new file mode 100644
index 0000000..1f64e1b
--- /dev/null
+++ b/scripts/dictcomplete.pl
@@ -0,0 +1,78 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi qw(signal_add_last settings_add_bool settings_add_str
+ settings_get_bool settings_get_str);
+$VERSION = '1.31';
+%IRSSI = (
+ authors => 'Juerd (first version: Timo Sirainen)',
+ contact => 'juerd@juerd.nl',
+ name => 'Dictionary complete',
+ description => 'Caching dictionary based tab completion',
+ license => 'Public Domain',
+ url => 'http://juerd.nl/irssi/',
+ changed => 'Fri Dec 6 11:12 CET 2002',
+ changes => 'Removed a silly mistake'
+);
+
+my $file = '/usr/share/dict/words'; # file must be sorted!
+
+my @array;
+my %index;
+
+{
+ my $old = '';
+ my $start = 0;
+ my $pointer = 0;
+ open(DICT, q{<}, $file) or die $!;
+ while (<DICT>) {
+ chomp;
+ push @array, $_;
+ my $letter = lc substr $_, 0, 1;
+ if ($letter ne $old) {
+ $index{$old} = [ $start, $pointer - 1 ];
+ $start = $pointer;
+ }
+ $old = $letter;
+ $pointer++;
+ }
+ close DICT;
+ $index{$old} = [ $start, $pointer ];
+}
+
+my %cache;
+sub sig_complete {
+ my ($complist, $window, $word, $linestart, $want_space) = @_;
+ if (defined($cache{$word})){
+ push @$complist, @{$cache{$word}};
+ return;
+ }
+
+ my $found;
+ my $mylist = [];
+ my $regex = $word =~ /[^\w-\']/;
+ return unless my $index = (($word =~ /^[^\w-\']/)
+ ? [0, $#array]
+ : $index{lc substr $word, 0, 1});
+ eval {
+ for ($index->[0] .. $index->[1]) {
+ if ($array[$_] =~ /^$word/i) {
+ $found = 1;
+ push @$complist, $array[$_];
+ push @$mylist, $array[$_];
+ } else {
+ last if $found && not $regex;
+ }
+ }
+ }; return if $@;
+
+ $cache{$word} = $mylist;
+ my $max = settings_get_str 'dictcomplete_display' or 20;
+ $window->print(@$complist > $max ? "@$complist[0..($max-1)] ..." : "@$complist")
+ unless @$complist < 2 or settings_get_bool 'dictcomplete_quiet';
+}
+
+signal_add_last 'complete word' => \&sig_complete;
+
+settings_add_bool 'dictcomplete', 'dictcomplete_quiet' => 0;
+settings_add_str 'dictcomplete', 'dictcomplete_display' => 20;
diff --git a/scripts/dim_nicks.pl b/scripts/dim_nicks.pl
new file mode 100644
index 0000000..b66c309
--- /dev/null
+++ b/scripts/dim_nicks.pl
@@ -0,0 +1,431 @@
+use strict;
+use warnings;
+
+our $VERSION = '0.4.9';
+our %IRSSI = (
+ authors => 'Nei',
+ contact => 'Nei @ anti@conference.jabber.teamidiot.de',
+ url => "http://anti.teamidiot.de/",
+ name => 'dim_nicks',
+ description => 'Dims nicks that are not in channel anymore.',
+ license => 'GNU GPLv2 or later',
+ );
+
+# Usage
+# =====
+# Once loaded, this script will record the nicks of each new
+# message. If the user leaves the room, the messages will be rewritten
+# with the nick in another colour/style.
+#
+# Depending on your theme, tweaking the forms settings may be
+# necessary. With the default irssi theme, this script should just
+# work.
+
+# Options
+# =======
+# /set dim_nicks_color <colour>
+# * the colour code to use for dimming the nick, or a string of format
+# codes with the special token $* in place of the nick (e.g. %I$*%I
+# for italic)
+#
+# /set dim_nicks_history_lines <num>
+# * only this many lines of messages are remembered/rewritten (per
+# window)
+#
+# /set dim_nicks_ignore_hilights <ON|OFF>
+# * ignore lines with hilight when dimming
+#
+# /set dim_nicks_forms_skip <num>
+# /set dim_nicks_forms_search_max <num>
+# * these two settings limit the range where to search for the
+# nick.
+# It sets how many forms (blocks of irssi format codes or
+# non-letters) to skip at the beginning of line before starting to
+# search for the nick, and from then on how many forms to search
+# before stopping.
+# You should set this to the appropriate values to avoid (a) dimming
+# your timestamp (b) dimming message content instead of the nick.
+# To check your settings, you can use the command
+# /script exec Irssi::Script::dim_nicks::debug_forms
+
+
+no warnings 'redefine';
+use constant IN_IRSSI => __PACKAGE__ ne 'main' || $ENV{IRSSI_MOCK};
+use Irssi 20140701;
+use Irssi::TextUI;
+use Encode;
+
+
+sub setc () {
+ $IRSSI{name}
+}
+
+sub set ($) {
+ setc . '_' . $_[0]
+}
+
+my $history_lines = 100;
+my $skip_forms = 1;
+my $search_forms_max = 5;
+my $ignore_hilights = 1;
+my $color_letter = 'K';
+my @color_code = ("\cD8/"); # update this when you change $color_letter
+
+# nick object cache, chan object cache, line id cache, line id -> window map, -> channel, -> nick, -> nickname, channel -> line ids, channel->nickname->departure time, channel->nickname->{parts of line}
+my (%nick_reg, %chan_reg, %history_w, %history_c, %history_n, %history_nn, %history_st, %lost_nicks, %lost_nicks_fs, %lost_nicks_fc, %lost_nicks_bc, %lost_nicks_bs);
+
+our ($dest, $chanref, $nickref);
+
+
+sub msg_line_tag {
+ my ($srv, $msg, $nick, $addr, $targ) = @_;
+ local $chanref = $srv->channel_find($targ);
+ local $nickref = ref $chanref ? $chanref->nick_find($nick) : undef;
+ &Irssi::signal_continue;
+}
+
+sub color_to_code {
+ my $win = Irssi::active_win;
+ my $view = $win->view;
+ my $cl = $color_letter;
+ if (-1 == index $cl, '$*') {
+ $cl = "%$cl\$*";
+ }
+ $win->print_after(undef, MSGLEVEL_NEVER, "$cl ");
+ my $lp = $win->last_line_insert;
+ my $color_code = $lp->get_text(1);
+ $color_code =~ s/ $//;
+ $view->remove_line($lp);
+ @color_code = split /\$\*/, $color_code, 2;
+}
+
+sub setup_changed {
+ $history_lines = Irssi::settings_get_int( set 'history_lines' );
+ $skip_forms = Irssi::settings_get_int( set 'forms_skip' );
+ $search_forms_max = Irssi::settings_get_int( set 'forms_search_max' );
+ $ignore_hilights = Irssi::settings_get_bool( set 'ignore_hilights' );
+ my $new_color = Irssi::settings_get_str( set 'color' );
+ if ($new_color ne $color_letter) {
+ $color_letter = $new_color;
+ color_to_code();
+ }
+}
+
+sub init_dim_nicks {
+ setup_changed();
+}
+
+sub prt_text_issue {
+ my ($ld) = @_;
+ local $dest = $ld;
+ &Irssi::signal_continue;
+}
+
+sub expire_hist {
+ for my $ch (keys %history_st) {
+ if (@{$history_st{$ch}} > 2 * $history_lines) {
+ my @del = splice @{$history_st{$ch}}, 0, $history_lines;
+ delete @history_w{ @del };
+ delete @history_c{ @del };
+ delete @history_n{ @del };
+ delete @history_nn{ @del };
+ }
+ }
+}
+
+sub prt_text_ref {
+ return unless $nickref;
+ return unless $dest && defined $dest->{target};
+ return unless $dest->{level} & MSGLEVEL_PUBLIC;
+ return if $ignore_hilights && $dest->{level} & MSGLEVEL_HILIGHT;
+
+ my ($win) = @_;
+ my $view = $win->view;
+ my $line_id = $view->{buffer}{_irssi} .','. $view->{buffer}{cur_line}{_irssi};
+ $chan_reg{ $chanref->{_irssi} } = $chanref;
+ $nick_reg{ $nickref->{_irssi} } = $nickref;
+ if (exists $history_w{ $line_id }) {
+ }
+ $history_w{ $line_id } = $win->{_irssi};
+ $history_c{ $line_id } = $chanref->{_irssi};
+ $history_n{ $line_id } = $nickref->{_irssi};
+ $history_nn{ $line_id } = $nickref->{nick};
+ push @{$history_st{ $chanref->{_irssi} }}, $line_id;
+ expire_hist();
+ my @lost_forever = grep { $view->{buffer}{first_line}{info}{time} > $lost_nicks{ $chanref->{_irssi} }{ $_ } }
+ keys %{$lost_nicks{ $chanref->{_irssi} }};
+ delete @{$lost_nicks{ $chanref->{_irssi} }}{ @lost_forever };
+ delete @{$lost_nicks_fs{ $chanref->{_irssi} }}{ @lost_forever };
+ delete @{$lost_nicks_fc{ $chanref->{_irssi} }}{ @lost_forever };
+ delete @{$lost_nicks_bc{ $chanref->{_irssi} }}{ @lost_forever };
+ delete @{$lost_nicks_bs{ $chanref->{_irssi} }}{ @lost_forever };
+ return;
+}
+
+sub win_del {
+ my ($win) = @_;
+ for my $ch (keys %history_st) {
+ @{$history_st{$ch}} = grep { exists $history_w{ $_ } &&
+ $history_w{ $_ } != $win->{_irssi} } @{$history_st{$ch}};
+ }
+ my @del = grep { $history_w{ $_ } == $win->{_irssi} } keys %history_w;
+ delete @history_w{ @del };
+ delete @history_c{ @del };
+ delete @history_n{ @del };
+ delete @history_nn{ @del };
+ return;
+}
+
+sub _alter_lines {
+ my ($chan, $check_lr, $ad) = @_;
+ my $win = $chan->window;
+ return unless ref $win;
+ my $view = $win->view;
+ my $count = $history_lines;
+ my $buffer_id = $view->{buffer}{_irssi} .',';
+ my $lp = $view->{buffer}{cur_line};
+ my %check_lr = map { $_ => undef } @$check_lr;
+ my $redraw;
+ my $bottom = $view->{bottom};
+ while ($lp && $count) {
+ my $line_id = $buffer_id . $lp->{_irssi};
+ if (exists $check_lr{ $line_id }) {
+ $lp = _alter_line($buffer_id, $line_id, $win, $view, $lp, $chan->{_irssi}, $ad);
+ unless ($lp) {
+ last;
+ }
+ $redraw = 1;
+ }
+ } continue {
+ --$count;
+ $lp = $lp->prev;
+ }
+ if ($redraw) {
+ $win->command('^scrollback end') if $bottom && !$win->view->{bottom};
+ $view->redraw;
+ }
+}
+
+my $irssi_mumbo = qr/\cD[`-i]|\cD[&-@\xff]./;
+my $irssi_mumbo_no_partial = qr/(?<!\cD)(?<!\cD[&-@\xff])/;
+my $irssi_skip_form_re = qr/((?:$irssi_mumbo|[.,*@%+&!#$()=~'";:?\/><]+(?=$irssi_mumbo|\s))+|\s+)/;
+
+sub debug_forms {
+ my $win = Irssi::active_win;
+ my $view = $win->view;
+ my $lp = $view->{buffer}{cur_line};
+ my $count = $history_lines;
+ my $buffer_id = $view->{buffer}{_irssi} .',';
+ while ($lp && $count) {
+ my $line_id = $buffer_id . $lp->{_irssi};
+ if (exists $history_w{ $line_id }) {
+ my $line_nick = $history_nn{ $line_id };
+ my $text = $lp->get_text(1);
+ pos $text = 0;
+ my $from = 0;
+ for (my $i = 0; $i < $skip_forms; ++$i) {
+ last unless
+ scalar $text =~ /$irssi_skip_form_re/g;
+ $from = pos $text;
+ }
+ my $to = $from;
+ for (my $i = 0; $i < $search_forms_max; ++$i) {
+ last unless
+ scalar $text =~ /$irssi_skip_form_re/g;
+ $to = pos $text;
+ }
+ my $pre = substr $text, 0, $from;
+ my $search = substr $text, $from, $to-$from;
+ my $post = substr $text, $to;
+ unless ($to > $from) {
+ } else {
+ my @nick_reg;
+ unshift @nick_reg, quotemeta substr $line_nick, 0, $_ for 1 .. length $line_nick;
+ no warnings 'uninitialized';
+ for my $nick_reg (@nick_reg) {
+ last if $search
+ =~ s/(\Q$color_code[0]\E\s*)?((?:$irssi_mumbo)+)?$irssi_mumbo_no_partial($nick_reg)((?:$irssi_mumbo)+)?(\s*\Q$color_code[0]\E)?/<match>$1$2<nick>$3<\/nick>$4$5<\/match>/;
+ last if $search
+ =~ s/(?:\Q$color_code[0]\E)?(?:(?:$irssi_mumbo)+?)?$irssi_mumbo_no_partial($nick_reg)(?:(?:$irssi_mumbo)+?)?(?:\Q$color_code[1]\E)?/<nick>$1<\/nick>/;
+ }
+ }
+ my $msg = "$pre<search>$search</search>$post";
+ #$msg =~ s/([^[:print:]])/sprintf '\\x%02x', ord $1/ge;
+ $msg =~ s/\cDe/%|/g; $msg =~ s/%/%%/g;
+ $win->print(setc." form debug: [$msg]", MSGLEVEL_CLIENTCRAP);
+ return;
+ }
+ } continue {
+ --$count;
+ $lp = $lp->prev;
+ }
+ $win->print(setc." form debug: no usable line found", MSGLEVEL_CLIENTCRAP);
+}
+
+sub _alter_line {
+ my ($buffer_id, $lrp, $win, $view, $lp, $cid, $ad) = @_;
+ my $line_nick = $history_nn{ $lrp };
+ my $text = $lp->get_text(1);
+ pos $text = 0;
+ my $from = 0;
+ for (my $i = 0; $i < $skip_forms; ++$i) {
+ last unless
+ scalar $text =~ /$irssi_skip_form_re/g;
+ $from = pos $text;
+ }
+ my $to = $from;
+ for (my $i = 0; $i < $search_forms_max; ++$i) {
+ last unless
+ scalar $text =~ /$irssi_skip_form_re/g;
+ $to = pos $text;
+ }
+ return $lp unless $to > $from;
+ my @nick_reg;
+ unshift @nick_reg, quotemeta substr $line_nick, 0, $_ for 1 .. length $line_nick;
+ { no warnings 'uninitialized';
+ if ($ad) {
+ if (exists $lost_nicks_fs{ $cid }{ $line_nick }) {
+ my ($fs, $fc, $bc, $bs) = ($lost_nicks_fs{ $cid }{ $line_nick }, $lost_nicks_fc{ $cid }{ $line_nick }, $lost_nicks_bc{ $cid }{ $line_nick }, $lost_nicks_bs{ $cid }{ $line_nick });
+ my $sen = length $bs ? $color_code[0] : '';
+ for my $nick_reg (@nick_reg) {
+ last if
+ (substr $text, $from, $to-$from)
+ =~ s/(?:\Q$color_code[0]\E)?(?:(?:$irssi_mumbo)+?)?$irssi_mumbo_no_partial($nick_reg)(?:(?:$irssi_mumbo)+?)?(?:\Q$color_code[1]\E)?/$fc$1$bc$sen/;
+ }
+ }
+ }
+ else {
+ for my $nick_reg (@nick_reg) {
+ if (
+ (substr $text, $from, $to-$from)
+ =~ s/(\Q$color_code[0]\E\s*)?((?:$irssi_mumbo)+)?$irssi_mumbo_no_partial($nick_reg)((?:$irssi_mumbo)+)?(\s*\Q$color_code[0]\E)?/$1$2$color_code[0]$3$color_code[1]$4$5/) {
+ $lost_nicks_fs{ $cid }{ $line_nick } = $1;
+ $lost_nicks_fc{ $cid }{ $line_nick } = $2;
+ $lost_nicks_bc{ $cid }{ $line_nick } = $4;
+ $lost_nicks_bs{ $cid }{ $line_nick } = $5;
+ last;
+ }
+ }
+ } }
+ $win->gui_printtext_after($lp->prev, $lp->{info}{level} | MSGLEVEL_NEVER, "$text\n", $lp->{info}{time});
+ my $ll = $win->last_line_insert;
+ my $line_id = $buffer_id . $ll->{_irssi};
+ if (exists $history_w{ $line_id }) {
+ }
+ grep { $_ eq $lrp and $_ = $line_id } @{$history_st{ $cid }};
+ $history_w{ $line_id } = delete $history_w{ $lrp };
+ $history_c{ $line_id } = delete $history_c{ $lrp };
+ $history_n{ $line_id } = delete $history_n{ $lrp };
+ $history_nn{ $line_id } = delete $history_nn{ $lrp };
+ $view->remove_line($lp);
+ $ll;
+}
+
+sub nick_add {
+ my ($chan, $nick) = @_;
+ if (delete $lost_nicks{ $chan->{_irssi} }{ $nick->{nick} }) {
+ my @check_lr = grep { $history_c{ $_ } == $chan->{_irssi} &&
+ $history_n{ $_ } eq $nick->{nick} } keys %history_w;
+ if (@check_lr) {
+ $nick_reg{ $nick->{_irssi} } = $nick;
+ for my $li (@check_lr) {
+ $history_n{ $li } = $nick->{_irssi};
+ }
+ _alter_lines($chan, \@check_lr, 1);
+ }
+ }
+ delete $lost_nicks_fs{ $chan->{_irssi} }{ $nick->{nick} };
+ delete $lost_nicks_fc{ $chan->{_irssi} }{ $nick->{nick} };
+ delete $lost_nicks_bc{ $chan->{_irssi} }{ $nick->{nick} };
+ delete $lost_nicks_bs{ $chan->{_irssi} }{ $nick->{nick} };
+ return;
+}
+
+sub nick_del {
+ my ($chan, $nick) = @_;
+ my @check_lr = grep { $history_n{ $_ } eq $nick->{_irssi} } keys %history_w;
+ for my $li (@check_lr) {
+ $history_n{ $li } = $nick->{nick};
+ }
+ if (@check_lr) {
+ $lost_nicks{ $chan->{_irssi} }{ $nick->{nick} } = time;
+ _alter_lines($chan, \@check_lr, 0);
+ }
+ delete $nick_reg{ $nick->{_irssi} };
+ return;
+}
+
+sub nick_change {
+ my ($chan, $nick, $oldnick) = @_;
+ nick_add($chan, $nick);
+}
+
+sub chan_del {
+ my ($chan) = @_;
+ if (my $del = delete $history_st{ $chan->{_irssi} }) {
+ delete @history_w{ @$del };
+ delete @history_c{ @$del };
+ delete @history_n{ @$del };
+ delete @history_nn{ @$del };
+ }
+ delete $chan_reg{ $chan->{_irssi} };
+ delete $lost_nicks{$chan->{_irssi}};
+ delete $lost_nicks_fs{$chan->{_irssi}};
+ delete $lost_nicks_fc{$chan->{_irssi}};
+ delete $lost_nicks_bc{$chan->{_irssi}};
+ delete $lost_nicks_bs{$chan->{_irssi}};
+ return;
+}
+
+Irssi::settings_add_int( setc, set 'history_lines', $history_lines);
+Irssi::settings_add_bool( setc, set 'ignore_hilights', $ignore_hilights);
+Irssi::signal_add_last({
+ 'setup changed' => 'setup_changed',
+});
+Irssi::signal_add({
+ 'print text' => 'prt_text_issue',
+ 'gui print text finished' => 'prt_text_ref',
+ 'nicklist new' => 'nick_add',
+ 'nicklist changed' => 'nick_change',
+ 'nicklist remove' => 'nick_del',
+ 'window destroyed' => 'win_del',
+ 'message public' => 'msg_line_tag',
+ 'channel destroyed' => 'chan_del',
+});
+
+sub dumphist {
+ my $win = Irssi::active_win;
+ my $view = $win->view;
+ my $buffer_id = $view->{buffer}{_irssi} .',';
+ for (my $lp = $view->{buffer}{first_line}; $lp; $lp = $lp->next) {
+ my $line_id = $buffer_id . $lp->{_irssi};
+ if (exists $history_w{ $line_id }) {
+ my $k = $history_c{ $line_id };
+ my $kn = $history_n{ $line_id };
+ if (exists $chan_reg{ $k }) {
+ }
+ if (exists $nick_reg{ $kn }) {
+ }
+ if (exists $lost_nicks{ $k } && exists $lost_nicks{ $k }{ $kn }) {
+ }
+ }
+ }
+}
+Irssi::settings_add_str( setc, set 'color', $color_letter);
+Irssi::settings_add_int( setc, set 'forms_skip', $skip_forms);
+Irssi::settings_add_int( setc, set 'forms_search_max', $search_forms_max);
+
+init_dim_nicks();
+
+{ package Irssi::Nick }
+
+# Changelog
+# =========
+# 0.4.9
+# - fix default setting not working
+# 0.4.8
+# - optionally ignore hilighted lines
+# 0.4.7
+# - fix useless re-reading of settings colour
+# 0.4.6
+# - fix crash on some lines reported by pierrot
diff --git a/scripts/discord_unbridge.pl b/scripts/discord_unbridge.pl
new file mode 100644
index 0000000..9a7bd57
--- /dev/null
+++ b/scripts/discord_unbridge.pl
@@ -0,0 +1,45 @@
+use strict;
+use warnings;
+use Irssi;
+
+our $VERSION = '1.6';
+our %IRSSI = (
+ authors => 'Idiomdrottning',
+ contact => 'sandra.snan@idiomdrottning.org',
+ name => 'discord_unbridge.pl',
+ description => 'In channels with a discord bridge, turns "<bridge> <Sender> Message" into "<Sender> Message", and hides spoilers.',
+ license => 'Public Domain',
+ url => 'https://idiomdrottning.org/discord_unbridge.pl',
+);
+
+# HOWTO:
+#
+# set $bridgename to your bot's name, default is Yoda50.
+#
+# Regardless, to use the script just
+# /load discord_unbridge.pl
+#
+# NOTE:
+#
+# git clone https://idiomdrottning.org/discord_unbridge.pl
+# for version history and to send patches.
+#
+# Based on discord_unhilight by Christoffer Holmberg, in turn
+# based on slack_strip_auto_cc.pl by Ævar Arnfjörð Bjarmason.
+
+my $bridgename = "Yoda50";
+
+sub msg_bot_clean {
+ my ($server, $data, $nick, $nick_and_address) = @_;
+ my ($target, $message) = split /:/, $data, 2;
+ my ($name, $text) = $message =~ /< *([^>]*)> (.*)/s;
+ if ($text && $nick eq $bridgename) {
+ $nick = $name;
+ $message = $text;
+ }
+ $message =~ s/\|\|([^|]+)\|\|/1,1$1/g;
+ my $new_data = "$target:$message";
+ Irssi::signal_continue($server, $new_data, $nick, $nick_and_address);
+}
+
+Irssi::signal_add('event privmsg', 'msg_bot_clean');
diff --git a/scripts/dispatch.pl b/scripts/dispatch.pl
new file mode 100644
index 0000000..6050520
--- /dev/null
+++ b/scripts/dispatch.pl
@@ -0,0 +1,26 @@
+use strict;
+use warnings;
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.0.2";
+%IRSSI = (
+ authors => "Sebastian 'yath' Schmidt",
+ contact => "yathen\@web.de",
+ name => "Command dispatcher",
+ description => "This scripts sends unknown commands to the server",
+ license => "GNU GPLv2",
+ changed => "Tue Mar 5 14:55:29 CET 2002",
+);
+
+sub event_default_command {
+ my ($command, $server) = @_;
+ return if (Irssi::settings_get_bool("dispatch_unknown_commands") == 0
+ || !$server);
+ $server->send_raw($command);
+ Irssi::signal_stop();
+}
+
+Irssi::settings_add_bool("misc", "dispatch_unknown_commands", 1);
+Irssi::signal_add_first("default command", "event_default_command");
diff --git a/scripts/doc.pl b/scripts/doc.pl
new file mode 100644
index 0000000..4ed56d2
--- /dev/null
+++ b/scripts/doc.pl
@@ -0,0 +1,276 @@
+# Copyright (C) 02 October 2001 Author FoxMaSk <foxmask@phpfr.org>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#============================================================================
+# This script manage a list of keywords
+# with their definition...
+# The file, named "doc", is composed as follow :
+# keyword=definition
+#
+# Then, anyone on the channel can query the file and
+# if the keyword exists the script displays the definition,
+# if not ; the script /msg to $nick an appropriate message
+#
+# You can also, Add ; Modify or Delete definitions ;
+# but only *known* people can do it...
+#
+# To install it ; put the script in ~/.irssi/scripts and then
+# cd to autorun and make ln -s ../doc.pl .
+#================================WARNING======================================
+# Requirement : script friends.pl (http://irssi.atn.pl/friends/) version 2.3
+# this one permit us to identify people who can
+# addd/modify/delete records in the file
+#=============================================================================
+#
+# History :
+# Before using irssi and make this script ; i used (and continue to use)
+# an eggdrop that use this feature of querying the file to help anyone
+# on the channel to find online help on demand.
+#
+# Now :
+# I will try to merge all my tcl scripts (that i use with my egg) for irssi.
+# Then, irssi will be able to react _as_ an eggdrop, but with more functions.
+#
+# Todo :
+# 1) make it work on multi-channel
+#
+# Update :
+#
+# make it work with latest friends.pl (http://irssi.atn.pl/friends/) version 2.3
+#
+# get_idx() give me the state "Friends or Not ?"
+# instead of old is_friends() function
+#
+#
+# 2003/01/09
+# changes Irssi::get_irssi_dir()."/doc"; instead of $ENVENV{HOME}/.irssi/doc";
+# thanks to Wouter Coekaerts
+
+use Irssi::Irc;
+use Irssi;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.0.4";
+%IRSSI = (
+ authors => 'FoxMaSk',
+ contact => 'foxmask@phpfr.org ',
+ name => 'doc',
+ description => 'manage tips ; url ; help in a doc file in the keyword=definition form',
+ license => 'GNU GPL',
+ url => 'http://team.gcu-squad.org/~odemah/'
+);
+
+#name of the channel where this feature will be used
+my $channel = "#phpfr";
+
+#commands that manage the "doc" script
+#query
+my $cmd_query = "!doc";
+#add
+my $cmd_add = "!doc+";
+#delete
+my $cmd_del = "!doc-";
+#modify
+my $cmd_mod = "!doc*";
+
+#file name to store data
+my $doc_file = Irssi::get_irssi_dir()."/doc";
+
+#==========================END OF PARMS======================================
+
+#init array
+my @doc = ();
+my $x = 0;
+
+#The main function
+sub doc_find {
+ my ($server, $msg, $nick, $address, $target) = @_;
+
+ my $keyword="";
+ my $new_definition="";
+ my $definition="";
+
+ #flag if keyword is found
+ my $find="";
+
+ #*action* to do
+ my $cmd="";
+ #the string behind *action*
+ my $line="";
+
+ #to display /msg
+ my $info="";
+
+ #split the *action* and the rest of the line
+ ($cmd,$line) = split / /,$msg,2;
+
+ if ($target eq $channel) {
+
+ #to query
+ if ($cmd eq $cmd_query) {
+ $keyword = $line;
+
+ ($find,$definition) = exist_doc($keyword);
+
+ if ($find ne '') {
+ my $newmsg = join("=",$keyword,$definition);
+ $server->command("notice $target $newmsg");
+ }
+ #definition not found ; so we tell it to $nick
+ else {
+ $info="$nick $keyword does not exist";
+ info_doc($server,$info);
+ }
+ }
+
+ else {
+ my $code = Irssi::Script::friends::->can('get_idx') || Irssi::Script::friends_shasta::->can('get_idx');
+ if ($code && $code->($nick,$address) != -1) {
+ #call of friends.pl script to determine if the current
+ #$nick can manage the doc file
+ #to add
+ if ($cmd eq $cmd_add) {
+ ($keyword,$new_definition) = split /=/,$line,2;
+ ($find,$definition) = exist_doc($keyword);
+
+ #definition not found ; so we add it
+ if ($find eq '') {
+ push(@doc,"$keyword=$new_definition");
+ save_doc();
+ $info="$nick added, thank you for your contribution";
+ info_doc($server,$info);
+
+ #definition found ; so we tell it to the $nick
+ } else {
+ $info="$nick $keyword already exists";
+ info_doc($server,$info);
+ }
+ }
+ #to modify
+ elsif ($cmd eq $cmd_mod) {
+ ($keyword,$new_definition) = split /=/,$line,2;
+ ($find,$definition) = exist_doc($keyword);
+
+ #definition not found ; so we can't modify it
+ if ($find eq '') {
+ $info="$nick $keyword does not exists, can not be modified";
+ info_doc($server,$info);
+ } else {
+ del_doc($keyword) ;
+ push(@doc,"$keyword=$new_definition");
+ save_doc();
+ $info="$nick modified, thank you for your contribution";
+ info_doc($server,$info);
+ }
+ }
+ #to delete
+ elsif ($cmd eq $cmd_del) {
+ $keyword = $line;
+ ($find,$definition) = exist_doc($keyword);
+ if ($find ne '') {
+ del_doc($keyword);
+ save_doc();
+ $info="$nick definition has been removed";
+ info_doc($server,$info);
+ }
+ else {
+ $info="$nick $keyword does not exist, can't be deleted";
+ info_doc($server,$info);
+ }
+ }
+ }
+ }
+ }
+}
+
+
+#load datas
+sub load_doc {
+ my $doc_line="";
+ if (-e $doc_file) {
+ @doc = ();
+ Irssi::print("Loading doc from $doc_file");
+ local *DOC;
+ open(DOC, q{<}, $doc_file);
+ local $/ = "\n";
+ while (<DOC>) {
+ chop();
+ $doc_line = $_;
+ push(@doc,$doc_line);
+ }
+ close DOC;
+ Irssi::print("Loaded " . scalar(@doc) . " record(s)");
+ } else {
+ Irssi::print("Cannot load $doc_file");
+ }
+}
+
+#remove data
+sub del_doc {
+ my ($keyword) = @_;
+ my $key_del="";
+ my $def_del="";
+ for ($x=0;$x < @doc; $x++) {
+ ($key_del,$def_del) = split /=/,$doc[$x],2;
+ if ( $key_del eq $keyword ) {
+ splice (@doc,$x,1);
+ last;
+ }
+ }
+}
+
+#store data inf "doc" file
+sub save_doc {
+ my $keyword="";
+ my $definition="";
+ if (-e $doc_file) {
+ open(DOC, q{>}, $doc_file);
+ for ($x=0;$x < @doc;$x++) {
+ ($keyword,$definition) = split /=/,$doc[$x],2;
+ print DOC "$keyword=$definition\n";
+ }
+ close DOC;
+ }
+}
+
+#search if keyword already exists or not
+sub exist_doc {
+ my ($keyword) = @_;
+ my $key="";
+ my $def="";
+ my $find="";
+ for ($x=0;$x < @doc;$x++) {
+ ($key,$def) = split /=/,$doc[$x],2;
+ if ($key eq $keyword) {
+ $find = "*";
+ last;
+ }
+ }
+ return $find,$def;
+}
+
+#display /msg to $nick
+sub info_doc {
+ my ($server,$string) = @_;
+ $server->command("/msg $string");
+ Irssi::signal_stop();
+}
+
+load_doc();
+
+Irssi::signal_add_last('message public', 'doc_find');
+Irssi::print("Doc Management $VERSION loaded!");
+
diff --git a/scripts/doublefilter.pl b/scripts/doublefilter.pl
new file mode 100644
index 0000000..78a5c35
--- /dev/null
+++ b/scripts/doublefilter.pl
@@ -0,0 +1,113 @@
+##
+# doublefilter.pl
+#
+# Removes double messages, even if they appear on different channels.
+# The script stores every message it sees in a query or a channel into
+# a FIFO (a queue), if new, or increases the counter for that message.
+# Any message already in the FIFO is further ignored (e.g. doesn't show
+# up in any window).
+#
+# Customization:
+#
+# /set filter_length <n>
+# Sets the number of lines the script remembers in a FIFO to <n>.
+# Setting filter_length to 1 simulates the behaviour of repeat.pl, but
+# it depends on ignore_window if doublefilter.pl ignores the windows the
+# message gets to.
+# Default is currently set to 5.
+#
+# /set show_repeat on/off
+# If set to ON, shows the count for lines the script moves out of the FIFO.
+# Default is OFF.
+# (Idea is blatantly ripped from repeat.pl.)
+#
+# /set ignore_window on/off
+# If set to OFF, and if filter_length is set to 1, it emulates repeat.pl.
+# If set to ON, double messages get also filtered if they appear in different
+# windows (queries or channels).
+# Default is ON.
+# (This idea was also inspired by repeat.pl.)
+#
+# History:
+#
+# 0.1 Initial release.
+#
+# 0.2 Counter for messages
+#
+# 0.3 If desired, filters per message window, thus emulating repeat.pl
+##
+
+use strict;
+use Irssi;
+use Data::Dumper;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.3";
+%IRSSI = (
+ authors => "Karl Siegemund",
+ contact => "q \[at\] spuk.de",
+ name => "doublefilter",
+ description => "Filters msgs which appear the same on different channels.",
+ license => "GPLv2",
+ changed => "22.04.2005 9:50GMT"
+);
+
+my %lastmsgs = ();
+my %count = ();
+my %window = ();
+
+sub filter_check {
+ my $max = Irssi::settings_get_int('filter_length');
+ my $show = Irssi::settings_get_bool('show_repeat');
+ my $win = Irssi::settings_get_bool('ignore_window');
+ my ($server, $msg, $nick, undef, $target) = @_;
+ my $refnum = -1;
+ ($target, $msg) = split / :/,$msg,2;
+ if (!$win) {
+ $refnum = $server->window_find_item($target)->{refnum};
+ }
+ $msg = "<$nick> $msg";
+ if (exists $count{$refnum}{$msg}) {
+ Irssi::signal_stop();
+ ++$count{$refnum}{$msg};
+ return;
+ }
+ if(exists $lastmsgs{$refnum}) {
+ $lastmsgs{$refnum} = [ $msg, @{$lastmsgs{$refnum}} ];
+ } else {
+ $lastmsgs{$refnum} = [ $msg ];
+ }
+ if(scalar @{$lastmsgs{$refnum}} > $max) {
+ my $last = pop @{$lastmsgs{$refnum}};
+ print "$last\n*** Repeated $count{$refnum}{$last} times."
+ if $show && $count{$refnum}{$last};
+ delete $count{$refnum}{$last};
+ }
+ $count{$refnum}{$msg} = 0;
+}
+
+sub window_change {
+ my $new = shift->{refnum};
+ my $old = shift;
+
+ $count{$new} = $count{$old};
+ $lastmsgs{$new} = $lastmsgs{$old};
+
+ delete $count{$old};
+ delete $lastmsgs{$old};
+}
+
+sub window_destroyed {
+ my $ref = shift->{refnum};
+
+ delete $count{$ref};
+ delete $lastmsgs{$ref};
+}
+
+Irssi::settings_add_int ('doublefilter', 'filter_length' => '5');
+Irssi::settings_add_bool('doublefilter', 'show_repeat' => 0);
+Irssi::settings_add_bool('doublefilter', 'ignore_window' => 1);
+
+Irssi::signal_add_first('event privmsg', \&filter_check);
+Irssi::signal_add_last('window refnum changed', \&window_change);
+Irssi::signal_add_last('window destroyed', \&window_destroyed);
diff --git a/scripts/dtach_away.pl b/scripts/dtach_away.pl
new file mode 100644
index 0000000..c503668
--- /dev/null
+++ b/scripts/dtach_away.pl
@@ -0,0 +1,209 @@
+use Irssi;
+use strict;
+use FileHandle;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.0";
+%IRSSI = (
+ authors => 'Antoine Beaupré',
+ contact => 'anarcat@debian.org',
+ name => 'dtach_away',
+ description => 'set (un)away, if dtach is attached/detached',
+ license => 'GPL v2',
+ url => 'none',
+);
+
+# dtach_away irssi module
+#
+# written by Andreas 'ads' Scherbaum <ads@ufp.de>, ported to dtach by
+# anarcat.
+#
+# changes:
+# 13.11.2019 rewrite to support dtach instead of screen
+# 20.12.2014 fix the bug when screenname is changed during the session
+# 07.02.2004 fix error with away mode
+# thanks to Michael Schiansky for reporting and fixing this one
+# 07.08.2004 new function for changing nick on away
+# 24.08.2004 fixing bug where the away nick was not storedcorrectly
+# thanks for Harald Wurpts for help debugging this one
+# 17.09.2004 rewrote init part to use $ENV{'STY'}
+# 05.12.2004 add patch for remember away state
+# thanks to Jilles Tjoelker <jilles@stack.nl>
+# change "chatnet" to "tag"
+# 18.05.2007 fix '-one' for SILC networks
+#
+#
+# usage:
+#
+# put this script into your autorun directory and/or load it with
+# /SCRIPT LOAD <name>
+#
+# there are 5 settings available:
+#
+# /set dtach_away_active ON/OFF/TOGGLE
+# /set dtach_away_repeat <integer>
+# /set dtach_away_message <string>
+# /set dtach_away_window <string>
+# /set dtach_away_nick <string>
+#
+# active means, that you will be only set away/unaway, if this
+# flag is set, default is ON
+# repeat is the number of seconds, after the script will check the
+# dtach status again, default is 5 seconds
+# message is the away message sent to the server, default: not here ...
+# window is a window number or name, if set, the script will switch
+# to this window, if it sets you away, default is '1'
+# nick is the new nick, if the script goes away
+# will only be used it not empty
+#
+# normal you should be able to rename the script to something other
+# than 'dtach_away' (as example, if you dont like the name) by simple
+# changing the 'name' parameter in the %IRSSI hash at the top of this
+# script
+#
+# This requires dtach 0.9, as 0.8 and previous do not change the
+# executable bit on the socket.
+
+
+# variables
+my $timer_name = undef;
+my $away_status = 0;
+my %old_nicks = ();
+my %away = ();
+
+# Register formats
+Irssi::theme_register(
+[
+ 'dtach_away_crap',
+ '{line_start}{hilight ' . $IRSSI{'name'} . ':} $0'
+]);
+
+# register config variables
+Irssi::settings_add_bool('misc', $IRSSI{'name'} . '_active', 1);
+Irssi::settings_add_int('misc', $IRSSI{'name'} . '_repeat', 5);
+Irssi::settings_add_str('misc', $IRSSI{'name'} . '_message', "not here ...");
+Irssi::settings_add_str('misc', $IRSSI{'name'} . '_window', "1");
+Irssi::settings_add_str('misc', $IRSSI{'name'} . '_nick', "");
+Irssi::settings_add_str('misc', $IRSSI{'name'} . '_socket', "");
+
+my $socket = Irssi::settings_get_str($IRSSI{'name'} . '_socket');
+
+if (!$socket) {
+ # just return, we will never be called again
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'dtach_away_crap',
+ "need to set the path to the detach socket");
+ return;
+}
+
+# init process
+dtach_away();
+
+# dtach_away()
+#
+# check, set or reset the away status
+#
+# parameter:
+# none
+# return:
+# 0 (OK)
+sub dtach_away {
+ my ($away, @dtach, $dtach);
+
+ # only run, if activated
+ if (Irssi::settings_get_bool($IRSSI{'name'} . '_active') == 1) {
+ if ($away_status == 0) {
+ # display init message at first time
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'dtach_away_crap',
+ "activating $IRSSI{'name'} (interval: " . Irssi::settings_get_int($IRSSI{'name'} . '_repeat') . " seconds)");
+ }
+ # get actual dtach status
+ my @dtach = stat($socket);
+ # 00100 is the mode for "user has execute permissions", see stat.h
+ if (($dtach[2] & 00100) == 0) {
+ # no execute permissions, Detached
+ $away = 1;
+ } else {
+ # execute permissions, Attached
+ $away = 2;
+ }
+
+ # check if status has changed
+ if ($away == 1 and $away_status != 1) {
+ # set away
+ if (length(Irssi::settings_get_str($IRSSI{'name'} . '_window')) > 0) {
+ # if length of window is greater then 0, make this window active
+ Irssi::command('window goto ' . Irssi::settings_get_str($IRSSI{'name'} . '_window'));
+ }
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'dtach_away_crap',
+ "Set away");
+ my $message = Irssi::settings_get_str($IRSSI{'name'} . '_message');
+ if (length($message) == 0) {
+ # we have to set a message or we wouldnt go away
+ $message = "not here ...";
+ }
+ my ($server);
+ foreach $server (Irssi::servers()) {
+ if (!$server->{usermode_away}) {
+ # user isnt yet away
+ $away{$server->{'tag'}} = 0;
+ $server->command("AWAY " . (($server->{chat_type} ne 'SILC') ? "-one " : "") . "$message") if (!$server->{usermode_away});
+ if (length(Irssi::settings_get_str($IRSSI{'name'} . '_nick')) > 0) {
+ # only change, if actual nick isnt already the away nick
+ if (Irssi::settings_get_str($IRSSI{'name'} . '_nick') ne $server->{nick}) {
+ # keep old nick
+ $old_nicks{$server->{'tag'}} = $server->{nick};
+ # set new nick
+ $server->command("NICK " . Irssi::settings_get_str($IRSSI{'name'} . '_nick'));
+ }
+ }
+ } else {
+ # user is already away, remember this
+ $away{$server->{'tag'}} = 1;
+ }
+ }
+ $away_status = $away;
+ } elsif ($away == 2 and $away_status != 2) {
+ # unset away
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'dtach_away_crap',
+ "Reset away");
+ my ($server);
+ foreach $server (Irssi::servers()) {
+ if ($away{$server->{'tag'}} == 1) {
+ # user was already away, dont reset away
+ $away{$server->{'tag'}} = 0;
+ next;
+ }
+ $server->command("AWAY" . (($server->{chat_type} ne 'SILC') ? " -one" : "")) if ($server->{usermode_away});
+ if (defined($old_nicks{$server->{'tag'}}) and length($old_nicks{$server->{'tag'}}) > 0) {
+ # set old nick
+ $server->command("NICK " . $old_nicks{$server->{'tag'}});
+ $old_nicks{$server->{'tag'}} = "";
+ }
+ }
+ $away_status = $away;
+ }
+ }
+ # but everytimes install a new timer
+ register_dtach_away_timer();
+ return 0;
+}
+
+# register_dtach_away_timer()
+#
+# remove old timer and install a new one
+#
+# parameter:
+# none
+# return:
+# none
+sub register_dtach_away_timer {
+ if (defined($timer_name)) {
+ # remove old timer, if defined
+ Irssi::timeout_remove($timer_name);
+ }
+ # add new timer with new timeout (maybe the timeout has been changed)
+ $timer_name = Irssi::timeout_add(Irssi::settings_get_int($IRSSI{'name'} . '_repeat') * 1000, 'dtach_away', '');
+}
+
+
diff --git a/scripts/duckduckgo.pl b/scripts/duckduckgo.pl
new file mode 100644
index 0000000..cf45747
--- /dev/null
+++ b/scripts/duckduckgo.pl
@@ -0,0 +1,256 @@
+# duckduckgo.pl is free software: you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation, either version 3 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+use strict;
+use POSIX;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+use LWP::UserAgent;
+use HTML::Entities;
+use URI::Escape;
+
+$VERSION = '0.03';
+%IRSSI = (
+ authors => 'bw1',
+ contact => 'bw1@aol.at',
+ name => 'duckduckgo',
+ description => 'search by https://duckduckgo.com/html/',
+ license => 'lgplv3',
+ url => 'http://scripts.irssi.org',
+ changed => '2021-10-09',
+ selfcheckcmd=> 'ddg -check',
+);
+
+my $url="https://duckduckgo.com/html?q={}";
+#my $url="https://duckduckgo.com/html?q=irssi";
+my $view_count=5;
+my $browser="firefox '{}'";
+
+my @res;
+my $res_next;
+
+# fork
+my $read_handle;
+my $write_handle;
+my $forkcount=0;
+my $pipe_tag;
+
+sub www_get {
+ (my $url) =@_;
+ # Initialize LWP
+ my $ua = new LWP::UserAgent;
+ $ua->agent("duckduckgo.pl/0.1 " . $ua->agent);
+ # get
+ my $req = new HTTP::Request GET =>$url;
+ my $res = $ua->request($req);
+ return $res->content;
+}
+
+sub content2res {
+ (my $content) = @_;
+ my @content =split /\n/,$content;
+ my @res;
+ my $index=1;
+ foreach (@content) {
+ if ($_ =~ m/class="result__a"/) {
+ my %r;
+ $r{index}=$index;
+ # url
+ $_ =~ m/href="(.*?)"/;
+ $1 =~ m/uddg=(.*)&amp/;
+ my $u=uri_unescape($1);
+ $r{url}=$u;
+ # txt
+ $_ =~ m#">(.*?)</a>#;
+ my $s =$1;
+ $r{txt_raw}=$s;
+ $s=~s/<b>/%U/g;
+ $s=~s#</b>#%U#g;
+ $r{txt}=$s;
+ # out
+ push @res,{%r};
+ $index++;
+ }
+ }
+ return @res;
+}
+
+sub backgroundf {
+ (my $url, my $write_handle) =@_;
+ print "child start";
+ my $res = www_get($url);
+ print "child fertig";
+ print $write_handle $res;
+ print $write_handle "\n";
+ close $write_handle;
+}
+
+sub view_results {
+ my ($start) =@_;
+ print "duckduckgo: results ";
+ for (my $c=$start; $c < $view_count+$start && $c <= $#res; $c ++) {
+ print $c,". ",$res[$c]->{txt};
+ if (length($res[$c]->{url}) <50) {
+ print " ",$res[$c]->{url};
+ } else {
+ print " ",substr($res[$c]->{url},0,20),"=>>";
+ }
+ }
+}
+
+sub sig_result {
+ print "sig_result";
+ my $r;
+ my $o_fh;
+ # input
+ $o_fh=select($read_handle);
+ local $/;
+ select($o_fh);
+ $r=readline($read_handle);
+ close($read_handle);
+ Irssi::input_remove($pipe_tag);
+ # filter
+ @res= content2res($r);
+ $res_next=0;
+ $forkcount--;
+ view_results($res_next);
+}
+
+sub sig_config {
+ $url = Irssi::settings_get_str('ddg_url');
+ $view_count = Irssi::settings_get_int('ddg_view_count');
+}
+
+sub cmd_ddg {
+ my ($args, $server, $witem) = @_;
+
+ my @alist =split / /,$args;
+ if ($alist[0] !~ m/^-/) {
+ cmd_searchf($args);
+ } else {
+ if ($alist[0] eq '-browser') {
+ cmd_browser($alist[1]);
+ } elsif ($alist[0] eq '-next') {
+ cmd_next();
+ } elsif ($alist[0] eq '-help') {
+ cmd_help('ddg');
+ } elsif ($alist[0] eq '-drop') {
+ cmd_drop($alist[1],$witem);
+ } elsif ($alist[0] eq '-check') {
+ @res=();
+ cmd_searchf("irssi");
+ Irssi::timeout_add_once(3000,\&self_check,'');
+ }
+ }
+}
+
+sub cmd_drop {
+ my ($args, $witem) =@_;
+ if ($witem) {
+ $witem->command("/say $res[$args*1]->{url}");
+ }
+}
+
+sub cmd_next {
+ $res_next+=$view_count;
+ view_results($res_next);
+}
+
+sub cmd_searchf {
+ my ($args) = @_;
+ my $url2=$url;
+ $args=~s/ /+/g;
+ $url2=~s/{}/$args/;
+ # fork
+ if ($forkcount==0) {
+ print "ddg:",$url2;
+ $forkcount++;
+ pipe($read_handle, $write_handle);
+ my $o_fh=select($write_handle);
+ local $|=1;
+ select($o_fh);
+ my $pid =fork();
+ if (not defined $pid) {
+ _error("Can't fork: Aborting");
+ close($read_handle);
+ close($write_handle);
+ return;
+ }
+ if ($pid == 0) {
+ # child
+ backgroundf($url2,$write_handle);
+ POSIX::_exit(1);
+ } else {
+ # parent
+ close ($write_handle);
+ Irssi::pidwait_add($pid);
+ $pipe_tag = Irssi::input_add(fileno($read_handle),
+ Irssi::INPUT_READ, \&sig_result, "");
+ }
+ }
+}
+
+sub cmd_browser {
+ my ($args) = @_;
+ my $b=$browser;
+ $b =~ s/{}/$res[$args*1]->{url}/;
+ system($b);
+}
+
+sub self_check {
+ my $s='ok';
+ Irssi::print("Result count: ".scalar(@res));
+ Irssi::print("Result url: ".$res[0]->{url});
+ Irssi::print("Result txt length: ".length($res[0]->{txt}));
+ if ( scalar ( @res ) <10 ) {
+ $s= "Error: result count (".scalar(@res).")";
+ } elsif ( $res[0]->{url} !~ m/^http.*\/$/ ) {
+ $s= "Error: url (".$res[0]->{url}.")";
+ } elsif ( length($res[0]->{txt}) < 5 ) {
+ $s= "Error: txt length (".length($res[0]->{txt}).")";
+ }
+ Irssi::print("Selfcheck $s");
+ my $schs = exists $Irssi::Script::{'selfcheckhelperscript::'};
+ Irssi::command("selfcheckhelperscript $s") if ( $schs );
+}
+
+sub cmd_help {
+ if ($_[0] eq 'ddg' || $_[0] eq 'duckduckgo') {
+
+my $help = <<'END';
+/ddg <keywords> search for the keywords
+/ddg -next display the next results
+/ddg -browser <num> give the url to firefox
+/ddg -drop <num> drop the url in a channel
+/ddg -check self check
+
+settings:
+ ddg_view_count,
+ ddg_url, ddg_browser (placeholder {} )
+END
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop;
+ }
+}
+
+Irssi::settings_add_str("duckduckgo", "ddg_url", $url);
+Irssi::settings_add_str("duckduckgo", "ddg_browser", $browser);
+Irssi::settings_add_int("duckduckgo", "ddg_view_count", $view_count);
+
+Irssi::signal_add('setup changed', "sig_config");
+
+Irssi::command_bind('help',\&cmd_help);
+Irssi::command_bind("ddg", \&cmd_ddg);
+Irssi::command_set_options('ddg','help browser next drop');
+
+sig_config();
diff --git a/scripts/elist.pl b/scripts/elist.pl
new file mode 100644
index 0000000..06e934f
--- /dev/null
+++ b/scripts/elist.pl
@@ -0,0 +1,137 @@
+#!/usr/bin/perl
+
+# (c) 2007, Ilya Cassina <icassina@gmail.com>
+#
+# inspired by 'xlist.pl' by Matthäus 'JonnyBG' Wander <jbg@swznet.de>
+
+# Usage: /elist [-min <usercount>] [-max <usercount] [#]<channelmask>
+
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+use Getopt::Long;
+
+$VERSION = '1.2';
+%IRSSI = (
+ authors => 'Ilya Cassina',
+ contact => 'icassina@gmail.com',
+ name => 'Enanched LIST',
+ description => 'This script allow advanced parametrization ' .
+ 'of the /list command. Accepted parameters are ' .
+ '-minusers <#users> and -maxusers <#users>. ',
+ license => 'GPLv2',
+);
+
+use Irssi qw(
+ command_bind
+ signal_add
+);
+
+### global variables ####
+my %elist_channels = ();
+my %elist_config = ();
+
+### settings
+Irssi::settings_add_bool($IRSSI{'name'}, 'elist_colorized', 1);
+
+sub elist_channels_free {
+ %elist_channels = ();
+}
+
+sub elist_config_init {
+ %elist_config = (
+ mincount => 0,
+ maxcount => 10000,
+ yes => "",
+ chanmask => ""
+ );
+}
+
+sub elist {
+ my ($data, $server, $witem) = @_;
+
+ ### init variables ###
+ elist_config_init();
+
+ #### processing arguments using Getopt ###
+ Getopt::Long::config('permute', 'no_ignore_case');
+
+ local(@ARGV) = split(/\s/, $data,);
+ GetOptions (
+ 'mincount|m=i' => \$elist_config{"mincount"},
+ 'maxcount|M=i' => \$elist_config{"maxcount"},
+ 'yes|YES' => \$elist_config{"yes"}
+ );
+
+ ## setting chanmask (remaining argument) ##
+ if (@ARGV . length == 0) {
+ $elist_config{"chanmask"} = "";
+ } else {
+ # adding '#' character at the beginning if not already present! #
+ if ($ARGV[0] !~/^\#.*/) {
+ $elist_config{"chanmask"} = "\#". $ARGV[0];
+ } else {
+ $elist_config{"chanmask"} = $ARGV[0];
+ }
+ }
+
+ ### sending LIST command to the server ###
+ print "%K[%n".$server->{'tag'}."%K]%n %B<-->%n %m"."elist %n%B(%y"."min=%m".$elist_config{"mincount"}."%n".
+ ", %y"."max=%m".$elist_config{"maxcount"}."%n".
+ ", %y"."mask=%K'%m".$elist_config{"chanmask"}."%K'%B)";
+ $server->command("LIST " . ($elist_config{"yes"} ? "-YES " : "") . $elist_config{"chanmask"});
+}
+
+
+sub elist_collect {
+ my ($server, $data) = @_;
+
+ my (undef, $channel, $users, $topic) = split(/\s/, $data, 4);
+ $topic = substr($topic, 1);
+
+ if (!Irssi::settings_get_bool('elist_colorized')) {
+ # code below stolen from script: cleanpublic.pl by Jørgen Tjernø
+ $topic =~ s/\x03\d?\d?(,\d?\d?)?|\x02|\x1f|\x16|\x06|\x07//g;
+ }
+
+ if ($users >= $elist_config{"mincount"} and $users <= $elist_config{"maxcount"}) {
+ push @{$elist_channels{$users}}, [ $channel, $topic ];
+ }
+}
+
+sub elist_show {
+ my ($server) = @_;
+ my ($printstring, $channel);
+
+ ## keys of elist_channels are (int) users in channel ##
+ foreach (reverse sort { $a <=> $b } keys %elist_channels) {
+ my $user_count = $_;
+ ## values are arrays of [ channel_name, topic ] ##
+ foreach (@{$elist_channels{$user_count}}) {
+ $printstring = "%K[%n" . $server->{'tag'} . "%K]%n " .
+ sprintf("%4d", $user_count ) .
+ " " . @{$_}[0]; ## channel name
+ if (length @{$_}[1] > 0) {
+ $printstring .= " %B->%n " . @{$_}[1]; ## topic
+ }
+
+ print $printstring;
+ }
+ }
+
+ elist_channels_free();
+
+ print "%K[%n".$server->{'tag'}."%K]%n %B<-->%n End of %m"."elist%n";
+}
+
+command_bind('elist', \&elist);
+signal_add('event 322', \&elist_collect);
+signal_add('event 323', \&elist_show);
+
+
+##print "Usage: /elist [-min <usercount>] [-max <usercount] [#]<channelmask>"
+
+# EOF #
+# vim: set expandtab tabstop=2 shiftwidth=2:
diff --git a/scripts/eliza.pl b/scripts/eliza.pl
new file mode 100644
index 0000000..b8d5674
--- /dev/null
+++ b/scripts/eliza.pl
@@ -0,0 +1,107 @@
+# Answers to /msg's using Chatbot::Eliza when you're away.
+
+# Put definition files to ~/.irssi/eliza/*.txt
+# Uses the default definitions if there aren't any definition files.
+# http://misterhouse.net:81/mh/data/eliza/
+
+use strict;
+use 5.6.0;
+use Irssi;
+use Chatbot::Eliza;
+
+use vars qw($VERSION %IRSSI $eliza_dir @cmd_queue
+ $min_reply_time $max_reply_time
+ %conversations $conversation_expire);
+
+$VERSION = '1.0';
+%IRSSI = (
+ authors => 'Johan "Ion" Kiviniemi',
+ contact => 'ion at hassers.org',
+ name => 'Eliza',
+ description => 'Answers to /msg\'s using Chatbot::Eliza when you\'re away.',
+ license => 'Public Domain',
+ url => 'http://ion.amigafin.org/scripts/',
+ changed => 'Thu Mar 14 05:29 EET 2002',
+);
+
+$eliza_dir = Irssi::get_irssi_dir . "/eliza";
+undef $eliza_dir unless -d $eliza_dir;
+
+$min_reply_time = 5; # seconds
+$max_reply_time = 15; # seconds as well
+$conversation_expire = 600; # seconds again
+
+Irssi::timeout_add(
+ 1000 * $conversation_expire, sub {
+ foreach (keys %conversations) {
+ if ($conversations{$_}{lastmsg} < time - $conversation_expire) {
+ # The Chatbot::Eliza object will be destroyed automagically.
+ delete $conversations{$_};
+ }
+ }
+ },
+ undef
+);
+
+sub new_eliza {
+ my ($name, $eliza_o, @files) = shift;
+ if ($eliza_dir) { @files = <$eliza_dir/*.txt> }
+ if (@files) {
+ $eliza_o = Chatbot::Eliza->new(scriptfile => $files[ rand @files ])
+ || return;
+ } else {
+ $eliza_o = Chatbot::Eliza->new() || return;
+ }
+ $eliza_o->name($name);
+ return $eliza_o;
+}
+
+Irssi::signal_add(
+ 'message private' => sub {
+ # Someone just msg'ed me.
+ my ($server, $message, $nick, $address) = @_;
+ return if $nick eq $server->{nick};
+
+ # Ignore it if I'm not away.
+ return unless $server->{usermode_away};
+
+ if (not $conversations{$address}
+ and $conversations{$address}{lastmsg} < time - $conversation_expire)
+ {
+ # A new conversation.
+ $conversations{$address} = { lastmsg => time };
+ unless ($conversations{$address}{eliza} =
+ new_eliza($server->{nick}))
+ {
+ Irssi::print("Chatbot::Eliza->new() failed!",
+ MSGLEVEL_CLIENTERROR);
+ delete $conversations{$address};
+ return;
+ }
+ } else {
+ # Continuing an old conversation.
+ $conversations{$address}{lastmsg} = time;
+ }
+ push_queue($server, "msg $nick "
+ . $conversations{$address}{eliza}->transform($message));
+ }
+);
+
+sub push_queue {
+ my ($server, $command) = @_;
+ return if @cmd_queue > 3;
+ my $reply_time =
+ int(time + $min_reply_time + rand($max_reply_time - $min_reply_time));
+ push @cmd_queue, [ $reply_time, $server, $command ];
+ @cmd_queue = sort { $a->[0] <=> $b->[0] } @cmd_queue;
+}
+
+Irssi::timeout_add(
+ 1000, sub {
+ while (@cmd_queue and $cmd_queue[0][0] <= time) {
+ my $cmd = shift @cmd_queue;
+ $cmd->[1]->command($cmd->[2]);
+ }
+ },
+ undef
+);
diff --git a/scripts/email_msgs.pl b/scripts/email_msgs.pl
new file mode 100644
index 0000000..b932b85
--- /dev/null
+++ b/scripts/email_msgs.pl
@@ -0,0 +1,305 @@
+# Copyright (c) 2010 Adam James <atj@pulsewidth.org.uk>
+# Copyright (c) 2015 Igor Duarte Cardoso <igordcard@gmail.com>
+
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to deal
+# in the Software without restriction, including without limitation the rights
+# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+# THE SOFTWARE.
+
+# Changelog:
+# 1.0 - initial release, based on email_privmsgs 0.5:
+# * support for public messages as well (with/without mentions);
+# * support for own messages as well;
+# * configuration options to select what messages should be emailed:
+# - public received;
+# - private received;
+# - private sent;
+# - public sent;
+# - public mentions received.
+# * configuration option to choose whether the user must be away or not;
+# * configuration option to select message check/email interval;
+# * configuration option for the destination email address;
+# * configuration option to activate detailed info:
+# - currently only to email the user's hostname (for spam tracking e.g.).
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+use POSIX qw(strftime);
+
+use Email::Sender::Simple qw(try_to_sendmail);
+use Email::Simple;
+use Email::Simple::Creator;
+
+$VERSION = '1.1';
+%IRSSI = (
+ authors => 'Igor Duarte Cardoso, Adam James',
+ contact => 'igordcard@gmail.com, atj@pulsewidth.org.uk',
+ url =>
+ "http://www.igordcard.com",
+ name => 'email_msgs',
+ description =>
+ "Emails you messages sent/received while you're away or not. " .
+ "Works for both public mentions and private messages." .
+ "When away, it is very useful in combination with screen_away. " .
+ "Based on email_privmsgs, with advanced features and options. " .
+ "Requires Email::Sender.",
+ license => 'MIT',
+);
+
+my $FORMAT = $IRSSI{'name'} . '_crap';
+my $msgs = {};
+
+##############################################
+# your destination email address:
+my $to_addr;
+# your sender email address:
+my $from_addr;
+# email subject
+my $subject;
+# whether the script should work only when away:
+my $away_only;
+# include detailed info like the hostname of the sender:
+my $detailed;
+# interval to check for messages (in seconds):
+my $interval;
+# whether public messages received (including mentions) should be emailed:
+my $pub_r_msgs;
+# whether private messages received should be emailed:
+my $pri_r_msgs;
+# whether public messages sent should be emailed:
+my $pub_s_msgs;
+# whether private messages sent should be emailed:
+my $pri_s_msgs;
+# whether public mentions received should be emailed (when $pub_r_msgs=0):
+my $mentions;
+##############################################
+
+Irssi::settings_add_str('misc', $IRSSI{'name'} . '_from_address',
+ 'irssi@' . ($ENV{'HOST'} || 'localhost'));
+Irssi::settings_add_str('misc', $IRSSI{'name'} . '_to_address',
+ 'x@y.z');
+Irssi::settings_add_str('misc', $IRSSI{'name'} . '_subject',
+ 'IRC Messages');
+Irssi::settings_add_bool('misc', $IRSSI{'name'} . '_away_only', 0);
+Irssi::settings_add_bool('misc', $IRSSI{'name'} . '_detailed', 1);
+Irssi::settings_add_int('misc', $IRSSI{'name'} . '_interval', 300);
+Irssi::settings_add_bool('misc', $IRSSI{'name'} . '_pri_r_msgs', 1);
+Irssi::settings_add_bool('misc', $IRSSI{'name'} . '_pub_s_msgs', 1);
+Irssi::settings_add_bool('misc', $IRSSI{'name'} . '_pri_s_msgs', 1);
+Irssi::settings_add_bool('misc', $IRSSI{'name'} . '_pub_r_msgs', 0);
+Irssi::settings_add_bool('misc', $IRSSI{'name'} . '_mentions', 1);
+
+Irssi::theme_register([
+ $FORMAT,
+ '{line_start}{hilight ' . $IRSSI{'name'} . ':} $0'
+]);
+
+my ($timetag, $t_pri_r_msgs, $t_pub_s_msgs, $t_pri_s_msgs, $t_pub_r_msgs);
+Irssi::signal_add('setup changed', \&sig_setup_changed);
+
+sig_setup_changed();
+
+sub sig_setup_changed {
+ $from_addr = Irssi::settings_get_str($IRSSI{'name'} . '_from_address');
+ $to_addr = Irssi::settings_get_str($IRSSI{'name'} . '_to_address');
+ $subject = Irssi::settings_get_str($IRSSI{'name'} . '_subject');
+ $away_only = Irssi::settings_get_bool($IRSSI{'name'} . '_away_only');
+ $detailed = Irssi::settings_get_bool($IRSSI{'name'} . '_detailed');
+ my $i = Irssi::settings_get_int($IRSSI{'name'} . '_interval');
+ if ($i != $interval) {
+ $interval=$i;
+ if (defined $timetag) {
+ Irssi::timeout_remove($timetag);
+ }
+ $timetag= Irssi::timeout_add($interval*1000, 'check_messages', '');
+ }
+ my $pr = Irssi::settings_get_bool($IRSSI{'name'} . '_pri_r_msgs');
+ if ($pr != $pri_r_msgs) {
+ $pri_r_msgs= $pr;
+ if ($pri_r_msgs) {
+ Irssi::signal_add_last("message private", "handle_privmsg");
+ $t_pri_r_msgs=1;
+ } elsif (defined $t_pri_r_msgs) {
+ Irssi::signal_remove("message private", "handle_privmsg");
+ $t_pri_r_msgs=undef;
+ }
+ }
+ my $pus = Irssi::settings_get_bool($IRSSI{'name'} . '_pub_s_msgs');
+ if ($pus != $pub_s_msgs) {
+ $pub_s_msgs= $pus;
+ if ($pub_s_msgs) {
+ Irssi::signal_add_last("message own_public", "handle_ownpubmsg");
+ $t_pub_s_msgs=1;
+ } elsif (defined $t_pub_s_msgs) {
+ Irssi::signal_remove("message own_public", "handle_ownpubmsg");
+ $t_pub_s_msgs=undef;
+ }
+ }
+ my $ps = Irssi::settings_get_bool($IRSSI{'name'} . '_pri_s_msgs');
+ if ($ps != $pri_s_msgs) {
+ $pri_s_msgs= $ps;
+ if ($pri_s_msgs) {
+ Irssi::signal_add_last("message own_private", "handle_ownprivmsg");
+ $t_pri_s_msgs=1;
+ } elsif (defined $t_pri_s_msgs) {
+ Irssi::signal_remove("message own_private", "handle_ownprivmsg");
+ $t_pri_s_msgs=undef;
+ }
+ }
+ my $pur = Irssi::settings_get_bool($IRSSI{'name'} . '_pub_r_msgs');
+ my $men = Irssi::settings_get_bool($IRSSI{'name'} . '_mentions');
+ my $pm = $pub_r_msgs || $mentions;
+ $pub_r_msgs= $pur;
+ $mentions= $men;
+ if (($pub_r_msgs || $mentions) != $pm) {
+ if ($pub_r_msgs || $mentions) {
+ Irssi::signal_add_last("message public", "handle_pubmsg");
+ $t_pub_r_msgs=1;
+ } elsif (defined $t_pub_r_msgs) {
+ Irssi::signal_remove("message public", "handle_pubmsg");
+ $t_pub_r_msgs= undef;
+ }
+ }
+}
+
+sub handle_ownprivmsg {
+ my ($server, $message, $target, $orig_target) = @_;
+
+ if ($server->{usermode_away} || !$away_only) {
+ add_msg($server, $message, $server->{nick}, $from_addr, "\@$target");
+ }
+}
+
+sub handle_ownpubmsg {
+ my ($server, $message, $target) = @_;
+
+ if ($server->{usermode_away} || !$away_only) {
+ add_msg($server, $message, $server->{nick}, $from_addr, $target);
+ }
+}
+
+sub handle_privmsg {
+ my ($server, $message, $user, $address) = @_;
+
+ if ($server->{usermode_away} || !$away_only) {
+ add_msg($server, $message, $user, $address, "\@$user");
+ }
+}
+
+sub handle_pubmsg {
+ my ($server, $message, $user, $address, $target) = @_;
+
+ if ($server->{usermode_away} || !$away_only) {
+ if (index($message,$server->{nick}) >= 0 || $pub_r_msgs) {
+ add_msg($server, $message, $user, $address, $target);
+ }
+ }
+}
+
+sub check_messages {
+ if (scalar(keys(%{$msgs})) > 0) {
+ send_email();
+ $msgs = {};
+ }
+
+ return 0;
+}
+
+sub add_msg {
+ my ($server, $message, $user, $address, $target) = @_;
+
+ unless (defined $msgs->{$server->{chatnet}}) {
+ $msgs->{$server->{chatnet}} = {};
+ };
+
+ unless (defined $msgs->{$server->{chatnet}}{$target}) {
+ $msgs->{$server->{chatnet}}->{$target} = {};
+ };
+
+ unless (defined $msgs->{$server->{chatnet}}{$target}{$user}) {
+ $msgs->{$server->{chatnet}}->{$target}->{$user} = [];
+ };
+
+ push(@{$msgs->{$server->{chatnet}}->{$target}->{$user}},
+ [time, $message, $address]
+ );
+}
+
+sub generate_email {
+ my @lines = ();
+ my $detail;
+
+ if (scalar(keys(%{$msgs})) == 0) {
+ return undef;
+ }
+
+ for my $network (keys %{$msgs}) {
+ push(@lines, $network);
+ push(@lines, '=' x length($network));
+ push(@lines, '');
+
+ for my $target (keys %{$msgs->{$network}}) {
+ push(@lines, $target);
+ push(@lines, '-' x length($target));
+ for my $user (keys %{$msgs->{$network}{$target}}) {
+ for my $ele (@{$msgs->{$network}->{$target}->{$user}}) {
+ $detail = $detailed ? " ($ele->[2])" : "";
+ push(@lines, sprintf("[%s] <%s> %s%s",
+ strftime("%T", localtime($ele->[0])),
+ $user, $ele->[1], $detail)
+ );
+ }
+ push(@lines, '');
+ }
+ }
+ }
+
+ return \@lines;
+}
+
+sub send_email {
+ my $body = generate_email();
+
+ unless (defined($body)) {
+ return;
+ }
+
+ my $email = Email::Simple->create(
+ header => [
+ To => $to_addr,
+ From => $from_addr,
+ Subject => $subject,
+ ],
+ body => join("\n", @{$body}),
+ );
+
+ if (! try_to_sendmail($email)) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, $FORMAT,
+ "an error occurred when sending an email to " .
+ Irssi::settings_get_str($IRSSI{'name'} . '_to_address') .
+ " from " .
+ Irssi::settings_get_str($IRSSI{'name'} . '_from_address') .
+ " subject " .
+ Irssi::settings_get_str($IRSSI{'name'} . '_subject') .
+ " with content:\n" .
+ join("\n", @{$body})
+ );
+ }
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, $FORMAT,
+ "A message was sent to your email.");
+}
diff --git a/scripts/emaildb.pl b/scripts/emaildb.pl
new file mode 100644
index 0000000..30b5228
--- /dev/null
+++ b/scripts/emaildb.pl
@@ -0,0 +1,131 @@
+#!/usr/bin/perl
+# Please note that some MySQL experience is required to use this script.
+#
+# You must have the appropriate tools installed for MySQL and Perl to "talk"
+# to each other... specifically perl dbi and DBD::mysql
+#
+# You must set up the following table `13th` in your mysql database:
+#
+# +----------+-------------+------+-----+---------+-------+
+# | Field | Type | Null | Key | Default | Extra |
+# +----------+-------------+------+-----+---------+-------+
+# | nickname | varchar(40) | YES | | NULL | |
+# | email | varchar(40) | YES | | NULL | |
+# | birthday | varchar(40) | YES | | NULL | |
+# +----------+-------------+------+-----+---------+-------+
+#
+# I suggest you set up a separate user in the mysql database to use this script
+# with only permission to SELECT from this database.
+# </paranoia>
+#
+# change the settings in irssi (see /set emaildb).
+#
+# if you choose to make this accessible by users on a user-list only, create
+# a text file called "emaildb_users" in your home .irssi directory, add the nicknames
+# of users you wish to give access in this format:
+#
+# PrincessLeia2
+# R2D2
+# Time
+#
+# I never created an interface to add new nicknames, email, and birthday,
+# so you will need to manually insert this information into the database
+#
+# This script allows a user to search the database by using the command ~search nickname
+# (in channel, or in pm) it will respond with a private message. It will match full and
+# partial nicknames while it does it's search (if you search for 't' it will give you
+# results of any nicknames with a 't' i nthem)
+#
+# Personally, I run this in an ircbot, as the owner of this script cannot use
+# the ~nick command themselves
+#
+#
+# ... That's about it, enjoy!
+#
+
+use strict;
+use Irssi;
+use DBI;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.2";
+%IRSSI = (
+ authors => 'PrincessLeia2',
+ contact => 'lyz\@princessleia.com ',
+ name => 'emaildb',
+ description => 'a script for accessing an email mysql database through irc',
+ license => 'GNU GPL v2 or later',
+ url => 'http://www.princessleia.com/'
+);
+
+my $LIST;
+my @user;
+my $filename = Irssi::get_irssi_dir().'/emaildb_users';
+if (! -e $filename) {
+ my $fa;
+ open $fa, '>', $filename;
+ close $fa;
+}
+open ( $LIST, '<', $filename ) or die "can't open users:$!\n";
+chomp( @user = <$LIST> );
+close $LIST;
+
+if (1 > @user) {
+ Irssi::print("%RWarning:%n no users defined (see: $filename)",MSGLEVEL_CLIENTNOTICE);
+}
+
+# database
+my $d;
+# user
+my $u;
+# password
+my $p;
+
+sub event_privmsg {
+my ($server, $data, $nick, $mask, $target) =@_;
+my ($ta, $text) = $data =~ /^(\S*)\s:(.*)/;
+ if ($text =~ /^~search */i ) {
+ foreach my $person (@user) {
+ if ($nick =~ /^$person$/i) {
+ my ($nickname) = $text =~ /^~search (.*)/;
+
+ my $dbh = DBI->connect("DBI:mysql:$d","$u","$p")
+ or die "Couldn't connect to database: " . DBI->errstr;
+ my $sth = $dbh->prepare("SELECT * FROM 13th where nickname like \"\%$nickname\%\";")
+ or die "Cant prepare statement: $dbh->errstr\n";
+ my $rv = $sth->execute
+ or die "cant execute the query: $sth->errstr\n";
+ if ($rv >= 1) {
+ my @row;
+ while ( @row = $sth->fetchrow_array( ) ) {
+ my $n = "$row[0]\n";
+ my $e = "$row[1]\n";
+ my $b = "$row[2]\n";
+ $server->command ( "msg $nick Nickname : $n" );
+ $server->command ( "msg $nick Email : $e" );
+ $server->command ( "msg $nick Birthday : $b" );
+ }
+ } else {
+ $server->command ( "msg $nick Sorry, No Results Match Your Query\n" );
+ }
+ }
+ }
+ }
+}
+
+sub event_setup_changed {
+ $d=Irssi::settings_get_str($IRSSI{name}.'_database');
+ $u=Irssi::settings_get_str($IRSSI{name}.'_user');
+ $p=Irssi::settings_get_str($IRSSI{name}.'_password');
+}
+
+Irssi::signal_add('event privmsg', 'event_privmsg');
+Irssi::signal_add('setup changed','event_setup_changed');
+
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_database', 'database');
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_user', 'user');
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_password', 'password');
+
+event_setup_changed();
+
+# vim:set ts=4 sw=2 expandtab:
diff --git a/scripts/emaildb1.0.pl b/scripts/emaildb1.0.pl
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/scripts/emaildb1.0.pl
diff --git a/scripts/eng_no_translate_dpryo.pl b/scripts/eng_no_translate_dpryo.pl
new file mode 100644
index 0000000..f00f40c
--- /dev/null
+++ b/scripts/eng_no_translate_dpryo.pl
@@ -0,0 +1,57 @@
+# A simple script for all Norwegians who like to get
+# all incoming english text translated to Norwegian :D
+# Written by dpryo <hnesland@samsen.com>
+#
+# WARNING:
+# Dunno what freetranslation.com thinks about it ;D
+# ..so remember, this scripts sends ALL incoming public messages
+# as a webrequest to their server. That is, one request pr.
+# message you get. In other words, if somebody pubfloods 100 lines, you will
+# visit freetranslation.com 100 times ;)
+######
+#
+# There is at least one bug in it .. It doesn't check wether the
+# incoming text is english or not before it sends the request.
+#
+# Somebody could perhaps fix that?, since i'm a lazy asshole.
+#
+# Another thing, it doesn't handles channels or anything, so
+# I could call this a "Technology Preview" as all the big
+# guys are calling their software when it's in a buggy and
+# not-so-very-usefull stage of development :P
+#
+use Irssi;
+use LWP::Simple;
+use vars qw($VERSION %IRSSI);
+$translate =0;
+
+$VERSION = "0.2";
+%IRSSI = (
+ authors => "Harald Nesland",
+ contact => "hnesland\@samsen.com",
+ name => "EngNoTranslate",
+ description => "Very simple script that sends incoming text to freetranslation.com for english->norwegian translation. May be modified to translate other languages.",
+ license => "Public Domain",
+ url => "http://www.satyra.net",
+ changed => "Thu Apr 11 14:15:25 CEST 2002"
+);
+
+sub income {
+my ($server, $data, $nick, $mask, $target) = @_;
+ $eng = $data;
+ if($translate=1) {
+ $eng =~ s/ /+/ig;
+ chop($eng);
+ Irssi::command("/echo [$nick] $eng");
+ $result = get("http://ets.freetranslation.com:5081/?Sequence=core&Mode=txt&template=TextResults2.htm&Language=English/Norwegian&SrcText=$eng");
+ Irssi::command("/echo [$nick] $result");
+ }
+}
+
+sub trans {
+
+ if($translate =0) { $translate=1; } else { $translate =0; }
+}
+
+Irssi::signal_add("message public", "income");
+Irssi::command_bind("translate","trans");
diff --git a/scripts/events.pl b/scripts/events.pl
new file mode 100644
index 0000000..4886fb7
--- /dev/null
+++ b/scripts/events.pl
@@ -0,0 +1,54 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+use Irssi::Irc;
+
+$VERSION = '1.0';
+%IRSSI = (
+ authors => 'Taneli Kaivola',
+ contact => 'dist@sci.fi',
+ name => 'Extended events',
+ description => 'Expand "event mode" and emit "event mode {channel,user,server} *"',
+ license => 'GPLv2',
+ url => 'http://scripts.irssi.de',
+ changed => 'Mon May 20 04:04:47 EEST 2002',
+);
+
+sub event_mode {
+ my($server,$args,$nick,$addr)=@_;
+ my($target,$modes,$modeparms)=split(" ",$args,3);
+ my(@modeparm)=split(/ /,$modeparms);
+ my($target_type)="other";
+ my($chan);
+ my($modetype)="";
+ my($pos)=0;
+
+ if($target =~ /^#/) {
+ $chan=$server->channel_find($target);
+ $target_type="channel";
+ }
+
+ #emit $chan $mode $param
+ if($target_type eq "channel") {
+ foreach my $mode (split(//,$modes)) {
+ if($mode eq "+" || $mode eq "-") {
+ $modetype=$mode;
+ } elsif($mode =~ /[vbkeIqhdOo]/ || ($mode eq "l" && $modetype eq "+")) { # Thanks friends.pl
+ Irssi::signal_emit("event mode $target_type ".$modetype.$mode,$chan,$nick,$modeparm[$pos]);
+ $pos++;
+ } else {
+ Irssi::signal_emit("event mode $target_type ".$modetype.$mode,$chan,$nick);
+ }
+ }
+ } else {
+ # Some user/server/other? mode
+ # print "Target: [$target] Modes: [$modes] Modeparms: [$modeparms]";
+ }
+}
+Irssi::signal_add_last("event mode",\&event_mode);
+
+# Signals you can catch after loading this script:
+# "event mode channel {+o,-o,+v,-v,+b,-b,+k,+e,-e,+I,-I,+q,-q,+h,-h,+d,-d,+O,-O,+l}"
+# "event mode user {}" (Maybe soon)
+# "event mode server {}" (Maybe soon)
diff --git a/scripts/exec_clean.pl b/scripts/exec_clean.pl
new file mode 100644
index 0000000..766627f
--- /dev/null
+++ b/scripts/exec_clean.pl
@@ -0,0 +1,52 @@
+# $Id: exec-clean.pl,v 1.6 2002/07/04 13:18:02 jylefort Exp $
+
+use strict;
+use Irssi 20020121.2020 ();
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.01";
+%IRSSI = (
+ authors => 'Jean-Yves Lefort',
+ contact => 'jylefort\@brutele.be, decadix on IRCNet',
+ name => 'exec-clean',
+ description => 'Adds a setting to automatically terminate a process whose parent window has been closed',
+ license => 'BSD',
+ url => 'http://void.adminz.be/irssi.shtml',
+ changed => '$Date: 2002/07/04 13:18:02 $ ',
+);
+
+# /set's:
+#
+# autokill_orphan_processes
+#
+# guess :)
+#
+# changes:
+#
+# 2002-07-04 release 1.01
+# * signal_add's uses a reference instead of a string
+#
+# 2002-04-25 release 1.00
+# * increased version number
+#
+# 2002-01-28 initial release
+#
+# todo:
+#
+# * kill the process using a better method (TERM -> sleep -> KILL etc)
+
+use Irssi::UI;
+
+sub window_destroyed {
+ my ($window) = @_;
+
+ foreach (Irssi::UI::processes()) {
+ if ($_->{target_win}->{refnum} == $window->{refnum}
+ && Irssi::settings_get_bool("autokill_orphan_processes")) {
+ kill 15, $_->{pid};
+ return;
+ }
+ }
+}
+
+Irssi::signal_add("window destroyed", \&window_destroyed);
+Irssi::settings_add_bool("misc", "autokill_orphan_processes", 1);
diff --git a/scripts/fakectcp.pl b/scripts/fakectcp.pl
new file mode 100644
index 0000000..73fe490
--- /dev/null
+++ b/scripts/fakectcp.pl
@@ -0,0 +1,277 @@
+#!/usr/bin/perl -w
+
+## Bugreports and Licence disclaimer.
+#
+# For bugreports and other improvements contact Geert Hauwaerts <geert@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+##
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.04";
+
+%IRSSI = (
+ authors => 'Geert Hauwaerts',
+ contact => 'geert@irssi.org',
+ name => 'fakectcp.pl',
+ description => 'This script sends fake ctcp replies to a client using a fake ctcp list.',
+ license => 'GNU General Public License',
+ url => 'http://irssi.hauwaerts.be/default.pl',
+ changed => '2018-09-17',
+);
+
+my @fakectcp = ();
+my $fakectcp_file = "fctcplist";
+my $irssidir = Irssi::get_irssi_dir();
+
+my $help = <<EOF;
+
+Usage: (all on one line)
+/FCTCP [-add||-replace <ctcp-item> <ctcp-reply>] [-del <ctcp-item>] [-list] [-help]
+
+-add: Add a new fake ctcp-reply to the list.
+-del: Delete a fake ctcp-reply from the list.
+-list: Display the contents of the fake ctcp-reply list.
+-help: Display this useful little helpfile.
+-replace: Replace an existing fake reply with a new one. If the old one doesn't exist, the new one will be added by default.
+
+Examples: (all on one line)
+/FCTCP -add CHRISTEL We all love christel, don't we! :)
+/FCTCP -add LOCATION I'm at home, reading some helpfiles.
+
+/FCTCP -del CHRISTEL
+/FCTCP -del LOCATION
+
+Note: The caps are not obligated. The default parameter is -list.
+EOF
+
+Irssi::theme_register([
+ 'fctcp_info', ' # ctcpitem ctcpreply',
+ 'fctcp_empty', '%R>>%n %_FCTCP:%_ Your fake ctcp list is empty.',
+ 'fctcp_added', '%R>>%n %_FCTCP:%_ Added %_$0%_ ($1) to the fake ctcp list.',
+ 'fctcp_replaced', '%R>>%n %_FCTCP:%_ Replaced the old fake reply %_$0%_ with the new one ($1)',
+ 'fctcp_delled', '%R>>%n %_FCTCP:%_ Deleted %_$0%_ from the fake ctcp list.',
+ 'fctcp_nfound', '%R>>%n %_FCTCP:%_ Can\'t find $0 in the fake ctcp list.',
+ 'fctcp_delusage', '%R>>%n %_FCTCP:%_ Usage: /FCTCP -del <ctcp-item>',
+ 'fctcp_usage', '%R>>%n %_FCTCP:%_ Usage: /FCTCP -add <ctcp-item> <ctcp-reply>',
+ 'fctcp_repusage', '%R>>%n %_FCTCP:%_ Usage: /FCTCP -replace <ctcp-item> <ctcp-reply>',
+ 'fctcp_nload', '%R>>%n %_FCTCP:%_ Could not load the fake ctcp list.',
+ 'fctcp_request', '%R>>%n %_FCTCP:%_ Used the fake reply %_$1%_ on %_$0%_',
+ 'fctcp_loaded', '%R>>%n %_FCTCP:%_ The fake reply %_$0%_ already exists, use %_/FCTCP -del $0%_ to remove it from the list.',
+ 'fctcp_print', '$[!-2]0 $[20]1 $2',
+ 'fctcp_help', '$0',
+ 'loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.'
+]);
+
+sub ctcpreply {
+
+ my ($server, $data, $nick, $address, $target) = @_;
+ my ($findex);
+
+ $data = lc($data);
+
+ return unless (lc($server->{nick}) eq lc($target));
+
+ if (!already_loaded($data)) {
+ $findex = check_loaded($data);
+ $server->command("^NCTCP $nick $data $fakectcp[$findex]->{reply}");
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_request', $nick, $data);
+ Irssi::signal_stop();
+ }
+}
+
+sub new_fctcp {
+
+ my $fctcp = {};
+
+ $fctcp->{item} = shift;
+ $fctcp->{reply} = shift;
+
+ return $fctcp;
+}
+
+sub already_loaded {
+
+ my ($item) = @_;
+ my $loaded = check_loaded($item);
+
+ if ($loaded > -1) {
+ return 0;
+ }
+
+ return 1;
+}
+
+sub check_loaded {
+
+ my ($item) = @_;
+
+ $item = lc($item);
+
+ for (my $loaded = 0; $loaded < @fakectcp; ++$loaded) {
+ return $loaded if (lc($fakectcp[$loaded]->{item}) eq $item);
+ }
+
+ return -1;
+}
+
+sub load_fakectcplist {
+
+ my ($file) = @_;
+
+ @fakectcp = ();
+
+ if (-e $file) {
+ local *F;
+ open(F, "<", $file);
+ local $/ = "\n";
+
+ while (<F>) {
+ chop;
+ my $new_fctcp = new_fctcp(split("\t"));
+
+ if (($new_fctcp->{item} ne "") && ($new_fctcp->{reply} ne "")) {
+ push(@fakectcp, $new_fctcp);
+ }
+ }
+
+ close(F);
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_nload');
+ }
+}
+
+sub save_fakectcplist {
+
+ my ($file) = @_;
+
+ local *F;
+ open(F, ">", $file) or die "Could not load the fake ctcpreply list for writing";
+
+ for (my $n = 0; $n < @fakectcp; ++$n) {
+ print(F join("\t", $fakectcp[$n]->{item}, $fakectcp[$n]->{reply}) . "\n");
+ }
+
+ close(F);
+}
+
+sub addfakectcp {
+
+ my ($ctcpitem, $ctcpreply) = split (" ", $_[0], 2);
+
+ if (($ctcpitem eq "") || ($ctcpreply eq "")) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_usage');
+ return;
+ } elsif (!already_loaded($ctcpitem)) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_loaded', $ctcpitem);
+ return;
+ }
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_added', $ctcpitem, $ctcpreply);
+ push(@fakectcp, new_fctcp($ctcpitem, $ctcpreply));
+ save_fakectcplist("$irssidir/$fakectcp_file");
+}
+
+sub delfakectcp {
+
+ my ($fdata) = @_;
+ my ($fdataindex);
+
+ if ($fdata eq "") {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_delusage');
+ return;
+ }
+
+ for (my $index = 0; $index < @fakectcp; ++$index) {
+ if (lc($fakectcp[$index]->{item}) eq $fdata) {
+ $fdataindex = splice(@fakectcp, $index, 1);
+ }
+ }
+
+ if ($fdataindex) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_delled', $fdata);
+ save_fakectcplist("$irssidir/$fakectcp_file");
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_nfound', $fdata);
+ }
+}
+
+sub replacefakectcp {
+
+ my ($ctcpitem, $ctcpreply) = split (" ", $_[0], 2);
+ my ($fdataindex);
+
+ if (($ctcpitem eq "") || ($ctcpreply eq "")) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_repusage');
+ return;
+ }
+
+ if (!already_loaded($ctcpitem)) {
+ for (my $index = 0; $index < @fakectcp; ++$index) {
+ if (lc($fakectcp[$index]->{item}) eq $ctcpitem) {
+ $fdataindex = splice(@fakectcp, $index, 1);
+ } elsif ($fdataindex) {
+ save_fakectcplist("$irssidir/$fakectcp_file");
+ }
+ }
+ }
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_replaced', $ctcpitem, $ctcpreply);
+ push(@fakectcp, new_fctcp($ctcpitem, $ctcpreply));
+ save_fakectcplist("$irssidir/$fakectcp_file");
+}
+
+sub fakectcp {
+
+ my ($cmdoption, $ctcpitem, $ctcpreply) = split (" ", $_[0], 3);
+
+ $ctcpitem = lc($ctcpitem);
+ $cmdoption = lc($cmdoption);
+
+ if ($cmdoption eq "-add") {
+ addfakectcp("$ctcpitem $ctcpreply");
+ return;
+ } elsif ($cmdoption eq "-del") {
+ delfakectcp("$ctcpitem");
+ return;
+ } elsif ($cmdoption eq "-help") {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_help', $help);
+ return;
+ } elsif ($cmdoption eq "-replace") {
+ replacefakectcp("$ctcpitem $ctcpreply");
+ return;
+ }
+
+ if (@fakectcp == 0) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_empty');
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_info');
+
+ for (my $n = 0; $n < @fakectcp ; ++$n) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_print', $n, $fakectcp[$n]->{item}, $fakectcp[$n]->{reply});
+ }
+ }
+}
+
+load_fakectcplist("$irssidir/$fakectcp_file");
+
+Irssi::signal_add('ctcp msg', 'ctcpreply');
+Irssi::command_bind('fctcp', 'fakectcp');
+Irssi::command_set_options('fctcp','add del list help replace');
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
diff --git a/scripts/figlet.pl b/scripts/figlet.pl
new file mode 100644
index 0000000..3f8ca6d
--- /dev/null
+++ b/scripts/figlet.pl
@@ -0,0 +1,58 @@
+use IPC::Open3;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi qw(command_bind active_win);
+$VERSION = "1.14";
+%IRSSI = (
+ authors => 'Juerd',
+ contact => 'juerd@juerd.nl',
+ name => 'Figlet',
+ description => 'Safe figlet implementation (with color support!)',
+ license => 'Public Domain',
+ url => 'http://juerd.nl/irssi/',
+ changed => 'Sun 10 Mar 14:46 CET 2002',
+ changes => 'No more zombie processes',
+);
+
+command_bind(
+ figlet => sub {
+ my ($msg) = @_;
+ my @figlet;
+ my $prefix = '';
+ while ($msg =~ s/
+ ^(
+ [^\cC\cB\cO\c_]+
+ |
+ (?:
+ \cC\d*(?:,\d*)?
+ |
+ [\cB\cO\c_]
+ )+
+ )
+ //x) {
+ my $part = $1;
+ if ($part =~ /[\cC\cB\cO\c_]/) {
+ if (@figlet) {
+ $_ .= $part for @figlet;
+ } else {
+ $prefix = $part;
+ }
+ } else {
+ my $i = 0;
+ my $pid = open3(undef, *FIG, *FIG, qw(figlet -k), $part);
+ while (<FIG>) {
+ chomp;
+ $figlet[$i++] .= $_;
+ }
+ close FIG;
+ waitpid $pid, 0;
+ }
+ }
+ for (@figlet) {
+ (my $copy = $_) =~ s/\cC\d*(?:,\d*)?|[\cB\cO\c_]//g;
+ next unless $copy =~ /\S/;
+ active_win->command("say $prefix$_");
+ }
+ }
+);
diff --git a/scripts/file.pl b/scripts/file.pl
new file mode 100644
index 0000000..fe58bcc
--- /dev/null
+++ b/scripts/file.pl
@@ -0,0 +1,102 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Getopt::Long qw/GetOptionsFromString/;
+
+my $help = <<EOF;
+Usage: (all on one line)
+/file [-raw] [-command]
+ [-msg [target]] [-notice [target]]
+ [-prefix "text"] [-postfix "text"]
+ filename
+
+-raw: output contents of file as raw irc data
+-command: run contents of file as irssi commands
+-msg: send as messages to active window (default) or target
+-notice: send as notices to active window or target
+
+-prefix: add "text" in front of output
+-postfix: add "text" after output
+
+-echo print contents of file to active window
+EOF
+
+$VERSION = 1.1;
+%IRSSI = (
+ authors => "David Leadbeater",
+ name => "file.pl",
+ description => "A command to output content of files in various ways",
+ license => "GNU GPLv2 or later",
+ url => "http://irssi.dgl.cx/"
+);
+
+Irssi::command_bind('file', sub {
+ my $data = shift;
+
+ if($data eq 'help') {
+ print $help;
+ return;
+ }
+
+ my($type, $target, $prefix, $postfix, $echo);
+
+ $type = 'msg';
+ $target = '*';
+ $prefix = '';
+ $postfix = '';
+
+ my ($raw,$command,$msg,$notice,$filename);
+
+ my ($ret, $args) = GetOptionsFromString($data,
+ 'raw' => \$raw,
+ 'command' => \$command,
+ 'msg:s' => \$msg,
+ 'notice:s' => \$notice,
+ 'prefix=s' => \$prefix,
+ 'postfix=s' => \$postfix,
+ 'echo' => \$echo,
+ );
+ $filename = $$args[-1];
+ $type ='raw' if (defined $raw);
+ $type ='command' if (defined $command);
+ $type ='echo' if (defined $echo);
+ if (defined $notice) {
+ $type ='notice';
+ if ($notice ne '') {
+ $target = $notice;
+ }
+ }
+ if (defined $msg) {
+ $type ='msg';
+ if ($msg ne '') {
+ $target = $msg;
+ }
+ }
+
+ # or do borrowed from one of juerd's scripts (needs 5.6 though)
+ open(FILE, "<", $filename) or do {
+ print "Error opening '$filename': $!";
+ return;
+ };
+
+ while(<FILE>) {
+ chomp;
+
+ if($type eq 'raw') {
+ Irssi::active_server->send_raw($prefix . $_ . $postfix);
+ }elsif($type eq 'command') {
+ Irssi::active_win->command($prefix . $_ . $postfix);
+ }elsif($type eq 'echo') {
+ Irssi::active_win->print($prefix . $_ . $postfix);
+ }else{
+ Irssi::active_win->command("$type $target $prefix$_$postfix");
+ }
+ }
+
+ close FILE;
+
+} );
+
+# little known way to get -options to tab complete :)
+Irssi::command_set_options('file','raw command prefix postfix msg notice echo');
+
+# vim:set ts=3 sw=3 expandtab:
diff --git a/scripts/find.pl b/scripts/find.pl
new file mode 100644
index 0000000..507975e
--- /dev/null
+++ b/scripts/find.pl
@@ -0,0 +1,45 @@
+# /FIND - display people who are in more than one channel with you
+# (it's ugly code)
+
+use strict;
+use Irssi;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.2";
+%IRSSI = (
+ authors => "Erkki Seppälä",
+ contact => "flux\@inside.org",
+ name => "Find",
+ description => "Finds a nick by real name, if he's on a channel with you.",
+ license => "Public Domain",
+ url => "http://xulfad.inside.org/~flux/software/irssi/",
+ changed => "Mon Mar 4 23:25:18 EET 2002"
+);
+
+
+sub cmd_find {
+ my ($findName, $server, $channel) = @_;
+
+ if ($findName eq "") {
+ Irssi::print("usage: /find erkki");
+ return 1;
+ }
+
+ my %channicks, $channel;
+ my %found;
+
+ foreach $channel (Irssi::active_server()->channels()) {
+ foreach my $nick ($channel->nicks()) {
+ $found{$nick->{nick}} = 1 if $nick->{realname} =~ /$findName/i;
+ }
+ }
+
+ if (keys %found) {
+ Irssi::print($findName . " could be found with these nicks: " . join(", ", keys %found));
+ } else {
+ Irssi::print("Sorry, " . $findName . " could not be found.");
+ }
+ return 1;
+}
+
+Irssi::command_bind('find', 'cmd_find');
diff --git a/scripts/findbot.pl b/scripts/findbot.pl
new file mode 100644
index 0000000..753fc31
--- /dev/null
+++ b/scripts/findbot.pl
@@ -0,0 +1,984 @@
+###############################################################################
+# Find script that searches your local files and sends them to users
+# Copyright (C) 2003 Thomas Karlsson
+#
+# Findbot script, which responds to @find commands in irc channels
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# Thomas Karlsson (findbot@planet.eu.org)
+#
+###############################################################################
+# Description:
+#
+# This script loads into an Irssi client and then monitors selected channels
+# and replies to public channel commands.
+# The commands are:
+# @find : searches the summaryfile after file "@find birthday" looks for
+# a file containing birthday.
+# @<botnick>-stats : Replies with the users queue.
+# @<botnick>-remove : Will remove the users whole queue
+# @<botnick>-remove 2 : Will remove queue position 2 from the queue
+# @<botnick>-help : Will message the help to the user.
+# !<botnick> <filename> :Will queue the file. For eg."!santa_claus jingle.bells.mp3"
+#
+###############################################################################
+# Installation:
+#
+# AT THE END OF THIS FILE IS ALL INSTALLATION INSTRUCTIONS!!
+#
+# Variables:
+# findbot_channels - Space separated channels (#mp3 #othermp3)
+# findbot_summaryfile - Full path to the "mymp3s.txt" file (/misc/mp3/mymp3s.txt)
+# findbot_sendlist - Full path and filename to the list that is sent to clients
+# findbot_maxresults - Max findresults returned to the requesting client
+# findbot_maxqueue - Max files allowed in the queue
+# findbot_maxsends - Max simultanous sends allowed
+# findbot_maxuserqueue - Max queued files per Nick
+# findbot_maxusersends - Max simultanous sends per Nick
+# findbot_showbanner - Present a banner in every "findbot_channels" channel
+# findbot_bannertime - How many seconds between each banner
+# findbot_minspeed - Minimum CPS for a send, 10000 means 10kb/s, 0 means disabled
+# findbot_mustbeinchannel - If ON, the user is required to be in the channel during download
+# findbot_debuglevel - Debuglevel, Higher value equals more debugoutput
+# findbot_enabled - Set ON or OFF
+# findbot_timeslots - When the server should be enabled (sat=10:00-18:00sun=00:00-23:59)
+# If a day can't be found the bot will be ON by default
+# findbot_voicegetpriority - If ON then voiceuserusers and ops will get priority in the queue.
+# Ops get 20 in priority and voice gets 10. I.e ops are more prioritized than voice
+#
+# Admincommands:
+# /findbotqueue - Shows you the whole queue in the findbot window
+# /findbotremove - Admin removes queueitems
+# /findbotreset - If you like you can specify how many sends the script thinks it have. This was just added
+# if you wanted to send somefiles your self without the script sending files.
+# /findbotreload - Reloads the summaryfile if you have added files
+# /findbotactivesends - Show which users are currently having a download
+#
+###############################################################################
+# TODO or maybe features
+#
+# * When requesting it SHOULD be case sensitive
+# * Support CTCP SLOTS and CTCP MP3, seems unnecessary to help windows-mirc users :)
+# Slots Free Next Queues Max Sendspeed Files
+# 4 4 NOW 0 999 0 120575 36856591362 0 1073595728 1
+# * Make an ignore and ban function
+# * Should the users see the whole que or just their own files?
+# * If there is a netsplit all downloads will be cancelled if an active user disappered
+# * If one send is below like 4kb/s then change findbot_maxsends to one more, so we use the bandwidth
+# * DONE Servers (i.e +v) should get priority, but how? First in queue?
+# * DONE Fix admin_showqueue to really show VIP instead of 1
+###############################################################################
+# CHANGES
+#
+# 1.58 * requesting in a private message is allowed when user is in a monitored channel
+# * filelist creation script at the bottom of this script has been changed to support utf8, multiple folders, with or without file and 7z compression of the command list
+# 1.57 * Added a VIP function which allows +v users to be first in line to get a file
+# * Remove a users queue if they get kicked (only if findbot_mustbeinchannel is ON)
+# * Fixed a bug when a user with a download changed nick.
+# 1.56 * The findbot_maxqueue now works
+# * Sending files with spaces in them, now works
+# 1.55 * Minor changes
+# 1.54 * Added support to update the mp3list without restarting the bot (/findbotreload)
+# 1.53 * Fixed some debug output
+# 1.52 * Fixed some typos
+# * Now people can't look for * . etc. Now a searchpattern MUST contain atleast 1 normal character
+# * Fixed so you can change banner time without restarting the bot
+# 1.50 * Added a timeslot function
+# * Added logging support. Now logging to file. Must specify filename and path INSIDE this script
+# 1.06 * "Optimized" search. Instead of opening and read the whole summaryfile everytime
+# someone searched the script reads the file once at startup.
+# * Fixed more regular expressions
+# * Added multiserver support, i.e you can have the bot on two nets and two different channels
+# 1.05 * Added a new perlscript at the end of this file.
+# It searches your mp3s and makes the 2 necessary files.
+# The script is made by Henrik Andreasson (findbot@han.pp.se)
+# 1.04 * Changed so the files contains full path to mp3s
+# * findbot_maxsends was ignored under some circumstanses
+# * Added so debugoutput shows which file are sent
+# * Sending to client "Now sending you file...." only if they accually are in the channel
+# 1.03 * Changed a "for-loop" one bit
+# * If findbot_minimumspeed was disabled, then the user could leave channel
+# and still get files even if findbot_mustbeinchannel was enabled
+# * Forgot to write to debugwindow if someone downloaded the whole list
+# * Corrected some bad english :)
+# * Fixed more regular expressions
+# * The user will be told the queueposition when requesting a file
+# * Fixed some queueproblems
+# * Added some errormessages if someone types !nickname in a private message
+# 1.01 * Do not reply with "no match" if no match was found to avoid unnecessary spam
+# * Removed alot of commented code
+# * Changed the description of the script
+# * Changed the "results found" string a bit.
+# * Added a new value findbot_sendlist and separated the filelist and the one which accually is sent to the users
+# * Fixed some regular expressions to fit the new searchfiles
+# * Bug fix. If someone resumed a file, they always will be under findbot_minspeed in the start
+# * Didn't search if someone typed @FIND (in uppercase)
+# * Ops the url wasn't right. There is no ~ in the address :)
+# 1.0 Release
+###############################################################################
+use Irssi;
+use Irssi::Irc;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.58";
+
+%IRSSI = (
+ authors => "Thomas Karlsson",
+ contact => "findbot\@planet.eu.org",
+ name => "Findbot",
+ description => "Public command \@find script",
+ license => "GPL",
+ url => "http://hem.passagen.se/thka2315/",
+);
+
+my %nickqueue = (); # Queuenumber + nickname
+my %filequeue = (); # Queuenumber + filename
+my %servertagqueue = (); # Queuenumber + array with servertag,voiceprio,extrafield
+my %activesends = (); # nickname + 1 The user is here if he has an active send
+my $lastqueuenumber = 0; # Holds the last queueitem
+my %scriptdetect = ();
+my $timeout_tag;
+my $banner_timeout;
+my $currentsends = 0;
+my $servertag;
+my $globalstart = 0;
+my $globalvippos = 0;
+my $debuglevel;
+my %bannedpeople = (); # This will contain banned people and time of ban
+my @bigarray; # In here the whole filelist will reside
+my @daynames = qw(Sun Mon Tue Wed Thu Fri Sat);
+my $logfile = "findbot.log";
+my $scriptdetecttime = "3"; # Three seconds must pass before a new filerequest is issued, after a DCC CLOSE
+my $showscriptdetect = 1;
+my $lastbannerprint = time(); # The last time the banner was printed into monitored channels
+
+sub timeslotenabled {
+ my $weekday = shift; # Save weekday
+ my $slothour = shift; # Save hours
+ my $slotminute = shift; # Save minutes
+
+ $weekday = $daynames[$weekday];
+ my $timeslotstring = Irssi::settings_get_str('findbot_timeslots');
+ if ( $timeslotstring =~ /$weekday/i ) {
+ if ( $timeslotstring =~ m/.*$weekday=(.?.):(.?.)(a\.?m\.?|p\.?m\.?)?-(.?.):(.?.)(a\.?m\.?|p\.?m\.?)?.*/i ) {
+ my $fromhour = $1;
+ my $frommin = $2;
+ my $fromampm = $3;
+ my $tohour = $4;
+ my $tomin = $5;
+ my $toampm = $6;
+ if ( $fromampm =~ /p/i ) { $fromhour += 12; } # If it is a pm time add 12 to get 24h format
+ if ( $toampm =~ /p/i ) { $tohour += 12; } # If it is a pm time add 12 to get 24h format
+ my $midnightfrom = ( $fromhour * 60 ) + $frommin; # Get minutes from midnight
+ my $midnightto = ( $tohour * 60 ) + $tomin; # Get minutes from midnight
+ my $inputtime = ( $slothour * 60 ) + $slotminute; # Get minutes from midnight
+ debugprint(20,"inputtime:$inputtime midfrom:$midnightfrom midto:$midnightto");
+ if ( $inputtime <= $midnightto && $inputtime >= $midnightfrom ) {
+ return 1; # The time is between the timeenabled slot
+ } else {
+ return 0; # Time was outside. Bot should be off.
+ }
+ } else {
+ return 0; # Hmm didnt get the times in that day, maybe wrong input from user
+ }
+ } else {
+ return 1; # If the current day wasn't found in findbot_timeslots then return true, i.e bot is default ON.
+ }
+ return 0; # Return false i.e
+}
+
+sub private_get {
+ (my $server, my $message, my $nick, my $address) = @_;
+ if ( $message =~ /^!$server->{nick}\ .*/i ) {
+ $server->command("/MSG " . $nick . " Please request files in the channel, not personally to me. Type \@$server->{nick}-help in channel for help");
+ } elsif ( $message =~ /^\@$server->{nick}.*/i ) {
+ $server->command("/MSG " . $nick . " Please request my filelist in the channel, not personally to me. Type \@$server->{nick}-help in channel for help");
+ } elsif ( $message =~ /^\@find.*/i ) {
+ $server->command("/MSG " . $nick . " Please search files in the channel, not personally to me. Type \@$server->{nick}-help in channel for help");
+ }
+}
+
+sub check_user_queued_items {
+ my $user = shift; # Get the nickname to check
+ my $localsrvtag = shift;
+ my $counter = 0; # Reset the counter
+ for ( my $i=1; $i <= $lastqueuenumber; $i++ ) { # Loop through entire queue
+ if ( $nickqueue{$i} eq $user && $localsrvtag eq $servertagqueue{$i}[0] ) {
+ $counter++;
+ }
+ }
+ return $counter;
+}
+
+sub already_queued_file {
+ my $checknick = shift;
+ my $checkfile = shift;
+ my $srvtag = shift;
+ my $alreadyqueued = 0;
+ for ( my $i=1; $i <= $lastqueuenumber; $i++ ) { # Loop through entire queue
+ if ( $nickqueue{$i} eq $checknick && $filequeue{$i} eq $checkfile && $servertagqueue{$i}[0] eq $srvtag) { # Check if its queued
+ $alreadyqueued = 1; # Yep it was
+ }
+ }
+ if ( $alreadyqueued ) { return 1; } else { return 0; } # Return true if queued else false
+}
+
+sub add_file_to_queue {
+ (my $addnick, my $addfile, my $srvtag, my $priority) = @_; # Split nickname and filename into two variables
+ $lastqueuenumber++;
+ $nickqueue{$lastqueuenumber} = $addnick; # for eg. $nickqueue{1} = 'El_Tomten'
+ $filequeue{$lastqueuenumber} = $addfile; # for eg. $filequeue{1} = '/misc/legal-mp3s/happy.birthday.mp3'
+ if ( ! Irssi::settings_get_bool('findbot_voicegetpriority') ) { $priority = 0; }
+ my @field = ($srvtag,$priority,"To be used later, maybe");
+ $servertagqueue{$lastqueuenumber} = \@field; # for eg. $servertagqueue{1} = 'stockholm'
+ if ( $priority > 1 ) { # Did a priority user queued the file
+ fix_vip_position($priority); # Move vip position up to number one, or just after the last already existing vip position
+ }
+}
+
+sub fix_vip_position {
+ my $priority = shift; # Get priority from input
+ my ($tnickqueue,$tfilequeue,$tservertagqueue);
+ if ( $lastqueuenumber eq 1 ) { return; } # If the queue only have one entry, why try to make it a priority?
+ for ( my $i = $lastqueuenumber; $i > 1; $i--) {
+ if ( $servertagqueue{$i-1}[1] >= $priority ) { $globalvippos = $i; last; } # Is the queue entry before a vip entry? Lets quit the prioritymove
+ $tnickqueue = $nickqueue{$i-1}; # Backup entry
+ $tfilequeue = $filequeue{$i-1};
+ $tservertagqueue = $servertagqueue{$i-1};
+
+ $nickqueue{$i-1} = $nickqueue{$i}; # Move entry up
+ $filequeue{$i-1} = $filequeue{$i};
+ $servertagqueue{$i-1} = $servertagqueue{$i};
+
+ $nickqueue{$i} = $tnickqueue; # Restore entry ( the two entris have now changed place )
+ $filequeue{$i} = $tfilequeue;
+ $servertagqueue{$i} = $tservertagqueue;
+ }
+}
+
+sub remove_queueitem {
+ my $queueitem = shift;
+ if (defined($nickqueue{$queueitem}) && defined($filequeue{$queueitem} && defined($servertagqueue{$queueitem})) ) { # Is there really a queueitem here?
+ for ( my $i = $queueitem; $i <= Irssi::settings_get_int('findbot_maxqueue'); $i++) {
+ if ( defined($nickqueue{$i+1}) && defined($filequeue{$i+1}) && defined($servertagqueue{$i+1}) ) { # Move up in queue if there is one
+ $nickqueue{$i} = $nickqueue{$i+1}; # Move up in queue
+ $filequeue{$i} = $filequeue{$i+1}; # Move up in queue
+ $servertagqueue{$i} = $servertagqueue{$i+1}; # Move up in queue
+ }
+
+ }
+ delete $nickqueue{$lastqueuenumber}; # Delete the last entry. It has been moved up one slot
+ delete $filequeue{$lastqueuenumber}; # Delete the last entry. It has been moved up one slot
+ delete $servertagqueue{$lastqueuenumber}; # Delete the last entry. It has been moved up one slot
+ $lastqueuenumber--; # Since we removed a queue item the lastqueuenumber decreases
+ } else { debugprint(10,"debug: No remove $queueitem"); }
+}
+
+sub user_have_max_active_sends {
+ my $nickname = shift; # Save the nick
+ my $localserver = shift; # Save current servertag
+ if ( $activesends{$nickname} < Irssi::settings_get_int('findbot_maxusersends') ) {
+ return 0; # The user didn't have enough sends
+ } else {
+ return 1; # The user have NOT an active send
+ }
+}
+
+sub user_is_in_active_channel {
+ my $nickname = shift;
+ my $srvtag = shift;
+ my $find_channels = Irssi::settings_get_str('findbot_channels'); # What channels to monitor
+ my @checkchannels = split (/ /, $find_channels); # Split into an array
+
+ foreach my $localserver ( Irssi::servers() ) { # Loop through all connected servers
+ foreach my $singlechan ( @checkchannels ) { # Loop through all monitored channels
+ my $channel = $localserver->channel_find($singlechan); # Get a channelobject
+ if ( defined($channel) && defined($channel->nick_find($nickname)) ) { # Is the nick there?
+ return 1; # User are in monitored channels # Yep is was
+ }
+ }
+ }
+ return 0; # User have left monitored channels
+
+}
+
+sub nicefilename {
+ my $filename = shift;
+
+ if ( $filename =~ /.*\/(.*)\ *:.*/g ) { # If filelist is made by "file"
+ debugprint(15,"Summary file is made by the program file");
+ return $1;
+ } elsif ( $filename =~ /.*\/(.*)$/g ) { # If filelist is Not made by file
+ debugprint(15,"Summary file is NOT made by the program file");
+ return $1;
+ }
+}
+
+sub strippath {
+ my $filename = shift; # Get parameter into $filename
+
+ $filename =~ s/.*\/(.*)/$1/g; # Remove everything until the last /
+ return $filename; # Return the stripped line
+}
+
+sub debugprint {
+ (my $dbglvl,my $debugmessage) = @_; # Save input to variables
+ $debuglevel = Irssi::settings_get_int('findbot_debuglevel');
+ my $win;
+ if ( ! ($win = Irssi::window_find_name($IRSSI{name})) ) { # If the windows doesn't exist
+ $win = Irssi::Windowitem::window_create($IRSSI{name},1);
+ }
+ if ( $dbglvl <= $debuglevel ) {
+ $win->set_name($IRSSI{name}); # Select the window
+ $win->print($debugmessage,MSGLEVEL_CLIENTCRAP);
+ my $debugtid = localtime(time);
+ open (LOGFILE,">>", $logfile);
+ print LOGFILE "$debugtid: $debugmessage\n";
+ close (LOGFILE);
+ }
+}
+
+sub process_queue {
+ if (Irssi::settings_get_bool('findbot_enabled') ) { # Is the findbot enabled?
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); # Get current time
+ if ( ! timeslotenabled($wday,$hour,$min) ) { # If NOT true the bot is offline
+ debugprint(15,"The bot is Offline due to timerestrictions in findbot_timeslots");
+ return 0;
+ }
+ print_banner();
+ if ( $currentsends < Irssi::settings_get_int('findbot_maxsends') ) { # Check if we'll send another file simultanously
+ my $i = 1;
+ while ( $i <= $lastqueuenumber ) {
+ if ( ! user_have_max_active_sends($nickqueue{$i},$servertagqueue{$i}[0]) ) { # If NOT user have max active sends
+ my $nicefile = nicefilename($filequeue{$i});
+ if ( user_is_in_active_channel($nickqueue{$i},$servertagqueue{$i}[0]) ) { # Are the user in a monitored channel?
+ debugprint(10,"[ADMIN] $nickqueue{$i} is in monitored channels, sending $nicefile");
+ my $localserver = Irssi::server_find_tag($servertagqueue{$i}[0]);
+ $localserver->command("/QUOTE NOTICE " . $nickqueue{$i} . " :Sending you the requested file: $nicefile");
+ $localserver->command("/DCC SEND $nickqueue{$i} \"$filequeue{$i}\"" );
+ remove_queueitem($i);
+ last; # Exit the loop
+ } else {
+ debugprint(10,"[ADMIN] $nickqueue{$i} is NOT in monitored channels. Removing queueentry $filequeue{$i}");
+ remove_queueitem($i);
+ } # Remove the queued item if the user have parted the channel
+ } else { # A user had too many sends, increase $i by one to check next queue pos.
+ $i++; # Increase by one so we can loop through whole queue
+ }
+ } # End while or for
+ }
+ }
+ check_dcc_speed_and_in_channel(); # Check minimumspeed
+}
+
+sub dcc_created {
+ (my $dcc) = @_; # Put active dcc in variable
+
+ debugprint(15,"dcc_created was called");
+ if ( $dcc->{type} eq "SEND" ) { # Is it a SEND?
+ if ( defined( $activesends{$dcc->{nick}} ) ) {
+ $activesends{$dcc->{nick}} = $activesends{$dcc->{nick}} + 1;
+ } else {
+ $activesends{$dcc->{nick}} = 1;
+ }
+ $currentsends++;
+ }
+}
+
+sub dcc_closed {
+ (my $dcc) = @_; # Put active dcc in variable
+
+ debugprint(15,"dcc_closed was called");
+ if ( $dcc->{type} eq "SEND" && defined ($activesends{$dcc->{nick}}) ) { # Is it a SEND and a findbot SEND?
+ my $tiden = time();
+ $tiden = $tiden - $dcc->{starttime};
+ if ( $tiden > 0 ) {
+ my $kbsec = $dcc->{transfd} / $tiden;
+ } else {
+ $tiden = 1;
+ my $kbsec = $dcc->{transfd} / $tiden;
+ }
+ if ( $dcc->{transfd} == 0 ) { # If transfered byts are zero, then it was probably aborted
+ debugprint(10,"[ADMIN] SEND aborted Nick: $dcc->{nick} File: $dcc->{arg}");
+ } else {
+ debugprint(10,"[ADMIN] SEND done Nick: $dcc->{nick} File: $dcc->{arg} Bytes: $dcc->{transfd} Time(sec): $tiden Speed: " . calc_kb_sec($tiden,$dcc->{transfd}) . " KB/s");
+ }
+ if ($activesends{$dcc->{nick}} == 1) {
+ delete $activesends{$dcc->{nick}};
+ } else {
+ $activesends{$dcc->{nick}} = $activesends{$dcc->{nick}} - 1;
+ }
+ $currentsends--;
+ $scriptdetect{$dcc->{nick}} = time(); # Record the time when dcc was closed
+ }
+}
+
+sub calc_kb_sec {
+ my $seco = shift;
+ my $bytest = shift;
+
+my $kbsec = $bytest / $seco / 1000;
+ $kbsec =~ s/(.*\..?.?).*/$1/;
+
+ return $kbsec;
+}
+
+sub dcc_destroyed {
+ (my $dcc) = @_; # Put active dcc in variable
+
+ debugprint(15,"dcc_destroyed was called");
+}
+
+sub check_dcc_speed_and_in_channel {
+# my $localserver = Irssi::server_find_tag($servertag); # Get serverobject
+ my $minimumspeed = Irssi::settings_get_int('findbot_minspeed');
+ my $channelcheck = Irssi::settings_get_bool('findbot_mustbeinchannel');
+ foreach my $dccconnection (Irssi::Irc::dccs()) {
+ if ( $dccconnection->{type} eq "SEND" && defined($activesends{$dccconnection->{nick}}) && ($dccconnection->{transfd} - $dccconnection->{skipped}) > 50000) { # Check if its a findbot send.
+ my $bytetransferred = $dccconnection->{transfd} - $dccconnection->{skipped};
+ my $timedownloaded = time() - $dccconnection->{starttime};
+ if ( $timedownloaded == 0 ) { $timedownloaded++; } # Fix for Illegal division by zero
+ my $currentcps = sprintf("%02d",($bytetransferred / $timedownloaded)); # Get current CPS
+ if ( $currentcps < $minimumspeed && $minimumspeed > 0 ) { # Check if below minimumspeed
+ my $localserver = Irssi::server_find_tag($dccconnection->{servertag});
+ $localserver->command("/QUOTE NOTICE $dccconnection->{nick} :Minimum CPS is $minimumspeed and you only have $currentcps. Closing your connection");
+ $localserver->command("/DCC CLOSE SEND $dccconnection->{nick}");
+ debugprint(10,"[ADMIN] $dccconnection->{nick} ($currentcps) is below minimumspeed($minimumspeed). Closing...");
+ } elsif ( $channelcheck ) {
+ if ( ! user_is_in_active_channel($dccconnection->{nick},$dccconnection->{servertag}) ) {
+ debugprint(10,"[ADMIN] $dccconnection->{nick} has LEFT monitored channels, closing SEND");
+ my $localserver = Irssi::server_find_tag($dccconnection->{servertag});
+ $localserver->command("/DCC CLOSE SEND $dccconnection->{nick}");
+ # Just close without warning, why bother to tell him if he's left.
+ }
+ }
+ }
+ }
+}
+
+sub nickname_changed {
+ my ($chan, $newnick, $oldnick) = @_;
+
+ foreach my $queuepos (keys(%nickqueue)) { # Go through all nicks in my queuelist to see if we're affected
+ if ( $nickqueue{$queuepos} eq $oldnick ) { # Check the nick
+ $nickqueue{$queuepos} = $newnick->{nick}; # Insert the new nick in that position
+ debugprint(10,"[ADMIN] Nickchange $nickqueue{$queuepos} -> $newnick->{nick}");
+ }
+ }
+ if ( defined($activesends{$oldnick}) ) { # He has an active send
+ $activesends{$newnick->{nick}} = $activesends{$oldnick}; # Make a new entry so he can't evade the dcc speed check
+ delete $activesends{$oldnick};
+ }
+}
+
+sub user_got_kicked {
+ my ($kchannel,$knick,$kkicker,$kaddress,$kreason) = @_;
+ my $mustbeinchannel = Irssi::settings_get_bool('findbot_mustbeinchannel');
+
+ if ( $mustbeinchannel ) { # Are we to punish this kicked user?
+ foreach my $queuepos (keys(%nickqueue)) { # Go through all nicks in my queuelist to see if we're affected
+ if ( $nickqueue{$queuepos} eq $knick ) { # Check the nick if the kicked user has a queue.
+ debugprint(10,"[ADMIN] $knick was KICKED. Removing queueposition $queuepos $filequeue{$queuepos}");
+ remove_queueitem($queuepos); # Removes the users queue
+ }
+ }
+ }
+}
+
+sub print_banner {
+ my $timenow = time();
+ my $timecalc = Irssi::settings_get_str('findbot_bannertime') + $lastbannerprint;
+# debugprint(10,"print_banner function... now: $timenow last: $lastbannerprint timecalc: $timecalc");
+ if ( $timenow > $timecalc ) {
+ $lastbannerprint = time(); # Reset timer
+ my $find_channels = Irssi::settings_get_str('findbot_channels'); # What channels to monitor
+ my @checkchannels = split (/ /, $find_channels); # Split into an array
+ if ( Irssi::settings_get_bool('findbot_showbanner') ) { # Check if I will print the banner
+ debugprint(10,"[ADMIN] Sending banner to monitored channels");
+ my $showvoiceprio = "OFF";
+ if (Irssi::settings_get_bool('findbot_voicegetpriority') ) {
+ $showvoiceprio = "ON";
+ }
+ foreach my $localserver ( Irssi::servers() ) {
+ my $bannerad = "For my list of $#bigarray files type: \@" . $localserver->{nick} . ", Sends: $currentsends/" . Irssi::settings_get_int('findbot_maxsends') . " , Queue: $lastqueuenumber/" . Irssi::settings_get_int('findbot_maxqueue') . ", Voicepriority: $showvoiceprio, For help: \@" . $localserver->{nick} . "-help";
+ foreach my $singlechan ( @checkchannels ) { # Loop through all monitored channels
+ my $channel = $localserver->channel_find($singlechan); # Get the channelobject
+ if ( defined($channel) ) { # Am I in the specific channel, if so its defined
+ $channel->command("/MSG $singlechan $bannerad" . " Using: Irssi " . $IRSSI{name} . " v$VERSION"); # Print banner
+ } # End if
+ } # End foreach channel
+ } # End foreach server
+ } # End if
+ } # End check if I'll print the banner
+}
+
+sub admin_showqueue {
+ debugprint(10,"[ADMIN] Show queue");
+ debugprint(10,"[ADMIN] Current sends are: $currentsends");
+ for ( my $i = 1; $i <= $lastqueuenumber; $i++ ) { # Loop through the queue
+ debugprint(10,"[ADMIN] ($i) $nickqueue{$i}:$filequeue{$i}:$servertagqueue{$i}[0]:Prio $servertagqueue{$i}[1]");
+# if ( $servertagqueue{$i}[1] > 0 ) { # Is this a VIP entry?
+# debugprint(10,"[ADMIN] ($i) $nickqueue{$i}:$filequeue{$i}:$servertagqueue{$i}[0]:VIP queued($servertagqueue{$i}[1])");
+# } else {
+# debugprint(10,"[ADMIN] ($i) $nickqueue{$i}:$filequeue{$i}:$servertagqueue{$i}[0]:Normal queued");
+# }
+ }
+ debugprint(10,"[ADMIN] End of list");
+}
+
+sub admin_reset {
+ my $howmany = shift;
+ if ( $howmany =~ /\d+/ ) {
+ $currentsends = $howmany; # Reset current sends
+ debugprint(10,"[ADMIN] Current sends are now set to $currentsends");
+ } else {
+ debugprint(10,"[ADMIN] Specify how many sends there are now");
+ }
+}
+
+#sub start_findbot {
+# my($data,$localserver,$witem) = @_;
+
+# if ( $localserver != 0 ) {
+# $servertag = $localserver->{tag}; # Remeber on which server the findbot is on
+# $globalstart = 1;
+# debugprint(10,"Findserver is started");
+# } else {
+# debugprint(10,"Please start the server in a window where I can get hold of a servertag");
+#3 }
+#}
+
+sub admin_removequeue {
+ my $queueposition = shift;
+ if ( $queueposition =~ /\d+/ ) {
+ remove_queueitem($queueposition);
+ debugprint(10,"[ADMIN] Removed position $queueposition");
+ } else {
+ debugprint(10,"[ADMIN] Specify which queueitem should be removed");
+ }
+}
+
+sub admin_activesends {
+ debugprint(10,"[ADMIN] Listing active dccsends");
+ foreach my $send (keys(%activesends)) {
+ debugprint(10,"[ADMIN] $send ($activesends{$send})");
+ }
+ debugprint(10,"[ADMIN] End of list");
+}
+
+sub admin_reload {
+ if ( -r Irssi::settings_get_str('findbot_summaryfile') ) {
+ open (FINDFILE, "<", Irssi::settings_get_str('findbot_summaryfile')); # Open the file
+ @bigarray = <FINDFILE>; # Load it whole into memory :)
+ close (FINDFILE);
+ debugprint(10,"[ADMIN] Summary file has been reloaded into memory.");
+ } else {
+ debugprint(10,"[ADMIN] The Summaryfile cannot be read. Please check if the path is correct and the file is accually there.");
+ }
+}
+
+sub send_ctcp_slots {
+# Not implemented yet
+}
+
+sub sanitize_input {
+ my $tainted_input = shift;
+ $tainted_input =~ s/[\^\\\[\]\$\(\)\?\+\/\|\'\}\{]+/\./g; # Translate ^\[]$()?+ to .
+ return $tainted_input; # Return regularexpression sanitized input
+}
+
+sub find_public {
+ my ($server, $msg, $nick, $address, $targetchan) = @_; # Save all input to variables
+ my $find_channels = Irssi::settings_get_str('findbot_channels');# What channels to monitor
+ my $find_file = Irssi::settings_get_str('findbot_summaryfile'); # Filename which holds all the files
+ my $mp3list = Irssi::settings_get_str('findbot_sendlist'); # The nice list which is sent to users
+ my $max_results = Irssi::settings_get_int('findbot_maxresults');# Get max results retured to client
+ my $userqueuelimit = Irssi::settings_get_int('findbot_maxuserqueue'); # Get userqueue limit
+ my $serverqueuelimit = Irssi::settings_get_int('findbot_maxqueue'); # Get server maxqueue
+ my @checkchannels = split (/ /, $find_channels); # Split into an array
+
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); # Get current time
+
+ my $validchan = 0;
+ foreach my $singlechan ( @checkchannels ) {
+ if ( $singlechan eq $targetchan ) {
+ $validchan = 1;
+ }
+ }
+ # allows requesting and searching files in private messages because $targetchan has the own nickname in it when it is a private message, if not it's the channel where it was said
+ if ( $targetchan == "$server->{nick}" && user_is_in_active_channel($nick) ) {
+ $validchan = 1;
+ }
+
+ if ( $validchan && Irssi::settings_get_bool('findbot_enabled') && timeslotenabled($wday,$hour,$min) ) { # Did the user say something in one of our channels?
+ my $mynick = $server->{nick};
+ if ( $msg =~ /^\ *\@find\ +.+/i ) { # Was it a @find command?
+ $msg =~ s/^\ *\@find\ (.*)/$1/i; # Remove @find space spaces infront of it
+ $msg =~ tr/*/\ /; # Translate * to spaces
+ $msg =~ s/[\ \+]+/\.\*/g; # Translate ALL spaces to .*
+ $msg = sanitize_input($msg);
+ debugprint(10,"$nick is searching for $msg");
+ my @matched;
+# if ( length($msg) > 2 && $msg =~ m/[a-z]+/i) { # MUST be over 2 chars and contain atleast 1 or more normal characters
+ @matched = grep (/$msg/i,@bigarray); # Search for the matches
+# } else {
+# debugprint(10,"[ADMIN] $nick tried to search with too wide searchpattern ($msg)");
+# return;
+# }
+ my $matchcount = 0; # Reset a counter
+ my $found_results = $#matched; # Return how many hits
+ $found_results++; # If nomatch then it is -1
+ if ( $found_results > 0 ) { # Print number of results to the user
+ debugprint(10,"Found $found_results matches");
+ $server->command("/QUOTE PRIVMSG " . $nick . " :Found $found_results matching files. Using: $IRSSI{name} v$VERSION for Irssi");
+ }
+ foreach my $match (@matched) { # Loop through each file match
+ $match = strippath($match); # Remove the path and keep filename and mp3info
+ $match =~ s/:/\ \ \ :\ \ /; # Replace the ":" with " : "
+ if ( $matchcount < $max_results ) { # Is the matchlimit reached and is it a mp3 file?
+ $matchcount++; # Increase by one
+ $server->command("/QUOTE PRIVMSG " . $nick . " :!$mynick $match");
+ } else { # Limit reached!
+ $server->command("/QUOTE PRIVMSG " . $nick . " :Resultlimit by " . $max_results . " reached. Download my list for more, by typing \@$server->{nick}");
+ close (FINDFILE);
+ return;
+ }
+ }
+# if ( $matchcount == 0 ) {
+# $server->command("/QUOTE NOTICE " . $nick . " :No match found.");
+# }
+ } elsif ( $msg =~ /^\ *!$server->{nick}.*/i ) { # Send file trigger
+ my $localsrvtag = $server->{tag}; # Get current servertag
+ debugprint(20,"$nick tries to queue $msg"); # Just debugoutput
+ $msg =~ s/\ *!$server->{nick}\ *(.*)/$1/; # Remove the trigger
+ $msg =~ tr/\(\)/\.\./; # Translate all () to . (any char)
+ $msg = sanitize_input($msg);
+ my @matched = grep (/$msg/i,@bigarray); # Get the real path from the file
+ if ( $matched[0] eq "" ) {
+ $server->command("/QUOTE NOTICE " . $nick . " :That file does not exist");
+ return;
+ }
+ my $realfile = $matched[0]; # Append the real path to the relative path
+ $realfile =~ s/(.*)\ +:.*/$1/; # Remove : and beyoned
+
+ my $scriptrequest = time() - $scriptdetect{$nick};
+ if ( $scriptrequest <= $scriptdetecttime && $showscriptdetect ) {
+ debugprint(10,"[ADMIN] Requestscript detected on $nick");
+ # return; #
+ }
+ chomp ($realfile);
+ if ( check_user_queued_items($nick,$localsrvtag) < $userqueuelimit ) { # Is it below allowed user queue limit
+ if ( already_queued_file($nick,$realfile,$localsrvtag) ) {
+ $server->command("/QUOTE PRIVMSG " . $nick . " :You have already queued that file!");
+ } else {
+ my $priority = 1; # Default prio
+ if ( $lastqueuenumber < $serverqueuelimit ) {
+ foreach my $vchannel ($server->channels()) { # Loop through all joined channels
+ if ( $vchannel->{name} eq $targetchan ) { # Did he say it in a monitored channel
+ my $nickrec = $vchannel->nick_find($nick);
+ if ( $nickrec->{voice} ) {
+ $priority = 10; # A voiced user get 10 prioritypoints
+ } # Voiced user?
+ if ( $nickrec->{op} ) {
+ $priority = 20; # An op get 20 prioritypoints
+ }
+ last; # Skip rest of loop
+ }
+ }
+ add_file_to_queue($nick,$realfile,$localsrvtag,$priority); # Add file to queue
+ if ( Irssi::settings_get_bool('findbot_voicegetpriority') && $priority > 1 ) {
+ $server->command("/QUOTE PRIVMSG " . $nick . " :Added file to VIP queueposition $globalvippos.");
+ debugprint(10,"[ADMIN] $nick VIP queued: $realfile");
+ } else {
+ $server->command("/QUOTE PRIVMSG " . $nick . " :Added file to queueposition $lastqueuenumber.");
+ debugprint(10,"[ADMIN] $nick queued: $realfile");
+ }
+ } else {
+ $server->command("/QUOTE PRIVMSG " . $nick . " :The serverqueue is full. Please try again in a few minutes.");
+ debugprint(10,"[ADMIN] Queue is FULL.");
+ }
+ }
+ } else { # Tell the user the user queue limit is reached
+ $server->command("/QUOTE PRIVMSG " . $nick . " :You have reached the " . $userqueuelimit . " files queue limit.");
+ debugprint(10,"[ADMIN] $nick has reached his queuelimit");
+ }
+ } elsif ( ($msg =~ /^\ *\@$server->{nick}-stats.*/i) || ($msg =~ /^\ *\@$server->{nick}-que.*/i) ) {
+ debugprint(10,"[ADMIN] $nick checked queuepositions");
+ $server->command("/QUOTE PRIVMSG " . $nick . " :Sending you, your queuepositions");
+ for ( my $i = 1; $i <= $lastqueuenumber; $i++ ) { # Loop through the queue
+ if ( $nickqueue{$i} eq $nick ) {
+ my $nicefile = nicefilename($filequeue{$i});
+ $server->command("/QUOTE PRIVMSG " . $nick . " :Pos $i, $nicefile");
+ }
+ }
+ } elsif ( $msg =~ /^\ *\@$server->{nick}-remove.*/i ) {
+ if ( $msg =~ /\ *\@$server->{nick}-remove\ *([\d]+)/ ) { # We have a number
+ my $qitem = $1;
+ debugprint(10,"[ADMIN] $nick is trying to remove queueposition $qitem");
+ if ( $nickqueue{$qitem} eq $nick ) { # Check if the item is owned by the user
+ remove_queueitem($qitem); # Remove the requested queueitem
+ $server->command("/QUOTE NOTICE " . $nick . " :Item $qitem has");
+ } else { # Unauthorized removal
+ debugprint(10,"[ADMIN] $nick tried to remove other peoples files from queue");
+ $server->command("/QUOTE NOTICE " . $nick . " :You can't remove other peoples queueitems");
+ }
+ } else { # We dont have a number, ie remove the whole user queue
+ debugprint(10,"[ADMIN] $nick has removed all own queueitems");
+ for ( my $i = 1; $i <= $lastqueuenumber; $i++ ) { # Loop through the queue
+ if ( $nickqueue{$i} eq $nick ) {
+ remove_queueitem($i);
+ }
+ }
+ $server->command("/QUOTE NOTICE " . $nick . " :Your whole queue have been deleted");
+ }
+ } elsif ( $msg =~ /^\ *\@$server->{nick}$/i ) {
+ if ( -r $mp3list ) { # Check if the file is still there
+ debugprint(10,"[ADMIN] $nick requested my list: $mp3list");
+ $server->command("/QUOTE NOTICE " . $nick . " :Sending you my full list...");
+ $server->command("/DCC SEND $nick $mp3list" );
+ } else {
+ debugprint(5,"[WARNING] the $mp3list doesn't exist!");
+ $server->command("/QUOTE NOTICE " . $nick . " :Something wicked happened. My list has disappeared and i have notified the bot owner.");
+ }
+ } elsif ( ($msg =~ /^\ *\@$server->{nick}\ *help\ *$/i) || ($msg =~ /^\ *\@$server->{nick}-help\ *$/i) ) {
+ debugprint(10,"[ADMIN] $nick requested HELP");
+ $server->command("/QUOTE PRIVMSG " . $nick . " :Public channel commands:");
+ $server->command("/QUOTE PRIVMSG " . $nick . " :\@find [searchpattern] : Searches my database for that file");
+ $server->command("/QUOTE PRIVMSG " . $nick . " :!$server->{nick} [file] : Queues that file and it will be sent to you when its your turn");
+ $server->command("/QUOTE PRIVMSG " . $nick . " :\@$server->{nick}-stats : Shows you your queuepositions");
+ $server->command("/QUOTE PRIVMSG " . $nick . " :\@$server->{nick}-que : Shows you your queuepositions");
+ $server->command("/QUOTE PRIVMSG " . $nick . " :\@$server->{nick}-remove : Clears all your queued files");
+ $server->command("/QUOTE PRIVMSG " . $nick . " :\@$server->{nick}-remove 2 : Clear your queueposition 2");
+ $server->command("/QUOTE PRIVMSG " . $nick . " :$IRSSI{name} v$VERSION $IRSSI{url}");
+ } else {
+ return; # Just ordinary chatter
+ }
+ }
+ return; # Just in case
+}
+
+sub check_vital_configuration {
+ my $configerror = 0;
+ if ( Irssi::settings_get_str('findbot_channels') eq "" ) {
+ $configerror = 1;
+ Irssi::print("The setting findbot_channels is empty.");
+ } elsif ( Irssi::settings_get_str('findbot_summaryfile') eq "" ) {
+ $configerror = 1;
+ Irssi::print("The setting findbot_summaryfile is empty.");
+ } elsif ( Irssi::settings_get_str('findbot_sendlist') eq "" ) {
+ $configerror = 1;
+ Irssi::print("The setting findbot_sendlist is empty.");
+ } elsif ( Irssi::settings_get_int('findbot_maxresults') == 0 ) {
+ $configerror = 1;
+ Irssi::print("The setting findbot_maxresults is empty.");
+ } elsif ( Irssi::settings_get_int('findbot_maxqueue') == 0 ) {
+ $configerror = 1;
+ Irssi::print("The setting findbot_maxqueue is empty.");
+ } elsif ( Irssi::settings_get_int('findbot_maxsends') == 0 ) {
+ $configerror = 1;
+ Irssi::print("The setting findbot_maxsends is empty.");
+ } elsif ( Irssi::settings_get_int('findbot_maxuserqueue') == 0 ) {
+ $configerror = 1;
+ Irssi::print("The setting findbot_maxuserqueue is empty.");
+ } elsif ( Irssi::settings_get_int('findbot_maxusersends') == 0 ) {
+ $configerror = 1;
+ Irssi::print("The setting findbot_maxusersends is empty.");
+ } elsif ( Irssi::settings_get_int('findbot_bannertime') == 0 ) {
+ $configerror = 1;
+ Irssi::print("The setting findbot_bannertime is empty.");
+ }
+ if ($configerror) {
+ Irssi::print("Please correct the settings first. The server will be disabled");
+ Irssi::print("You have to reload the script when the settings are correct");
+ Irssi::timeout_remove($timeout_tag);
+ Irssi::timeout_remove($banner_timeout);
+ }
+}
+
+########
+# Main #
+########
+
+Irssi::settings_add_str("misc", "findbot_channels", ""); # Add a variable inside of irssi
+Irssi::settings_add_str("misc", "findbot_summaryfile", ""); # Add a variable inside of irssi
+Irssi::settings_add_int("misc", "findbot_maxresults", ""); # Add a variable inside of irssi
+Irssi::settings_add_str("misc", "findbot_sendlist", ""); # Add a variable inside of irssi
+Irssi::settings_add_int("misc", "findbot_maxqueue", ""); # Add a variable inside of irssi
+Irssi::settings_add_int("misc", "findbot_maxsends", ""); # Add a variable inside of irssi
+Irssi::settings_add_int("misc", "findbot_maxuserqueue", ""); # Add a variable inside of irssi
+Irssi::settings_add_int("misc", "findbot_maxusersends", ""); # Add a variable inside of irssi
+Irssi::settings_add_bool("misc", "findbot_showbanner", ""); # Add a variable inside of irssi
+Irssi::settings_add_int("misc", "findbot_bannertime", ""); # Add a variable inside of irssi
+Irssi::settings_add_bool("misc", "findbot_enabled", ""); # Add a variable inside of irssi
+Irssi::settings_add_bool("misc", "findbot_voicegetpriority", ""); # Add a variable inside of irssi
+Irssi::settings_add_int("misc", "findbot_minspeed", ""); # Add a variable inside of irssi
+Irssi::settings_add_int("misc", "findbot_debuglevel", 10); # Add a variable inside of irssi
+Irssi::settings_add_bool("misc", "findbot_mustbeinchannel", "");
+Irssi::settings_add_str("misc", "findbot_timeslots", ""); # Add a variable inside of irssi
+Irssi::signal_add_last('message public', 'find_public'); # Hook up a function to public chatter
+Irssi::signal_add_last('message private', 'find_public'); # Hook up a function to public chatter
+Irssi::signal_add_last('dcc created', 'dcc_created'); # Hook when a dcc is created
+Irssi::signal_add_last('dcc closed', 'dcc_closed'); # Hook when a dcc is closed
+Irssi::signal_add_last('dcc destroyed', 'dcc_destroyed');
+Irssi::signal_add('nicklist changed', 'nickname_changed');
+Irssi::signal_add('message kick', 'user_got_kicked');
+Irssi::command_bind('findbotqueue', 'admin_showqueue');
+Irssi::command_bind('findbotremove', 'admin_removequeue');
+Irssi::command_bind('findbotreset', 'admin_reset');
+Irssi::command_bind('findbotreload', 'admin_reload');
+Irssi::command_bind('findbotactivesends', 'admin_activesends');
+
+check_vital_configuration(); # Run a subroutine to check all variables before starting
+if ( -r Irssi::settings_get_str('findbot_summaryfile') ) {
+ open (FINDFILE, "<", Irssi::settings_get_str('findbot_summaryfile')); # Open the file
+ @bigarray = <FINDFILE>; # Load it whole into memory :)
+ close (FINDFILE);
+} else {
+ debugprint(10,"The Summaryfile cannot be read. Please check if the path is correct and the file is accually there.");
+}
+# my $slots_timeout = Irssi::timeout_add(600000, "send_ctcp_slots", ""); # Not implemented yet
+$timeout_tag = Irssi::timeout_add(5000, "process_queue", ""); # Add a timeout value the process the queue
+#my $bannertime = Irssi::settings_get_int('findbot_bannertime');
+#$banner_timeout = Irssi::timeout_add($bannertime * 1000, "print_banner", ""); # Set timeout for banner
+Irssi::print("Findbot script v$VERSION by $IRSSI{'authors'} loaded!"); # Show version and stuff when it has been loaded
+
+if ( Irssi::settings_get_bool('findbot_enabled') ) {
+ Irssi::print("Findserver is Online");
+} else {
+ Irssi::print("Findserver is Offline");
+}
+debugprint (5,"[ADMIN] Findbot fileserver has been loaded!");
+
+
+#############################
+# INSTALLATION INSTRUCTIONS
+#############################
+# - Making of the "findbot_summaryfile" and "findbot_sendlist"
+# Run the perlscript below to create the summaryfile and sendlist
+#
+# - Install it in Irssi
+# Put the script in your Irssi scripts directory (~.irssi/scripts)
+# Start Irssi and load it. (/run findbot.pl)
+# Now start setting all vital variables by using the command /set
+# set the "findbot_summaryfile" and "findbot_sendlist" to the files you just have created with
+# the perlscript below.
+# Dont forget to set all the other variables
+
+
+####### Here is the script #########
+
+# #!/usr/bin/perl
+#use open ":encoding(UTF-8)";
+# if not supplied on cmd line this is the values
+#@PATH = ("/mnt/folder1","/mnt/folder2"); # if only one folder should be used let it be @PATH = ("/mnt/folder1");
+#@INPUT = "";
+#$NICK = "nickname";
+#($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
+#
+#$year = sprintf("%04d",$year+1900);
+#$mon = sprintf("%02d",$mon + 1);
+#$mday = sprintf("%02d",$mday);
+#$DATE = "$year-$mon-$mday";
+#$LIST = $NICK . "_books_list.txt";
+#$CMD = $NICK . "_books_cmd.txt";
+#$CMD_7z = $NICK . "_books_cmd";
+#$padding = 50; # How many pad-characters should it be
+#$use_file = 0; # each file is analysed by the program file if this is set to 0, this takes ages when with lots of files
+#$use_compressed_cmdfile = 1; # if 1 then use 7z for compressing the command filelist that is being sent to the users
+#
+#if( "x" ne "x$ARGV[0]" ){ $NICK = $ARGV[0]; }
+#if( "x" ne "x$ARGV[1]" ){ $PATH = $ARGV[1]; }
+#if( "x" ne "x$ARGV[2]" ){ $LIST = $ARGV[2]; }
+#if( "x" ne "x$ARGV[3]" ){ $CMD = $ARGV[3]; }
+#
+#print "Using nick: $NICK\n";
+#foreach (@PATH){
+# print "Finding under supplied path $_\n";
+# push(@INPUT,`find "$_" -follow -type f`);
+#}
+#print "Find done\n";
+#print "Summaryfile: $LIST\n";
+#print "Sendlist: $CMD\n";
+#
+#print "Generating lists done/total files\n";
+#open(LIST,">$LIST");
+#open(CMD,">$CMD");
+#
+#print LIST "### List generated: $DATE I have a total of $#INPUT files ###\n";
+#print CMD "### List generated: $DATE I have a total of $#INPUT files ###\r\n";
+#print CMD "### This list was created by Findbot for Irssi\r\n";
+#print CMD "### http://irssi.org/scripts\r\n";
+#
+#$CHECKDIR="";
+#$CNT=0;
+#
+## arrays start 0 and If I have 10 mp3 without +1 it would stat you have 9 ...
+#$TOTAL = $#INPUT + 1;
+#
+#sub padline {
+# $filename = shift;
+# $filelength = length($filename);
+# $paddchar = "=";
+# if ( $filelength <= $padding ) {
+# for ( $counter = $filelength; $counter < $padding; $counter++ ) {
+# $paddchar .= "=";
+# }
+# }
+# return $paddchar;
+#}
+#
+#foreach( @INPUT ){
+# $CNT++;
+# print "\r$CNT/" . $TOTAL;
+# chomp $_;
+#
+# $FILE=$_;
+# $DIR=$_;
+# $FILEwPATH=$_;
+#
+# $FILE =~ s/.*\/(.*)/$1/g; # only the file
+# $DIR =~ s/(.*)\/.*/$1/g; # only the dir
+#
+# if ( $use_file ) {
+# $STAT_OF_FILE = `file -b "$FILEwPATH"`; # the info about the file
+# $STAT_OF_FILE =~ s#/##gio; # remove /
+# chomp $STAT_OF_FILE;
+# print LIST "$FILEwPATH : $STAT_OF_FILE\n"; # output to the LIST-file
+# } else {
+# print LIST "$FILEwPATH\n"; # output to the LIST-file
+# }
+# if( "$DIR" ne "$CHECKDIR" ){
+# # output to the CMD-file
+# print CMD "\r\n=================================================\r\n";
+# $CHECKDIR = $DIR; print CMD "Files in $DIR\r\n";
+# print CMD "=================================================\r\n\r\n";
+# }
+# if ( $use_file ) {
+# print CMD "!$NICK $FILE " . padline($FILE) . " $STAT_OF_FILE\r\n"; # output to the CMD-file
+# } else {
+# print CMD "!$NICK $FILE\r\n"; # output to the CMD-file
+# }
+#}
+#print CMD "EOF\r\n";
+#print LIST "EOF\r\n";
+#close LIST;
+#close CMD;
+#if ( $use_compressed_cmdfile ) {
+# print "\ncompressing filelist...\n";
+# system "7z a -t7z -mx9 $CMD_7z.7z $CMD";
+#}
+#print "\nList generation done\n";
diff --git a/scripts/fleech.pl b/scripts/fleech.pl
new file mode 100644
index 0000000..935d803
--- /dev/null
+++ b/scripts/fleech.pl
@@ -0,0 +1,948 @@
+#
+# $Id: fleech.pl,v 1.41 2003/01/11 23:07:48 piotr Exp $
+#
+# This script works the best with sysreset file server. For other file
+# server types you probably need to add regexps.
+#
+# Commands: (for "/fleech add" uses current irc server - make sure nick is
+# on this server (e.g. execute "/fleech" commands in the window with
+# channel in which a nick is, or use C-x))
+#
+# Setting trigger: (<trigger> is a command you'd use to connect to fserve
+# without "/ctcp nick" part. Currently only /ctcp triggers are supported)
+# /fleech add nick trigger <trigger>
+#
+# Adding file: (<file> is a file with full path, with "/" not "\" even if
+# fserve is run on windows)
+# /fleech add nick file <file>
+#
+# Adding multiple files with one command: (see also 'Multiple files' section
+# below for examples and better description)
+# /fleech add nick rfile xxx{01,5}yy\{\\{y
+#
+# Starting leeching:
+# /fleech go
+#
+# Listing status:
+# /fleech list
+#
+# Removing Completed file records:
+# /fleech clrc
+#
+# There is also /fleech set command which is currently not documented
+# (RTFS :P), and a couple of /set fleech_ settings
+#
+# Example usage: ('nick' is fserve's nick)
+# /fleech add nick trigger !get me
+# /fleech add nick file lonewolf/Lone Wolf vol15 Story74.rar
+# /fleech add nick file Lone Wolf15.jpg
+# /fleech list
+# /fleech go
+#
+# Multiple files: [patch by Stylianos Papadopoulos]
+# Suppose you want to get files abc.r00, abc.r01, ..., abc.r45.
+# You can add them all with one command:
+# /fleech add nick rfile path/to/file/abc.r{00,45}
+# The "{00,45}" will be replaced by 00, 01, ..., 45 and files will be
+# added for download.
+# If the file name have "{" or "\" in it you need to escape such characters
+# with a "\", so "{" -> "\{", "\" -> "\\"
+# For example:
+# /fleech add nick rfile xxx{01,5}yy\{\\{y
+# will add xxx01yy{\{y, xxx02yy{\{y, ... , xxx05yy{\{y for download.
+#
+#
+# TODO:
+# - when get is closed and we're checking if there are other the same gets,
+# check only for gets with bigger tranfd
+# - loading, saving leechs
+# - user should be able to specify his own regexps for checking if file was
+# queued etc, connect this with some name, and notify fleech.pl that
+# server-nick fserve is that type fserve
+#
+# Changes:
+# 0.0.2i (2005.03.06):
+# - Multiple files adding with "/fleech add nick rfile" command, patch
+# from Stylianos Papadopoulos [papasv69 //at// hotmail //dot// com]
+# (thanks!)
+# 0.0.2h (2003.04.13):
+# - /fleech set <oldnick> nick <newnick>
+# - some other small fixes/changes
+# 0.0.2g (2003.01.13):
+# - rechecking bugfix
+# 0.0.2f (2003.01.12):
+# - new command "/fleech clrc" to remove record of complete files
+# - some sanity checks in /fleech set
+# 0.0.2e (2003.01.10):
+# - should work when fserv changes nick. Because of this, use
+# "/fleech add nick trigger !trigger" and not, like previously,
+# "/fleech add nick trigger /ctcp nick !trigger".
+#
+
+
+use Irssi;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.0.2i";
+%IRSSI = (
+ authors => 'Piotr Krukowiecki',
+ name => 'fleech',
+ contact => 'piotr //at// krukowiecki //dot// net',
+ description => 'fserve leecher - helps you download files from file servers',
+ license => 'GNU GPL v2',
+ url => 'http://www.krukowiecki.net/code/irssi/'
+);
+
+
+### Data model: (i know this sucks :( )
+# servertag->nick-> %hash:
+# trigger->$
+# path->@ (where are we in file server?)
+# state->$
+# type->$ (type of server, for example default, sysreset etc)
+# lastaction->$ (when was last action performed/received)
+# cfile->$ (number of file we're operating now, -1 if none (i.e. the send has come or fserver ACK'ed queueing/sending the file)
+# files->@ of %hash:
+# name (file name with full path)
+# state (complete, in transfer, not complete, etc.)
+# depth (how deep in dirs the file is. file in root dir == 0)
+# size (size of file, -1 means yet unknown)
+
+my %serv = ();
+my $dbglog = "";
+#my $dbglog = Irssi::get_irssi_dir() . "/fleech.dbg";
+
+my %states = (
+ '0' => 'Nothing done',
+ '1' => 'Initiating connection', # sent e.g. "/ctcp nick trigger"
+ '2' => 'Connecting', # accepted chat by "/dcc chat nick"
+ '3' => 'Connected, waiting till end of welcome message', # dcc chat established, probably reading welcome message
+ '4' => 'Connected, changing dir', # sent "cd dir"
+ '5' => 'Connected, queueing files', # sent "get file"
+ '6' => 'Files queued', # we belive we have queued all files we could
+ '7' => 'All files complete', # we belive we have all files we wanted
+ '8' => 'Slots Full', # can't queue cause slots full
+ );
+
+my %fstates = (
+ '0' => 'File not complete',
+ '1' => 'Transfer in progress', # the files is currently being send to us
+ '2' => 'Completed', # we assume we have whole file on disk
+ '3' => 'File queued', # we assume it's in queue
+ );
+
+my %servers = (
+ 'SysReset.*FileServer' => 'sysreset',
+ 'I.*-.*n.*-.*v.*-.*i.*-.*s.*-.*i.*-.*o.*-.*n.*File Server with Advanced File Serving features' => 'invision', # stupid colors
+ 'Edward_K Script' => 'edward_k',
+ );
+
+# TODO : Check more servers for regexps
+my %patterns = (
+ 'default' => {
+ 'EoWM' => '\[\\\]', # End of Welcome Message
+ 'file queued' => 'queue(d|ing).*in.*slot|add.*file.*to.*slot',
+ 'my slots full' => 'queue slot.*full|have filled.*queue slots|no.*sends.*avail',
+ 'sending file' => 'sending',
+ 'invalid file name' => 'invalid filename|not.*valid.*file',
+ 'already queued' => 'already.*(queued|sending)',
+ 'dir changed' => '\[\\\.*\]',
+ },
+ 'sysreset' => {
+ 'EoWM' => '\[\\\]', # End of Welcome Message
+ 'file queued' => 'Adding your file to queue slot.*The file will send when the next send slot is open', #ok
+ 'my slots full' => 'Sorry, all of your queue slots are full', #ok
+ 'all slots full' => 'Sorry, all send and queue slots are full', #ok
+ 'sending file' => 'Sending File', #ok
+ 'invalid file name' => 'Invalid file name, please use the form:', #OK
+ 'already sending' => 'That file is already sending', # ok
+ 'already queued' => 'That file has already been queued in slot', # ok
+ 'dir changed' => '\[\\\.*\]', #ok
+ 'press S' => "[[]'C' for more, 'S' to stop[]]",
+ },
+ 'edward_k' => {
+ 'EoWM' => '\[\\\]', #ok
+ 'file queued' => 'Queuing.*It has been placed in queue slot.*, it will send when sends are available', #ok
+ 'my slots full' => 'Sorry, there are too many sends in progress right now and you have used all your queue slots\. If you still want to get a file please wait for one to finish and try again', #ok
+# 'all slots full' => 'Sorry, all send and queue slots are full',
+ 'sending file' => 'Sending', #ok
+# 'already sending' => 'That file is already sending', # not have?
+ 'already queued' => 'Sorry, that queue already exists in queue slot.*, you have already queued that file', #ok
+ 'dir changed' => '\[\\\.*\]', # ok
+ },
+ 'invision' => {
+ 'EndoWM' => '\[\\\]', # End of Welcome Message
+ 'file queued' => 'The file has been queued in slot|Thë.*file.*has beèn.*quëued.*in.*slót', #ok 1,2
+ 'my slots full' => 'Invision has determined you have used all your queue slots', #ok 2
+ 'all slots full' => 'Sorry but the Maximum Allowed Queues of.*has been reached\. Please try again later',
+ 'sending file' => 'InstaSending|Sending .*(MB)+.*\.', #ok1
+ 'invalid file name' => 'File does not exists|ERROR:.*That is not a valid File', #ok1,2
+ 'already queued' => 'hàt queüé.*alreadý.*e×ísts in.*queuè slot.*, try ãnother fìlè', # ok1
+ 'dir changed' => '\[\\\.*\]', #ok
+ },
+ 'lamielle' => { #
+ 'EoWM' => '\[\\\]', # OK
+ 'my slots full' => 'You already have a send going, please do not try to get another file till it has stopped',
+ 'invalid file name' => 'Invalid filename', #OK
+ 'dir changed' => '\[\\\.*\]', #ok
+ },
+ );
+
+###
+# "DCC CHAT from nick" came (or dcc send from nick, but we don't care)
+sub sig_dcc_request {
+ my ($dcc, $sendaddr) = @_;
+ print_dbg("Signal 'dcc request': type '$dcc->{type}' from '$dcc->{nick}' on '$dcc->{servertag}' arg '$dcc->{arg}' sendaddr '$sendaddr'", 3);
+ my $nick = lc $dcc->{'nick'};
+ my $tag = $dcc->{'servertag'};
+
+ return if (($dcc->{type} ne 'CHAT')
+ or (not exists $serv{$tag})
+ or (not exists $serv{$tag}{$nick})
+ or ($serv{$tag}{$nick}{'state'} != 1));
+
+ print_dbg("Accepting connection", 3);
+ $serv{$tag}{$nick}{'state'} = 2;
+ $serv{$tag}{$nick}{'lastaction'} = time();
+ $dcc->{'server'}->command("DCC CHAT $dcc->{nick}");
+}
+
+###
+# dcc chat established or dcc get established
+sub sig_dcc_connected {
+ my $dcc = @_[0];
+ print_dbg("Signal 'dcc connected': type '$dcc->{type}' from '$dcc->{nick}' on '$dcc->{servertag}' arg '$dcc->{arg}'", 3);
+ my $nick = lc $dcc->{'nick'};
+ my $tag = $dcc->{'servertag'};
+
+ return if ((not exists $serv{$tag})
+ or (not exists $serv{$tag}{$nick}));
+ my $fserv = get_fserv($tag, $nick);
+ if ($dcc->{'type'} eq 'CHAT') {
+ return if ($$fserv{'state'} != 2);
+
+ print_dbg("Connection established", 3);
+ $$fserv{'state'} = 3;
+ $$fserv{'lastaction'} = time();
+ return;
+ }
+ if ($dcc->{'type'} eq 'GET') {
+ print_dbg("We have get!", 3);
+
+ my $fnumber = find_file($fserv, $dcc->{'arg'});
+ if ($fnumber == -1) {
+ print_dbg("We have not queued this file", 3);
+ return;
+ }
+
+ my $file = $$fserv{'files'}[$fnumber];
+ if ($$file{'state'} == 2) {
+ print_dbg("File completed, ignoring send", 3);
+ return;
+ }
+
+ $$file{'state'} = 1;
+ $$file{'size'} = $dcc->{'size'};
+ $$fserv{'lastaction'} = time();
+ $$fserv{'cfile'} = -1 if ($fnumber == $$fserv{'cfile'});
+
+ if (($$fserv{'state'} == 0 or $$fserv{'state'} == 6 or
+ $$fserv{'state'} == 8) and
+ (find_file_to_queue($tag, $nick) != -1)) {
+ initiate_connection($tag, $nick);
+ return;
+ }
+ return;
+ }
+}
+
+
+###
+# Finds number of file with name filename. File name has spaces changed
+# to underscores and the search is case nonsensitive
+# Does not care about file state
+# nick record, filename
+sub find_file_modified ($$) {
+ my ($fserv, $file) = @_;
+ my $number = -1;
+ foreach (@{$$fserv{files}}) {
+ $number++;
+ my $name = $$_{'name'};
+ $name =~ tr/A-Z /a-z_/; # FIXME : i hope locales won't be a problem...
+ return $number
+ if ($name =~ m/^\Q${file}\E$/i or $name =~ m/\/\Q${file}\E$/i);
+ }
+ return -1;
+}
+
+###
+# Finds number of file with name filename. Searches for exact match.
+# Does not care about file state
+# nick record, filename
+sub find_file_exact($$) {
+ my ($fserv, $file) = @_;
+ my $number = -1;
+ foreach (@{$$fserv{files}}) {
+ $number++;
+ return $number if ($$_{name} eq $file or $$_{name} =~ m|/\Q${file}\E$|);
+ }
+ return -1;
+}
+
+sub find_file($$) {
+ my ($fserv, $file) = @_;
+ my $num = find_file_exact($fserv, $file);
+ return $num if ($num >= 0);
+ return find_file_modified($fserv, $file);
+}
+
+###
+# End of dcc chat or end of dcc get
+sub sig_dcc_destroyed {
+ my $dcc = @_[0];
+ print_dbg("Signal 'dcc destroyed': type '$dcc->{type}' from '$dcc->{nick}' on '$dcc->{servertag}' arg '$dcc->{arg}'", 3);
+ my $nick = lc $dcc->{'nick'};
+ my $tag = $dcc->{'servertag'};
+
+ return if ((not exists $serv{$tag})
+ or (not exists $serv{$tag}{$nick}));
+
+ my $fserv = get_fserv($tag, $nick);
+
+ if ($dcc->{'type'} eq 'CHAT') { # TODO : sometimes we should reconnect at once (when?)
+ print_dbg("Chat connection closed", 3);
+ $$fserv{'state'} = 0 if ($$fserv{'state'} < 6);
+ $$fserv{'cfile'} = -1;
+ $$fserv{'lastaction'} = time();
+ @{$$fserv{'path'}} = ();
+
+ return;
+ }
+
+ if ($dcc->{'type'} eq 'GET') {
+ my $fnumber = find_file($fserv, $dcc->{'arg'});
+ if ($fnumber == -1) {
+ print_dbg("We have not queued this file", 3);
+ return;
+ }
+
+ my $file = $$fserv{'files'}[$fnumber];
+ if ($$file{'state'} == 2) {
+ print_dbg("File completed, ignoring this event", 3);
+ return;
+ }
+
+ print_dbg("Dcc get connection closed", 3);
+ $$fserv{'lastaction'} = time();
+
+ if ($dcc->{'size'} == $dcc->{'transfd'}) {
+ $$fserv{'files'}[$fnumber]{'state'} = 2;
+ $$fserv{'cfile'} = -1 if ($fnumber == $$fserv{'cfile'}); # possibile if we had send for the file from before script was loaded
+ } else {
+ if (!gets_exists($tag, $dcc->{'nick'}, $dcc->{'arg'})) {
+ $$fserv{'files'}[$fnumber]{'state'} = 0;
+ $$fserv{cfile} = -1 if ($fnumber == $$fserv{cfile}); # possibile if we had send for the file from before script was loaded
+ }
+ }
+
+ if (all_files_complete($tag, $nick)) {
+ $$fserv{'state'} = 7;
+ print_dbg("Leeching complete for nick $nick\@$tag", 2);
+ return;
+ }
+
+ if (($$fserv{'state'} == 0 or $$fserv{'state'} == 6 or
+ $$fserv{'state'} == 8) and
+ (find_file_to_queue($tag, $nick) != -1)) {
+ initiate_connection($tag, $nick);
+ return;
+ }
+
+ return;
+ }
+}
+
+###
+# Text was send thorough dcc chat
+# $dcc->{arg} is CHAT, what else can it be if type == CHAT?
+sub sig_dcc_chat_message {
+ my ($dcc, $message) = @_;
+ print_dbg("Signal 'dcc chat message': type '$dcc->{type}' from '$dcc->{nick}' on '$dcc->{servertag}' arg '$dcc->{arg}' message '$message'", 3);
+ my $nick = lc $dcc->{'nick'};
+ my $tag = $dcc->{'servertag'};
+
+ return if ((not exists $serv{$tag})
+ or (not exists $serv{$tag}{$nick})
+ or ($dcc->{'type'} ne 'CHAT'));
+
+ my $fserv = get_fserv($tag, $nick);
+ $$fserv{'lastaction'} = time();
+ if ($$fserv{'state'} == 3) { # waiting till end of welcome message
+ if ($$fserv{'type'} eq 'default') {
+ foreach (keys %servers) {
+ if ($message =~ /$_/i) {
+ $$fserv{'type'} = $servers{$_};
+ print_dbg("Recognized '$_' server", 2);
+ last;
+ }
+ }
+ }
+ if ($message =~ /$patterns{$$fserv{'type'}}{'EoWM'}/i) {
+ print_dbg("Got End of Welcome Message", 3);
+ get_next_file($dcc->{'server'}, $nick);
+ return;
+ }
+ if ((exists $patterns{$$fserv{'type'}}{'press S'} and
+ $message =~ /$patterns{$$fserv{'type'}}{'press S'}/i)) {
+ print_dbg("Pressing S", 3);
+ $dcc->{'server'}->command("MSG =$dcc->{nick} S");
+ return;
+ }
+ return;
+ }
+ if ($$fserv{'state'} == 4) { # changing dir
+ # TODO : should check $message for 'directory not existing' etc
+ print_dbg("Current state 4", 3);
+ if ($message =~ /$patterns{$$fserv{'type'}}{'dir changed'}/i) {
+ print_dbg("Directory successfully changed", 3);
+ get_next_file($dcc->{'server'}, $nick);
+ }
+ return;
+ }
+ if ($$fserv{'state'} == 5) { # sent "get file"
+ print_dbg("Current state 5", 3);
+ if ((exists $patterns{$$fserv{'type'}}{'file queued'} and
+ $message =~ /$patterns{$$fserv{'type'}}{'file queued'}/i) or
+ (exists $patterns{$$fserv{'type'}}{'sending file'} and
+ $message =~ /$patterns{$$fserv{'type'}}{'sending file'}/i)) {
+ print_dbg("File successfully queued", 3);
+ if ($$fserv{'cfile'} != -1) {
+ $$fserv{'files'}[$$fserv{'cfile'}]{'state'} = 3;
+ $$fserv{'cfile'} = -1;
+ }
+ get_next_file($dcc->{'server'}, $nick);
+ return;
+ }
+ if ((exists $patterns{$$fserv{'type'}}{'my slots full'} and
+ $message =~ /$patterns{$$fserv{'type'}}{'my slots full'}/i)) {
+ print_dbg("Can't queue file, my slots full", 3);
+ $$fserv{'cfile'} = -1;
+ $$fserv{'state'} = 8;
+ $dcc->{'server'}->command("MSG =$dcc->{nick} quit");
+ return;
+ }
+ if ((exists $patterns{$$fserv{'type'}}{'all slots full'} and
+ $message =~ /$patterns{$$fserv{'type'}}{'all slots full'}/i)) {
+ print_dbg("Can't queue file, all slots full", 3);
+ $$fserv{'cfile'} = -1;
+ $$fserv{'state'} = 0;
+ $dcc->{'server'}->command("MSG =$dcc->{nick} quit");
+ return;
+ }
+ if ((exists $patterns{$$fserv{'type'}}{'already queued'} and
+ $message =~ /$patterns{$$fserv{'type'}}{'already queued'}/i) or
+ (exists $patterns{$$fserv{'type'}}{'already sending'} and
+ $message =~ /$patterns{$$fserv{'type'}}{'already sending'}/i)) { # the same as 'file queued'
+ print_dbg("File has been already queued/sending", 3);
+ if ($$fserv{'cfile'} != -1) {
+ $$fserv{'files'}[$$fserv{'cfile'}]{'state'} = 3; # TODO : can it be that the file is in transfer?
+ $$fserv{'cfile'} = -1;
+ }
+ get_next_file($dcc->{'server'}, $nick);
+ return;
+ }
+ if (exists $patterns{$$fserv{'type'}}{'sending file'} and
+ $message =~ /$patterns{$$fserv{'type'}}{'sending file'}/i) { # the same as 'file queued'
+ print_dbg("File is being send at once", 3);
+ if ($$fserv{'cfile'} != -1) {
+ $$fserv{'files'}[$$fserv{'cfile'}]{'state'} = 3;
+ $$fserv{'cfile'} = -1;
+ }
+ get_next_file($dcc->{'server'}, $nick);
+ return;
+ }
+ }
+}
+
+###
+sub sig_no_such_nick {
+ my ($server, $args, $sender_nick, $sender_address) = @_;
+ my ($myself, $nick) = split(/ /, $args, 3);
+ print_dbg("no such nick '$nick' on '$server->{tag}'", 3);
+ $nick = lc $nick;
+ my $tag = $server->{'tag'};
+ return if ((not exists $serv{$tag}) or (not exists $serv{$tag}{$nick})
+ or ($serv{$tag}{$nick}{'state'} != 1));
+
+ $serv{$tag}{$nick}{'state'} = 0;
+ $serv{$tag}{$nick}{'lastaction'} = time();
+ print_dbg("Changed state to 0", 3);
+}
+
+###
+#
+sub sig_nicklist_changed {
+ my ($chan, $nick, $oldnick) = @_;
+ print_dbg("Nick change on $chan->{server}{tag} from $oldnick to $nick->{nick}", 3);
+ $nick = lc($nick->{'nick'});
+ my $tag = $chan->{'server'}{'tag'};
+ if ((exists $serv{$tag}) and
+ (exists $serv{$tag}{$oldnick})) {
+ print_dbg("Changing record for this nick", 3);
+ my $record = delete $serv{$tag}{$oldnick};
+ $serv{$tag}{$nick} = $record;
+ }
+}
+
+###
+# server tag, nick, filename
+sub gets_exists($$$) {
+ my ($tag, $nick, $file) = @_;
+ foreach (Irssi::Irc::dccs()) {
+ print_dbg("gets_exists: checking nick: '$_->{nick}', serv: '$_->{servertag}', type: '$_->{type}', arg: '$_->{arg}'", 4);
+ return 1 if ($_->{'type'} eq 'GET' and $tag eq $_->{servertag}
+ and $nick eq $_->{nick} and $file eq $_->{arg});
+ }
+ print_dbg("gets_exists: FOUND NO GETS", 3);
+ return 0;
+}
+
+###
+# Tries to get next file, we must be connected to fserv
+# server, nick
+sub get_next_file($$) {
+ my ($server, $nick) = @_;
+ my $fserv = get_fserv($server->{tag}, $nick);
+ my $fnumber = find_file_to_queue($server->{tag}, $nick);
+ if ($fnumber == -1) {
+ if (all_files_complete($server->{tag}, $nick)) {
+ $$fserv{state} = 7;
+ print_dbg("Leeching complete for nick $nick\@$server->{tag}", 2);
+ $server->command("MSG =$nick quit");
+ return;
+ }
+ # TODO : should wait a bit and see if the send comes
+ $$fserv{state} = 6;
+ print_dbg("Queued all files possibile", 3);
+ $server->command("MSG =$nick quit");
+ return;
+ }
+
+ print_dbg("Will try to get file number $fnumber", 3)
+ if ($$fserv{state} != 4);
+
+ if (change_dir($server->{tag}, $nick, $fnumber)) {
+ print_dbg("We're in the dir where the file is", 4);
+
+ $$fserv{state} = 5;
+ my @arr = split ('/', $$fserv{files}[$fnumber]{name});
+ $server->command("MSG =$nick get "
+ .(pop @arr) );
+
+ return;
+ }
+ return;
+}
+
+###
+# server tag, nick, file number
+# Tries to change current directory on fserve to the one where the file is
+# If it's in the dir returns true, if not yet returs false
+sub change_dir($$$) {
+ my ($tag, $nick, $fileno) = @_;
+ my $fserv = get_fserv($tag, $nick);
+ my $file = $$fserv{files}[$fileno];
+
+ my $server = Irssi::server_find_tag($tag);
+ if (!$server) {
+ # TODO : must do sth more in this case
+ print_dbg("Could not find server '$tag'", 3);
+ return;
+ }
+
+ $$fserv{state} = 4;
+
+ # simple case, file in root and we're in root
+ return 1 if (@{$$fserv{path}} == 0 and $$file{depth} == 0);
+
+ # we are deeper than the file, we must go up for sure.
+ if ($$file{depth} < @{$$fserv{path}}) {
+ print_dbg("change_dir: #5", 4);
+ pop @{$$fserv{path}};
+ $$fserv{lastaction} = time();
+ $server->command("MSG =$nick cd ..");
+ return 0;
+ }
+
+ my @fpath = split ('/', $$file{name}); pop @fpath; # has all dirs
+ print_dbg("File we want to traverse is '@fpath'", 4);
+
+ # we're in root dir, must cd to first dir for sure
+ if (@{$$fserv{path}} == 0) {
+ print_dbg("change_dir: #10", 4);
+ push (@{$$fserv{path}}, $fpath[0]);
+ $$fserv{lastaction} = time();
+ $server->command("MSG =$nick cd $fpath[0]");
+ return 0;
+ }
+
+ my @path = @{$$fserv{path}}; # just to have thing easier
+ while (@path) {
+ print_dbg("change_dir: comparing '$fpath[0]' and '$path[0]'", 4);
+ last if ($fpath[0] ne $path[0]); # go on as long as dirs are equal
+ shift @fpath; shift @path;
+ print_dbg("Current path='@path', fpath='@fpath'", 4);
+ }
+ if (@path == 0) { # so far we are on good path
+ print_dbg("change_dir: #15", 4);
+ return 1 if (@fpath == 0); # yup! no more dirs!
+
+ print_dbg("change_dir: #20", 4);
+ # must go deeper
+ push (@{$$fserv{path}}, $fpath[0]);
+ print_dbg("Going deeper, path='@path', fpath='@fpath'", 4);
+ $$fserv{lastaction} = time();
+ $server->command("MSG =$nick cd $fpath[0]");
+ return 0;
+ }
+
+ print_dbg("change_dir: #25", 4);
+ # dir is different - must go up
+ pop @{$$fserv{path}};
+ $$fserv{lastaction} = time();
+ $server->command("MSG =$nick cd ..");
+}
+
+###
+# Returns -1 if can't find it
+# server tag, nick
+sub find_file_to_queue($$) {
+ my ($tag, $nick) = @_;
+ my $fserv = get_fserv($tag, $nick);
+
+ return $$fserv{cfile} if ($$fserv{cfile} >= 0);
+
+ my $fnumber = -1;
+ foreach my $file (@{$$fserv{files}}) {
+ $fnumber++;
+ next unless ($$file{'state'} == 0);
+ $$fserv{cfile} = $fnumber;
+ return $fnumber;
+ }
+ return -1;
+}
+
+###
+# server tag, nick
+sub all_files_complete($$) {
+ my ($tag, $nick) = @_;
+ my $fserv = get_fserv($tag, $nick);
+ foreach (@{$$fserv{files}}) {
+ return 0 if ($$_{'state'} != 2); # FIXME : probably will have to be fixed when implemented missing files etc
+ }
+ return 1;
+}
+
+###
+# server tag, nick
+sub get_fserv($$) {
+ my ($tag, $nick) = @_;
+ return \%{$serv{$tag}{$nick}};
+}
+
+###
+# server tag, nick, trigger
+sub add_trigger ($$$) {
+ my ($tag, $nick, $trigger) = @_;
+ $nick = lc $nick;
+ my $fserv = get_fserv($tag,$nick);
+ if (not exists $$fserv{trigger}) {
+ @{$$fserv{path}} = ();
+ $$fserv{state} = 0;
+ $$fserv{type} = 'default';
+ $$fserv{cfile} = -1;
+ $$fserv{lastaction} = 0; # when was last action performed
+ @{$$fserv{files}} = ();
+ }
+ $$fserv{trigger} = $trigger;
+}
+
+###
+# server tag, nick, file
+sub add_file ($$$) {
+ my ($tag, $nick, $file) = @_;
+ $nick = lc $nick;
+ my $fserv = get_fserv($tag,$nick);
+ $file =~ s{^/}{};
+ $file =~ s{/$}{};
+ my $depth = ($file =~ tr|/||); # counting number of slashes ...
+ push (@{$$fserv{files}},
+ { 'name' => $file, 'state' => 0, 'depth' => $depth,
+ 'size' => -1});
+}
+
+###
+# server tag, nick
+sub initiate_connection($$) {
+ my ($tag, $nick) = @_;
+ my $server = Irssi::server_find_tag($tag);
+ if (!$server) {
+ print_dbg("Could not find server '$tag'", 3);
+ return;
+ }
+ my $fserv = get_fserv($tag,$nick);
+ print_dbg("Initiating connection with $nick", 3);
+ $$fserv{state} = 1;
+ $$fserv{lastaction} = time();
+ $server->command("CTCP $nick $$fserv{trigger}");
+}
+
+###
+# server tag, nick
+sub execute_next_command ($$) {
+ my ($tag, $nick) = @_;
+
+ my $fserv = get_fserv($tag,$nick);
+
+ if ($$fserv{'state'} == 0 or $$fserv{'state'} == 6 or $$fserv{'state'} == 8) {
+ initiate_connection($tag, $nick);
+ }
+
+ # if it's for example 'changing dir' don't wait for response but
+ # execute next command (i.e. next cd or get)
+}
+
+###
+#
+sub time4check {
+ my ($tag, $nick, $fserv);
+ my $time = time();
+ print_dbg("Time 4 check", 3);
+ my $recheck = Irssi::settings_get_int('fleech_recheck_interval');
+ my $conn_timeout = Irssi::settings_get_int('fleech_max_connecting_time');
+ foreach $tag (keys %serv) {
+ while (($nick, $fserv) = each %{$serv{$tag}}) {
+ next if ($$fserv{'lastaction'} == 0);
+ $$fserv{'state'} = 0
+ if (($$fserv{'state'} == 1 or $$fserv{'state'} == 2)
+ and ($time > $$fserv{'lastaction'} + $conn_timeout));
+ next if (($$fserv{'state'} != 0 and $$fserv{'state'} != 6
+ and $$fserv{'state'} != 8) or
+ ($time < $$fserv{'lastaction'} + $recheck) or
+ (find_file_to_queue($tag, $nick) == -1));
+
+ print_dbg ("Checking '$nick'\@'$tag'", 4);
+ execute_next_command($tag, $nick);
+ }
+ }
+}
+
+###
+# text[, level]
+sub print_dbg {
+ my ($txt, $mlvl) = @_;
+ my $lvl = Irssi::settings_get_int('fleech_verbose_level');
+if ($dbglog) {
+ if (not open (DBGLOG, ">>", $dbglog)) {
+ $dbglog = "";
+ } else {
+ # print_dbg("fleech.pl $VERSION loaded");
+ print DBGLOG time() . " $txt\n" if ($dbglog);
+ }
+}
+ Irssi::print("$txt") if ($mlvl < $lvl);
+}
+
+###
+# server tag, nick
+sub list_nick ($$) {
+ my ($s, $nick) = @_;
+ my $fserv = get_fserv($s, $nick);
+ print_dbg("Nick: '$nick'");
+ print_dbg(" type : '$$fserv{type}'");
+ print_dbg(" trigger: '$$fserv{trigger}'");
+ print_dbg(" state : '$$fserv{state}' "
+ ."($states{$$fserv{state}})");
+ print_dbg(" cfile : '$$fserv{cfile}'", 2);
+ print_dbg(" path : '@{$$fserv{path}}'", 2);
+ print_dbg(" lastaction: '$$fserv{lastaction}'", 2);
+ print_dbg(" files :");
+ my $fn = 0;
+ foreach my $file (@{$$fserv{files}}) {
+ print_dbg(" $fn)", 1); $fn++;
+ print_dbg(" name : '$$file{name}'");
+ print_dbg(" depth: '$$file{depth}'", 2);
+ print_dbg(" size : '$$file{size}'", 1);
+ print_dbg(" state: '$$file{state}' ($fstates{$$file{state}})");
+ }
+}
+#############################
+# take a string and expand it to an array of strings by substituting {00x,y} with 00x,00x+1,..,y
+# \{ is substituted with { and \\ with \ so \{->{ and \\{->\{
+sub expand_str($){
+ my ($str)=@_;
+ #print Dumper($str);
+ $str=~s/\%/\%\%/g;
+ my $from=0;
+ my $to=0;
+ my $zeros='';
+ if($str=~s/(^|[^\\])((\\\\)*)(\{(\d+),(\d+)\})/$1$2\%s/){
+ #print "matched\n";
+ $from=$5;
+ $to=$6;
+ $zeros=$from;
+ if($from=~/^0/){
+ $zeros='0'.length($from);
+ }else{
+ $zeros='';
+ }
+ }
+ $str=~s/\\\{/\{/g;
+ $str=~s/\\\\/\\/g;
+ #print Dumper($str);#" $str $from,$to\n";
+ my $toret=[];
+ for(my $i=$from;$i<=$to;$i++){
+ push @$toret,sprintf($str,sprintf('%'.$zeros.'d',$i));
+ }
+ return $toret;
+}
+
+###
+# /fleech add nick trigger /ctcp nick dupa
+# /fleech add nick file /dir/file
+sub cmd_fleech {
+ my ($data, $server, $channel) = @_;
+
+ my ($command, $nick, $rest) = split (" ", $data, 3);
+ $_ = $command;
+ if (/^list/) {
+ foreach my $s (keys %serv) {
+ print_dbg("Server '$s'");
+ foreach my $nick (keys %{$serv{$s}}) {
+ list_nick($s, $nick);
+ }
+ }
+ return;
+ }
+ if (/^add/) {
+ my ($type, $command) = split (" ", $rest, 2);
+ print_dbg("Adding type '$type' for '$nick' on '$server->{tag}': '$command'", 4);
+ if ($type eq 'trigger') {
+ add_trigger($server->{tag}, $nick, $command);
+ return;
+ }
+ if ($type eq 'file') {
+ if (not exists $serv{$server->{'tag'}} or
+ not exists $serv{$server->{'tag'}}{lc($nick)}) {
+ print_dbg("No such server or nick record");
+ return;
+ }
+ add_file($server->{tag}, $nick, $command);
+ return;
+ }
+ if ($type eq 'rfile') {
+ if (not exists $serv{$server->{'tag'}} or
+ not exists $serv{$server->{'tag'}}{lc($nick)}) {
+ print_dbg("No such server or nick record");
+ return;
+ }
+ my $papasv_list=expand_str($command);
+ my $papasv_item;
+ foreach $papasv_item (@$papasv_list){
+ #Irssi::print($papasv_item);
+ add_file($server->{tag}, $nick, $papasv_item);
+ }
+ return;
+ }
+ print_dbg("Unknown type '$type'");
+ return;
+ }
+ if (/^del/) {
+ }
+ if (/^set/) {
+ # set nick field value
+ # or in case of field == file:
+ # set nick file number field value
+ # or in case of field == nick:
+ # set nick nick newnick
+ # For example:
+ # /fleech set somenick type sysreset
+ # /fleech set somenick file 2 state complete
+ # /fleech set somenick nick newnick
+ my ($field, $rest) = split (" ", $rest, 2);
+ if (not exists $serv{$server->{'tag'}} or
+ not exists $serv{$server->{'tag'}}{lc($nick)}) {
+ print_dbg("No such server or nick record");
+ return;
+ }
+ if ($field eq 'files') {
+ my ($fn, $field, $rest) = split (" ", $rest, 3);
+ $serv{$server->{'tag'}}{lc($nick)}{'files'}[$fn]{$field} = $rest;
+ return;
+ } elsif ($field eq 'nick') {
+ if ((exists $serv{$server->{'tag'}}) and
+ (exists $serv{$server->{'tag'}}{lc($nick)})) {
+ my $record = delete $serv{$server->{'tag'}}{lc($nick)};
+ $serv{$server->{'tag'}}{lc($rest)} = $record;
+ return;
+ }
+ Irssi::print("No such server or nick");
+ return;
+ }
+ $serv{$server->{'tag'}}{lc($nick)}{$field} = $rest;
+ return;
+ }
+ if (/^go/) {
+ foreach my $s (keys %serv) {
+ foreach my $n (keys %{$serv{$s}}) {
+ if ($serv{$s}{$n}{state} == 0) {
+ execute_next_command($s, $n);
+ }
+ }
+ }
+ return;
+ }
+ if (/^clrc/) {
+ my $fc = 0;
+ foreach my $s (keys %serv) {
+ foreach my $n (keys %{$serv{$s}}) {
+ my $f = scalar @{$serv{$s}{$n}{'files'}};
+ while (--$f >= 0) {
+ if ($serv{$s}{$n}{'files'}[$f]{'state'} == 2) {
+ print_dbg("Removing from $n '"
+ ."$serv{$s}{$n}{files}[$f]{name}'", 1);
+ splice @{$serv{$s}{$n}{'files'}}, $f, 1;
+ $fc++;
+ }
+ }
+ @{$serv{$s}{$n}{'files'}} = () if (not @{$serv{$s}{$n}{'files'}});
+ }
+ }
+ print_dbg("Removed $fc file(s)") if ($fc);
+ return;
+ }
+
+}
+
+# FIXME: which one of signal_add{,_first,_last} use?
+Irssi::signal_add_last('nicklist changed', 'sig_nicklist_changed');
+Irssi::signal_add_last('dcc request', 'sig_dcc_request');
+Irssi::signal_add_last('dcc connected', 'sig_dcc_connected');
+Irssi::signal_add_last('dcc destroyed', 'sig_dcc_destroyed');
+Irssi::signal_add_last('dcc chat message', 'sig_dcc_chat_message');
+Irssi::signal_add("event 401", "sig_no_such_nick");
+
+
+Irssi::command_bind('fleech', 'cmd_fleech');
+
+Irssi::settings_add_int($IRSSI{'name'}, 'fleech_verbose_level', 1); # 0 - no messages at all, 1 - std messages, 2 - more verbose, 3 - even more verbose, 4 - debug messages
+Irssi::settings_add_int($IRSSI{'name'}, 'fleech_recheck_interval', 60*30); # check if can queue more files every this seconds
+Irssi::settings_add_int($IRSSI{'name'}, 'fleech_max_connecting_time', 60*5); # if fserv in state 1 or 2 more than this seconds, reset it to state 0
+Irssi::settings_add_int($IRSSI{'name'}, 'fleech_timeout', 60); # functions that checks timeouts etc is called every this seconds
+
+my $ttag = Irssi::timeout_add(1000*Irssi::settings_get_int('fleech_timeout'), "time4check", undef);
+
+
+
+# vim:ts=4:noexpandtab
diff --git a/scripts/fnotify.pl b/scripts/fnotify.pl
new file mode 100644
index 0000000..11707dd
--- /dev/null
+++ b/scripts/fnotify.pl
@@ -0,0 +1,140 @@
+use strict;
+use warnings;
+use vars qw($VERSION %IRSSI);
+use Irssi;
+
+$VERSION = '0.0.7';
+%IRSSI = (
+ name => 'fnotify',
+ authors => 'Tyler Abair, Thorsten Leemhuis, James Shubin' .
+ ', Serge van Ginderachter, Michael Davies',
+ contact => 'fedora@leemhuis.info, serge@vanginderachter.be',
+ description => 'Write notifications to a file in a consistent format.',
+ license => 'GNU General Public License',
+ url => 'http://www.leemhuis.info/files/fnotify/fnotify https://ttboj.wordpress.com/',
+);
+
+#
+# README
+#
+# To use:
+# $ cp fnotify.pl ~/.irssi/scripts/fnotify.pl
+# irssi> /load perl
+# irssi> /script load fnotify
+# irssi> /set fnotify_ignore_hilight 0 # ignore hilights of priority 0
+# irssi> /set fnotify_own on # turn on own notifications
+#
+
+#
+# AUTHORS
+#
+# Add self to notification file
+# version 0.0.7
+# Michael Davies <michael@the-davies.net>
+#
+# Ignore hilighted messages with priority = fnotify_ignore_hilight
+# version: 0.0.6
+# Tyler Abair <tyler.abair@gmail.com>
+#
+# Strip non-parsed left over codes (Bitlbee otr messages)
+# version: 0.0.5
+# Serge van Ginderachter <serge@vanginderachter.be>
+#
+# Consistent output formatting by James Shubin:
+# version: 0.0.4
+# https://ttboj.wordpress.com/
+# note: changed license back to original GPL from Thorsten Leemhuis (svg)
+#
+# Modified from the Thorsten Leemhuis <fedora@leemhuis.info>
+# version: 0.0.3
+# http://www.leemhuis.info/files/fnotify/fnotify
+#
+# In parts based on knotify.pl 0.1.1 by Hugo Haas:
+# http://larve.net/people/hugo/2005/01/knotify.pl
+#
+# Which is based on osd.pl 0.3.3 by Jeroen Coekaerts, Koenraad Heijlen:
+# http://www.irssi.org/scripts/scripts/osd.pl
+#
+# Other parts based on notify.pl from Luke Macken:
+# http://fedora.feedjack.org/user/918/
+#
+
+my %config;
+
+Irssi::settings_add_int('fnotify', 'fnotify_ignore_hilight' => -1);
+$config{'ignore_hilight'} = Irssi::settings_get_int('fnotify_ignore_hilight');
+
+Irssi::settings_add_bool('fnotify', 'fnotify_own', 0);
+$config{'own'} = Irssi::settings_get_bool('fnotify_own');
+
+Irssi::signal_add(
+ 'setup changed' => sub {
+ $config{'ignore_hilight'} = Irssi::settings_get_int('fnotify_ignore_hilight');
+ $config{'own'} = Irssi::settings_get_bool('fnotify_own');
+ }
+);
+
+#
+# catch private messages
+#
+sub priv_msg {
+ my ($server, $msg, $nick, $address, $target) = @_;
+ my $msg_stripped = Irssi::strip_codes($msg);
+ my $network = $server->{tag};
+ filewrite('' . $network . ' ' . $nick . ' ' . $msg_stripped);
+}
+
+#
+# catch 'hilight's
+#
+sub hilight {
+ my ($dest, $text, $stripped) = @_;
+ my $ihl = $config{'ignore_hilight'};
+ if ($dest->{level} & MSGLEVEL_HILIGHT && $dest->{hilight_priority} != $ihl) {
+ my $server = $dest->{server};
+ my $network = $server->{tag};
+ filewrite($network . ' ' . $dest->{target} . ' ' . $stripped);
+ }
+}
+
+#
+# catch own messages
+#
+sub own_public {
+ my ($dest, $msg, $target) = @_;
+ if ($config{'own'}) {
+ filewrite($dest->{'nick'} . ' ' .$msg );
+ }
+}
+
+sub own_private {
+ my ($dest, $msg, $target, $orig_target) = @_;
+ if ($config{'own'}) {
+ filewrite($dest->{'nick'} . ' ' .$msg );
+ }
+}
+
+#
+# write to file
+#
+sub filewrite {
+ my ($text) = @_;
+ my $fnfile = Irssi::get_irssi_dir() . "/fnotify";
+ if (!open(FILE, ">>", $fnfile)) {
+ print CLIENTCRAP "Error: cannot open $fnfile: $!";
+ } else {
+ print FILE $text . "\n";
+ if (!close(FILE)) {
+ print CLIENTCRAP "Error: cannot close $fnfile: $!";
+ }
+ }
+}
+
+#
+# irssi signals
+#
+Irssi::signal_add_last("message private", "priv_msg");
+Irssi::signal_add_last("print text", "hilight");
+Irssi::signal_add_last("message own_public", "own_public");
+Irssi::signal_add_last("message own_private", "own_private");
+
diff --git a/scripts/follow.pl b/scripts/follow.pl
new file mode 100644
index 0000000..74274e4
--- /dev/null
+++ b/scripts/follow.pl
@@ -0,0 +1,72 @@
+# This is useful with irssiproxy, to monitor irc on a separate terminal,
+# or if you just want to sit back and watch conversations. It just
+# lets Irssi go to the active window whenever there's any activity.
+#
+# It was made to demonstrate Irssi's new Perl capabilities...
+#
+# Juerd <juerd@juerd.nl>
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi qw(command_bind active_win);
+$VERSION = '1.10';
+%IRSSI = (
+ authors => 'Juerd',
+ contact => 'juerd@juerd.nl',
+ name => 'Follower',
+ description => 'Automatically switch to active windows',
+ license => 'Public Domain',
+ url => 'http://juerd.nl/irssi/',
+ changed => 'Thu Mar 19 11:00 CET 2002',
+);
+
+use Irssi 20011211 qw(signal_add command);
+
+sub sig_own {
+ my ($server, $msg, $target, $orig_target) = @_;
+ $server->print($target, 'Chatting with follow.pl loaded is very foolish.');
+}
+
+signal_add {
+ 'window hilight' => sub { command 'window goto active' },
+ 'message own_public' => \&sig_own,
+ 'message own_private' => \&sig_own,
+ 'message irc own_action' => \&sig_own
+};
+
+
+
+=comment
+
+ >> use Irssi 20011211 qw(signal_add command);
+
+ Loads the Irssi module, requiring at least version 20011211 and telling
+ it to export signal_add() and command() into our package.
+ This kind of version checking came available in the 20011208-snapshot.
+ Having te Irssi:: subs exported came available in the 20011211-snapshot.
+
+ >> sub sig_own
+
+ Warns the user: chatting while having windows switch all the time is
+ foolish, because your text gets sent to whatever window has the focus
+ when you press enter.
+
+ >> signal_add
+
+ This was exported into our package, so we can use signal_add() without the
+ "Irssi::" prefix. Since the 20011207 snapshot, you can add multiple signals
+ using a single add_signal(). If you want to do so, use a hash reference
+ (either { foo => bar, foo2 => bar2 } or \%hash).
+
+ >> sub { ... }
+ >> \&subname
+
+ These are references to subs(code). The first one is a reference to an
+ anonymous sub, the second one refers to a named one. Anonymous code
+ references allow for easy placement of oneliners :)
+ Irssi understands codereferences since the 20011207 snapshot.
+ Using references is better than having a string with the function name,
+ imho.
+
+=cut
diff --git a/scripts/foo.pl b/scripts/foo.pl
new file mode 100644
index 0000000..b80ecfa
--- /dev/null
+++ b/scripts/foo.pl
@@ -0,0 +1,75 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi qw(command_bind signal_add signal_emit signal_stop);
+
+$VERSION = '3.00';
+%IRSSI = (
+ authors => 'Juerd, Shiar',
+ contact => 'juerd@juerd.nl, shiar@shiar.org',
+ name => 'UeberRot encryption',
+ description => 'Rot n+i encryption and decryption',
+ license => 'Public Domain',
+ url => 'http://juerd.nl/site.plp/irssi',
+ changed => 'Tue Jan 21 01:40 CET 2003',
+);
+
+my $char1 = "\xC0-\xCF\xD2-\xD6\xD8-\xDD";
+my $char2 = "\xE0-\xF6\xF8-\xFF";
+
+sub rot {
+ my ($dir, $rotABC, $rot123, $rotshift, $msg) = @_;
+ my $i = 0;
+ for (0 .. length $msg) {
+ my $char = \substr $msg, $_, 1;
+ $i += $rotshift;
+ $$char =~ tr/a-zA-Z/b-zaB-ZA/ for 1..abs $dir *26 - ($rotABC + $i) % 26;
+ $$char =~ tr/0-9/1-90/ for 1..abs $dir *10 - ($rot123 + $i) % 10;
+ }
+ return $msg;
+}
+
+sub sig_message {
+ my $signal = shift;
+ my $msg = \$_[1];
+ return unless $$msg =~ s/^\cO(\cB+)\cO(\cB+)\cO(\cO*)//;
+ my $orig = $$msg;
+ $$msg = "\cB" . rot 1, length $1, length $2, length $3, $$msg;
+ $$msg =~ s{\c_\c_\cO([a-zA-Z])}<
+ my $char = $1;
+ eval qq{
+ \$char =~ tr/A-Z/$char1/;
+ \$char =~ tr/a-z/$char2/;
+ };
+ $char;
+ >ego;
+ signal_stop;
+ signal_emit($signal, $_[0], $orig, @_[2..$#_]);
+ signal_emit($signal, @_);
+}
+
+command_bind rot => sub {
+ my ($data, $server, $window) = @_;
+ $data =~ s/([$char1$char2])/\c_\c_\cO$1/og;
+ eval qq{
+ \$data =~ tr/$char1/A-Z/;
+ \$data =~ tr/$char2/a-z/;
+ };
+ my $rotABC = 1 + int rand 13;
+ my $rot123 = 1 + 2 * int rand 4;
+ my $rotshift = 1 + int rand 10;
+ $window->command(
+ sprintf "say \cO%s\cO%s\cO%s%s",
+ "\cB" x $rotABC,
+ "\cB" x $rot123,
+ "\cO" x $rotshift,
+ rot 0, $rotABC, $rot123, $rotshift, $data
+ );
+};
+
+signal_add {
+ 'message private' => sub { sig_message 'message private' => @_ },
+ 'message public' => sub { sig_message 'message public' => @_ },
+ 'message own_private' => sub { sig_message 'message own_private' => @_ },
+ 'message own_public' => sub { sig_message 'message own_public' => @_ },
+};
diff --git a/scripts/foreach_user.pl b/scripts/foreach_user.pl
new file mode 100644
index 0000000..23a1591
--- /dev/null
+++ b/scripts/foreach_user.pl
@@ -0,0 +1,59 @@
+use Irssi;
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.0";
+%IRSSI = (
+ authors => "David Leadbeater",
+ contact => "dgl\@dgl.cx",
+ url => "http://irssi.dgl.cx/",
+ license => "GNU GPLv2 or later",
+ name => "foreach user",
+ description => "Extends the /foreach command to have /foreach user
+ (users in a channel).
+ Syntax: /foreach user [hostmask] command.",
+);
+
+# Examples:
+# /foreach user /whois $0
+# /foreach user *!eviluser@* /k $0 evil! (consider kicks.pl ;) )
+
+Irssi::command_bind('foreach user', sub {
+ my($command) = @_;
+ return unless length $command;
+
+ my $mask = '*!*@*';
+ # see if it begins with a mask (kind of assumes cmdchars is /).
+ if($command !~ m!^/! && $command =~ /^\S+[!@]/) {
+ ($mask,$command) = split / /, $command, 2;
+ # make sure the mask is okay.
+ $mask .= '@*' if $mask !~ /\@/;
+ $mask = "*!$mask" if $mask !~ /!/;
+ }
+
+ my $channel = ref Irssi::active_win ? Irssi::active_win->{active} : '';
+ return unless ref $channel;
+
+ for my $nick($channel->nicks) {
+ next unless ref $nick;
+ next unless $channel->{server}->mask_match_address($mask, $nick->{nick},
+ $nick->{host} ? $nick->{host} : '');
+
+ # the backtracking is only so $$0 is escaped (don't ask me why...)
+ (my $tmpcommand = $command) =~ s/(?<!\$)\$(\d)/
+ if($1 == 0) {
+ $nick->{nick}
+ }elsif($1 == 1) {
+ $nick->{host}
+ }elsif($1 == 2) {
+ (split('@',$nick->{host}))[0];
+ }elsif($1 == 3) {
+ (split('@',$nick->{host}))[1];
+ }elsif($1 == 4) {
+ $nick->{realname}
+ }
+ /eg;
+ $tmpcommand =~ s/\$\$(\d)/\$$1/g;
+ $channel->command($tmpcommand);
+ }
+} );
+
diff --git a/scripts/fortune.pl b/scripts/fortune.pl
new file mode 100644
index 0000000..cb57da9
--- /dev/null
+++ b/scripts/fortune.pl
@@ -0,0 +1,124 @@
+#
+# fortune
+#
+# Edited by:
+# Ivo Marino <eim@cpan.org> 1.3 2004/12/17
+# bw1 <bw1@aol.at> 1.4 2019/05/30
+#
+# Required (Debian) packages:
+#
+# . fortune-mod The fortune core binaries
+# . fortunes-min Basic english fortune cookies
+#
+# Optional (Debian) packages:
+#
+# . fortunes-de German fortune cookies
+# . fortunes-it Italian fortune cookies
+#
+# Usage:
+#
+# Inside Irssi write: /fortune [nick] [-h] [-o options]
+# The optional [options] parameter can be:
+#
+# . en English
+# . de German
+# . it Italian
+# or anything else what the fortune command provide
+#
+# If not defined the fortune script defaults to en.
+#
+# Settings:
+#
+# fortune_command
+# fortune_default_args
+#
+# TODO:
+#
+# . Check if specified user exists.
+# . Handle direct user messaging.
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+use Getopt::Long qw/GetOptionsFromString/;
+$VERSION = '1.4';
+%IRSSI = (
+ authors => 'Ivo Marino',
+ contact => 'eim@cpan.rg',
+ name => 'fortune',
+ description => 'Send a random fortune cookie to an user in channel.',
+ license => 'Public Domain',
+);
+
+my ($nargs, $help);
+my %opts = (
+ 'h' => \$help,
+ 'o=s' => \$nargs,
+);
+
+sub fortune {
+
+ my ($param, $server, $witem) = @_;
+ my $return = 0;
+ my $cookie = '';
+ my $cmd = Irssi::settings_get_str($IRSSI{name}.'_command');
+ my $args = Irssi::settings_get_str($IRSSI{name}.'_default_args');
+ my ($ret, $arg)= GetOptionsFromString($param, %opts) or $help=1;
+ my $nick = $arg->[0];
+
+ if (!defined $help) {
+
+ if ($server || $server->{connected}) {
+
+ #Irssi::print ("Nick: " . $nick . ", Lang: \"" . $lang . "\"");
+
+ $args = $nargs if (defined $nargs);
+ $cookie = `$cmd $args`;
+
+ $cookie =~ s/\s*\n\s*/ /g;
+
+ if ($cookie) {
+
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ if (defined $nick) {
+ $witem->command('MSG ' . $witem->{name} . ' ' . $nick . ': ' . $cookie);
+ } else {
+ $witem->command('MSG ' . $witem->{name} .' '. $cookie);
+ }
+ } else {
+ Irssi::print ($cookie);
+ }
+
+ } else {
+
+ Irssi::print ("No cookie.");
+ $return = 1;
+ }
+
+ } else {
+
+ Irssi::print ("Not connected to server");
+ $return = 1;
+ }
+
+ } else {
+
+ Irssi::print ("Usage: /fortune [nick] [-h] [-o options]");
+ $return = 1;
+ }
+
+ $nick = undef;
+ $nargs= undef;
+ $help = undef;
+
+ return $return;
+}
+
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_command', 'fortune');
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_default_args', '');
+
+Irssi::command_bind ('fortune', \&fortune);
+
+# vim:set expandtab sw=4 ts=4:
diff --git a/scripts/forward.pl b/scripts/forward.pl
new file mode 100644
index 0000000..4fcb31b
--- /dev/null
+++ b/scripts/forward.pl
@@ -0,0 +1,128 @@
+#!/usr/bin/perl
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = '2003071904';
+%IRSSI = (
+ authors => 'Stefan \'tommie\' Tomanek',
+ contact => 'stefan@pico.ruhr.de',
+ name => 'Forward',
+ description => 'forward incoming messages to another nick',
+ license => 'GPLv2',
+ url => 'http://irssi.org/scripts/',
+ changed => $VERSION,
+ modules => '',
+ commands => "forward"
+);
+
+use Irssi 20020324;
+
+use vars qw(%forwards);
+
+sub show_help() {
+ my $help = $IRSSI{name}." ".$VERSION."
+/forward to <nick>
+ Forward incoming messages to <nick>
+/forward remove
+ Disable forwarding in the current chatnet
+
+You can remotely en- or disable forwarding by sending an
+ctcp command to your client. Set a password and use
+ /CTCP <nickname> forward <password>
+or
+ /CTCP <nickname> noforward
+to enable or diable forwarding to your current nick.
+";
+ my $text='';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP &draw_box($IRSSI{name}, $text, $IRSSI{name}." help", 1);
+}
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub sig_message_private ($$$$) {
+ my ($server, $msg, $nick, $address) = @_;
+ my $chatnet = $server->{chatnet};
+ return unless defined $forwards{$chatnet};
+ if ($forwards{$chatnet}{active}) {
+ my $to = $forwards{$chatnet}{to};
+ my $text = "[forwarded MSG from ".$nick."] ".$msg;
+ $server->command("notice $to ".$text);
+ }
+}
+
+sub sig_ctcp_msg_forward ($$$$$) {
+ my ($server, $args, $nick, $address, $target) = @_;
+ my $pass = Irssi::settings_get_str('forward_remote_password');
+ unless ($pass) {
+ print CLIENTCRAP '%R>>%n No forward password set, forwarding not enabled!';
+ $server->command("nctcp ".$nick." FORWARD Forwarding forbidden!");
+ return 0;
+ }
+ if ($pass eq $args) {
+ $server->command("nctcp ".$nick." FORWARD Forwarding enabled");
+ set_forward($server->{chatnet}, $nick);
+ }
+}
+
+sub sig_ctcp_msg_noforward ($$$$$) {
+ my ($server, $args, $nick, $address, $target) = @_;
+ my $chatnet = $server->{chatnet};
+ return unless defined $forwards{$chatnet};
+ return unless ($forwards{$chatnet}{to} eq $nick);
+ $server->command("nctcp ".$nick." NOFORWARD Forwarding disabled");
+ remove_forward($server->{chatnet});
+}
+
+
+sub set_forward ($$) {
+ my ($chatnet, $nick) = @_;
+ print CLIENTCRAP "%B>>%n Forwarding messages from $chatnet to > $nick <";
+ $forwards{$chatnet}{to} = $nick;
+ $forwards{$chatnet}{active} = 1;
+}
+
+sub remove_forward ($) {
+ my ($chatnet) = @_;
+ delete $forwards{$chatnet};
+ print CLIENTCRAP "%B>>%n No longer forwarding messages from $chatnet";
+}
+
+sub cmd_forward ($$$) {
+ my ($arg, $server, $witem) = @_;
+ return unless defined $server;
+ my @args = split(/ /, $arg);
+ if (@args < 1 || $args[0] eq 'help') {
+ show_help();
+ } elsif (@args[0] eq 'to') {
+ shift @args;
+ return unless @args;
+ set_forward($server->{chatnet}, $args[0]);
+ } elsif (@args[0] eq 'remove') {
+ remove_forward($server->{chatnet});
+ }
+}
+
+
+Irssi::signal_add('message private', \&sig_message_private);
+Irssi::signal_add('ctcp msg forward', \&sig_ctcp_msg_forward);
+Irssi::signal_add('ctcp msg noforward', \&sig_ctcp_msg_noforward);
+Irssi::settings_add_str($IRSSI{name}, 'forward_remote_password', '');
+
+Irssi::command_bind('forward' => \&cmd_forward);
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /forward help for help';
diff --git a/scripts/fpaste.pl b/scripts/fpaste.pl
new file mode 100644
index 0000000..4128575
--- /dev/null
+++ b/scripts/fpaste.pl
@@ -0,0 +1,264 @@
+use strict;
+use utf8;
+use HTTP::Tiny;
+use File::Glob ':bsd_glob';
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+
+$VERSION = '0.02';
+%IRSSI = (
+ authors => 'bw1',
+ contact => 'bw1@aol.at',
+ name => 'fpaste',
+ description => 'copy infos to fpaste',
+ license => 'Public Domain',
+ url => 'https://scripts.irssi.org/',
+ changed => '2021-01-24',
+ modules => 'HTTP::Tiny File::Glob',
+ commands=> 'fpaste',
+ selfcheckcmd=> 'fpaste -check',
+);
+
+my $help = << "END";
+%9Name%9
+ $IRSSI{name}
+%9Version%9
+ $VERSION
+%9Syntax%9
+ /$IRSSI{name} <-file <filename>> [-summary "summary"]
+ /$IRSSI{name} <-command <command>> [-summary "summary"]
+ /$IRSSI{name} <-sysinfo> [-summary "summary"]
+%9description%9
+ -file paste the file to fpaste
+ -command run the command and paste the result
+ -sysinfo colletct system infos and load them up
+ -check self check
+%9See also%9
+ http://fpaste.scsys.co.uk/irssi
+ https://github.com/rcaputo/bot-pastebot
+END
+
+my %fpaste_channels =(
+ '#irssi'=>1,
+ '#curl'=>1,
+ '#ledgersmb'=>1,
+ '#mojo'=>1,
+ '#ospkg'=>1,
+ '#perl'=>1,
+ '#r'=>1,
+ '#raku'=>1,
+);
+
+my $host="http://fpaste.scsys.co.uk";
+my $url="$host/paste";
+
+my $buffer;
+
+sub fpasteurl {
+ my ($res) = @_;
+ if( $res->{content} =~ m#($host/\d+)#) {
+ return $1;
+ } else {
+ return $res->{url};
+ }
+}
+
+sub paste {
+ my ($channel, $nick, $summary, $paste)= @_;
+ my $ht = HTTP::Tiny->new(
+ agent=>"irssi/$IRSSI{name} $VERSION");
+ my $data= {
+ channel=>$channel,
+ nick=>$nick,
+ summary=>$summary,
+ paste=>$paste,
+ 'Paste it'=>'Paste it',
+ };
+ my $res =$ht->post_form($url, $data);
+ return fpasteurl($res);
+}
+
+sub fslurp {
+ my ($filename) =@_;
+ $filename = bsd_glob $filename;
+ if ( -e $filename ) {
+ local $/;
+ open my $fi,'<',$filename;
+ my $data=<$fi>;
+ close $fi;
+ return $data;
+ }
+}
+
+sub getsetting {
+ my ($name)= @_;
+ my $s=$name. ": ";
+ $s .= Irssi::settings_get_str($name);
+ $s .= "\n";
+ return $s;
+}
+
+sub scripts {
+ my %all;
+ my $s;
+ foreach (sort grep s/::$//, keys %Irssi::Script::) {
+ no strict 'refs';
+ my %info = %{ "Irssi::Script::${_}::IRSSI" };
+ $info{version} = ${ "Irssi::Script::${_}::VERSION" };
+ $all{$_}={%info};
+ }
+ foreach (sort keys %all) {
+ $s .= sprintf "%-20s version: $all{$_}->{version}\n",$_;
+ }
+ return $s;
+}
+
+sub do_capture {
+ my ($cmd, $witem) = @_;
+ Irssi::signal_add_first('print text', 'sig_print_text');
+ if (defined $witem) {
+ $witem->command($cmd);
+ } else {
+ Irssi::command($cmd);
+ }
+ Irssi::signal_remove('print text', 'sig_print_text');
+}
+
+sub getbuf {
+ my $s= $buffer;
+ $buffer='';
+ $s =~ s/^-!- //m;
+ return $s;
+}
+
+sub sig_print_text {
+ my ($text_dest, $str, $stripped_str) = @_;
+ $buffer .= $stripped_str. "\n";
+ Irssi::signal_stop;
+}
+
+sub sysinfo {
+ my $info;
+ my $irssi;
+ $info .= "Irssi\n";
+ do_capture('eval echo version: $J');
+ $irssi .= getbuf();
+ do_capture('eval echo release date: $V');
+ $irssi .= getbuf();
+ $irssi .= getsetting('term_charset');
+ $irssi =~ s/^/ /mg;
+ $info .= $irssi;
+ #
+ my $scr;
+ $info .= "Scripts\n";
+ $scr .= scripts();
+ $scr =~ s/^/ /mg;
+ $info .= $scr;
+ #
+ my $mod;
+ $info .= "Modules\n";
+ do_capture('load');
+ $mod .= getbuf();
+ $mod =~ s/^/ /mg;
+ $info .= $mod;
+ #
+ $info .= "System\n";
+ my $sys;
+ $sys .= "Perl Version: $^V\n";
+ $sys .= "OS Name: $^O\n";
+ $sys .= "ENV TERM: $ENV{TERM}\n";
+ $sys .= "ENV XTERM_LOCALE: $ENV{XTERM_LOCALE}\n";
+ $sys .= "ENV LANG: $ENV{LANG}\n";
+ if ($^O eq 'linux') {
+ $sys .= ` uname -a`."\n";
+ $sys .= `cat /etc/os-release`. "\n";
+ }
+ $sys =~ s/^/ /mg;
+ $info .= $sys;
+ return $info;
+}
+
+sub self_check {
+ my ( $res ) = @_;
+ my $s="ok";
+ if ( $res !~ m/^http/ ) {
+ $s= "Error: url ($res)";
+ }
+ Irssi::print("fpaste: selfcheck: $s");
+ my $schs_version = $Irssi::Script::selfcheckhelperscript::VERSION;
+ Irssi::command("selfcheckhelperscript $s") if ( defined $schs_version );
+}
+
+sub cmd {
+ my ($args, $server, $witem)=@_;
+ my ($opt, $arg) = Irssi::command_parse_options($IRSSI{name}, $args);
+ my $channel='(none)';
+ my ($nick, $result, $summary, $paste, $run, $check);
+ my $serv= Irssi::active_server();
+ if ( defined $serv ){
+ $nick= $server->{nick};
+ } else {
+ $nick= Irssi::settings_get_str('nick');
+ }
+ if (defined $witem) {
+ if ($witem->{type} eq 'CHANNEL') {
+ if ( exists $fpaste_channels{$witem->{name}} ) {
+ $channel=$witem->{name};
+ $nick=$server->{nick};
+ }
+ }
+ }
+ if (exists $opt->{file}) {
+ $summary=$opt->{file};
+ $paste= fslurp($opt->{file});
+ $run=1;
+ }
+ if (exists $opt->{command}) {
+ $summary=$opt->{command};
+ do_capture($opt->{command}, $witem);
+ $paste=getbuf();
+ $run=1;
+ }
+ if (exists $opt->{sysinfo}) {
+ $summary='sysinfo';
+ $paste=sysinfo();
+ $run=1;
+ }
+ if (exists $opt->{summary}) {
+ $summary=$opt->{summary};
+ }
+ if (exists $opt->{check}) {
+ $summary='check';
+ $paste=sysinfo();
+ $run=1;
+ $check=1;
+ }
+ if ( defined $run ) {
+ $result= paste($channel, $nick, $summary, $paste);
+ if ( $check == 1 ) {
+ self_check($result);
+ $check=0;
+ }
+ if (defined $witem) {
+ $witem->print($result, MSGLEVEL_CLIENTCRAP);
+ } else {
+ Irssi::print($result, MSGLEVEL_CLIENTCRAP);
+ }
+ } else {
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ }
+}
+
+sub cmd_help {
+ my ($args, $server, $witem)=@_;
+ $args=~ s/\s+//g;
+ if ($IRSSI{name} eq $args) {
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop();
+ }
+}
+
+Irssi::command_bind($IRSSI{name}, \&cmd);
+Irssi::command_bind('help', \&cmd_help);
+Irssi::command_set_options($IRSSI{name}, "+file +command sysinfo +summary help check");
diff --git a/scripts/freenode_filter.pl b/scripts/freenode_filter.pl
new file mode 100644
index 0000000..2277c13
--- /dev/null
+++ b/scripts/freenode_filter.pl
@@ -0,0 +1,122 @@
+#!/usr/bin/perl -w
+
+## Bugreports and Licence disclaimer.
+#
+# For bugreports and other improvements contact Geert Hauwaerts <geert@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+##
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.06";
+
+%IRSSI = (
+ authors => 'Geert Hauwaerts',
+ contact => 'geert@irssi.org',
+ name => 'default.pl',
+ description => 'This script will filter some Freenode IRCD (Dancer) servernotices.',
+ license => 'GNU General Public License',
+ url => 'http://irssi.hauwaerts.be/freenode_filter.pl',
+ changed => 'Wed Sep 17 23:00:11 CEST 2003',
+);
+
+Irssi::theme_register([
+ 'window_missing', '%_Warning%_: %R>>%n You are missing the %_FILTER%_ window. Use %_/WINDOW NEW HIDDEN%_ and %_/WINDOW NAME FILTER%_ to create it.',
+ 'filter', '{servernotice $0} $1',
+ 'freenode_filter_loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.'
+]);
+
+sub check_filter {
+
+ if (!Irssi::window_find_name("FILTER")) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'window_missing');
+ return 0;
+ }
+
+ return 1;
+}
+
+sub parse_snote {
+
+ my ($dest, $text) = @_;
+
+ return if (($text !~ /^NOTICE/));
+
+ if ($text =~ /Notice -- Client connecting:/) {
+ filter_snote($dest, $text);
+ } elsif ($text =~ /Notice -- Illegal nick/) {
+ filter_snote($dest, $text);
+ } elsif ($text =~ /Notice -- Invalid username:/) {
+ filter_snote($dest, $text);
+ } elsif ($text =~ /Notice -- X-line Warning/) {
+ filter_snote($dest, $text);
+ } elsif ($text =~ /Notice -- Kick from/) {
+ filter_snote($dest, $text);
+ } elsif ($text =~ /Notice -- Client exiting:/) {
+ filter_snote($dest, $text);
+ } elsif ($text =~ /Notice -- (.*) confirms kill/) {
+ filter_snote($dest, $text);
+ } elsif ($text =~ /Notice -- Remove from/) {
+ filter_snote($dest, $text);
+ } elsif ($text =~ /Notice -- Flooder (.*)/) {
+ filter_snote($dest, $text);
+ } elsif ($text =~ /Notice -- Received KILL message for/) {
+ filter_snote($dest, $text);
+ }
+
+ if ($text =~ /Notice -- (.*) has removed the K-Line for:/) {
+ active_snote($dest, $text);
+ } elsif ($text =~ /Notice -- (.*) added K-Line for/) {
+ active_snote($dest, $text);
+ }
+}
+
+sub filter_snote {
+
+ my ($server, $snote) = @_;
+ my $win = Irssi::window_find_name("FILTER");
+ my $ownnick = $server->{nick};
+
+ $snote =~ s/^NOTICE $ownnick ://;
+
+ if (!check_filter()) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'window_missing');
+ return;
+ }
+
+ $win->printformat(MSGLEVEL_SNOTES, 'filter', $server->{real_address}, $snote);
+ Irssi::signal_stop();
+}
+
+sub active_snote {
+
+ my ($server, $snote) = @_;
+ my $ownnick = $server->{nick};
+ my $win = Irssi::active_win();
+
+ $snote =~ s/^NOTICE $ownnick ://;
+
+ $win->printformat(MSGLEVEL_SNOTES, 'filter', $server->{real_address}, $snote);
+ Irssi::signal_stop();
+}
+
+check_filter();
+
+Irssi::signal_add_first('server event', 'parse_snote');
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'freenode_filter_loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
diff --git a/scripts/friends_shasta.pl b/scripts/friends_shasta.pl
new file mode 100644
index 0000000..f05dd1a
--- /dev/null
+++ b/scripts/friends_shasta.pl
@@ -0,0 +1,2719 @@
+#!/usr/bin/perl -w
+#
+# This script may not work with irssi older than 0.8.5!
+#
+# Historical author of this script is Erkki Seppala <flux@inside.org>
+# Now it's maintained by me, so i'm listed as an author.
+#
+# $Id: friends.pl,v 1.3 2003/11/09 21:11:45 shasta Exp $
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "2.4.9";
+%IRSSI = (
+ authors => 'Jakub Jankowski',
+ contact => 'shasta@toxcorp.com',
+ name => 'Friends',
+ description => 'Maintains list of people you know.',
+ license => 'GNU GPLv2 or later',
+ url => 'http://toxcorp.com/irc/irssi/friends/',
+ changed => 'Sun Oct 9 22:12:43 2003'
+);
+
+use Irssi 20011201.0100 ();
+use Irssi::Irc;
+
+# friends.pl
+my $friends_version = $VERSION . " (20031109)";
+
+# release note, if any
+my $release_note = "Please read http://toxcorp.com/irc/irssi/friends/current/README\n";
+
+##############################################
+# These variables are adjustable with /set
+# but here are some 'safe' defaults:
+
+# do you want to process CTCP queries?
+my $default_friends_use_ctcp = 1;
+
+# space-separated list of allowed (implemented ;) CTCP commands
+my $default_friends_ctcp_commands = "OP VOICE LIMIT KEY INVITE PASS IDENT UNBAN";
+
+# do you want to learn new users?
+my $default_friends_learn = 1;
+
+# do you want to autovoice already opped nicks?
+my $default_friends_voice_opped = 0;
+
+# do you want to show additional info with /whois?
+my $default_friends_show_whois_extra = 1;
+
+# which flags do you want to add automatically with /addfriend? (case *sensitive*)
+my $default_friends_default_flags = "";
+
+# default path to friendlist
+my $default_friends_file = Irssi::get_irssi_dir() . "/friends";
+
+# do you want to save friendlist every time irssi's setup is saved
+my $default_friends_autosave = 0;
+
+# do you want to backup your friendlist upon a save
+my $default_friends_backup_friendlist = 1;
+
+# backup suffix to use (unixtime if empty)
+my $default_friends_backup_suffix = ".backup";
+
+# do you want to show friend's flags while he joins a channel?
+my $default_friends_show_flags_on_join = 1;
+
+# do you want to revenge?
+my $default_friends_revenge = 1;
+
+# revenge mode:
+# 0 Deop the user.
+# 1 Deop the user and give them the +D flag for the channel.
+# 2 Deop the user, give them the +D flag for the channel, and kick them.
+# 3 Deop the user, give them the +D flag for the channel, kick, and ban them.
+my $default_friends_revenge_mode = 0;
+
+# do you want /findfriends to print info in separate windows for separate chans?
+my $default_friends_findfriends_to_windows = 0;
+
+# maximum size of operationQueue
+my $default_friends_max_queue_size = 20;
+
+# min delaytime
+my $default_delay_min = 10;
+
+# max delaytime
+my $default_delay_max = 60;
+
+###############################################################
+
+# registering themes
+Irssi::theme_register([
+ 'friends_empty', 'Your friendlist is empty. Add items with /ADDFRIEND',
+ 'friends_notenoughargs', 'Not enough arguments. Usage: $0',
+ 'friends_badargs', 'Bad arguments. Usage: $0',
+ 'friends_nosuch', 'No such friend %R$0%n',
+ 'friends_notonchan', 'Not on channel {hilight $0}',
+ 'friends_endof', 'End of $0 $1',
+ 'friends_badhandle', 'Wrong handle: %R$0%n. $1',
+ 'friends_notuniqhandle', 'Handle %R$0%n already exists, choose another one',
+ 'friends_version', 'friends.pl\'s version: {hilight $0} [$1]',
+ 'friends_file_written', 'friendlist written on: {hilight $0}',
+ 'friends_file_version', 'friendlist written with: {hilight $0} [$1]',
+ 'friends_filetooold', 'Friendfile too old, loading aborted',
+ 'friends_loaded', 'Loaded {hilight $0} friends from $1',
+ 'friends_saved', 'Saved {hilight $0} friends to $1',
+ 'friends_duplicate', 'Skipping %R$0%n [duplicate?]',
+ 'friends_checking', 'Checking {hilight $0} took {hilight $1} secs [on $2]',
+ 'friends_line_head', '[$[!-3]0] Handle: %R$1%n, flags: %C$2%n [password: $3]',
+ 'friends_line_hosts', '$[-6]9 Hosts: $0',
+ 'friends_line_chan', '$[-6]9 Channel {hilight $0}: Flags: %c$1%n, Delay: $2',
+ 'friends_line_comment', '$[-6]9 Comment: $0',
+ 'friends_line_currentnick', '$[-6]9 [$1] Current nick: {nick $0}',
+ 'friends_line_channelson', '$[-6]9 [$1] Currently sharing with you: $0',
+ 'friends_joined', '{nick $0} is a friend, handle: %R$1%n, global flags: %C$2%n, flags for {hilight $3}: %C$4%n',
+ 'friends_whois', '{whois friend handle: {hilight $0}, global flags: $1}',
+ 'friends_queue_empty', 'Operation queue is empty',
+ 'friends_queue_line1', '[$[!-2]0] Operation: %R$1%n secs left before {hilight $2}',
+ 'friends_queue_line2', ' (Server: {hilight $0}, Channel: {hilight $1}, Nicklist: $2)',
+ 'friends_queue_nosuch', 'No such entry in operation queue ($0)',
+ 'friends_queue_removed', '$0 queues: {hilight $1} [$2]',
+ 'friends_friendlist', '{hilight Friendlist} [$0]:',
+ 'friends_friendlist_count', 'Listed {hilight $0} friend$1',
+ 'friends_findfriends', 'Looking for %R$2%n on channel {hilight $0} [on $1]:',
+ 'friends_already_added', 'Nick {hilight $0} matches one of %R$1%n\'s hosts',
+ 'friends_added', 'Added %R$0%n to friendlist',
+ 'friends_removed', 'Removed %R$0%n from friendlist',
+ 'friends_comment_added', 'Added comment line to %R$0%n ($1)',
+ 'friends_comment_removed', 'Removed comment line from %R$0%n',
+ 'friends_host_added', 'Added {hilight $1} to %R$0%n',
+ 'friends_host_removed', 'Removed {hilight $1} from %R$0%n',
+ 'friends_host_exists', 'Hostmask {hilight $1} overlaps with one of the already added to %R$0%n',
+ 'friends_host_notexists', '%R$0%n does not have {hilight $1} in hostlist',
+ 'friends_chanrec_removed', 'Removed {hilight $1} record from %R$0%n',
+ 'friends_chanrec_notexists', '%R$0%n does not have {hilight $1} record',
+ 'friends_changed_handle', 'Changed {hilight $0} to %R$1%n',
+ 'friends_changed_delay', 'Changed %R$0%n\'s delay value on {hilight $1} to %c$2%n',
+ 'friends_chflagexec', 'Executing %c$0%n for %R$1%n ($2)',
+ 'friends_currentflags', 'Current {channel $2} flags for %R$1%n are: %c$0%n',
+ 'friends_chpassexec', 'Altered password for %R$0%n',
+ 'friends_ctcprequest', '%R$0%n asks for {hilight $1} on {hilight $2}',
+ 'friends_ctcppass', 'Password for %R$0%n altered by $1',
+ 'friends_ctcpident', 'CTCP IDENT for %R$0%n from {hilight $1} succeeded',
+ 'friends_ctcpfail', 'Failed CTCP {hilight $0} from %R$1%n. $2',
+ 'friends_optree_header', 'Opping tree:',
+ 'friends_optree_line1', '%R$0%n has opped these:',
+ 'friends_optree_line2', '{hilight $[!-4]0} times: $1',
+ 'friends_general', '$0',
+ 'friends_notice', '[%RN%n] $0'
+]);
+
+my @friends = ();
+my $all_regexp_hosts = {};
+my $all_hosts = {};
+my $all_handles = {};
+my @operationQueue = ();
+my $timerHandle = undef;
+my $friends_file_version;
+my $friends_file_written;
+
+my $friends_PLAIN_HOSTS = 0;
+my $friends_REGEXP_HOSTS = 1;
+
+# Idea of moving userhost to a regexp and
+# the subroutine userhost_to_regexp were adapted from people.pl,
+# an userlist script made by Marcin 'Qrczak' Kowalczyk.
+# You can get that script from http://qrnik.knm.org.pl/~qrczak/irssi/people.pl
+# or from http://scripts.irssi.org/
+
+# HostToRegexp
+my %htr = ();
+# fill the hash
+foreach my $i (0..255) {
+ my $ch = chr($i);
+ $htr{$ch} = "\Q$ch\E";
+}
+# wildcards to regexp
+$htr{'?'} = '.';
+$htr{'*'} = '.*';
+
+# str userhost_to_regexp($userhost)
+# translates userhost to a regexp
+# lowercases host-part
+sub userhost_to_regexp($) {
+ my ($mask) = @_;
+ $mask = lowercase_hostpart($mask);
+ $mask =~ s/(.)/$htr{$1}/g;
+ return $mask;
+}
+
+# str lowercase_hostpart($userhost)
+# returns userhost with host-part loweracased
+sub lowercase_hostpart($) {
+ my ($host) = @_;
+ $host =~ s/(.+)\@(.+)/sprintf("%s@%s", $1, lc($2));/eg;
+ return $host;
+}
+
+# void print_version($what)
+# print's version of script/userlist
+sub print_version($) {
+ my ($what) = @_;
+ $what = lc($what);
+
+ if ($what eq "filever") {
+ if ($friends_file_version) {
+ my ($verbal, $numeric) = $friends_file_version =~ /^(.+)\ \(([0-9]+)\)$/;
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_file_version', $verbal, $numeric);
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_empty');
+ }
+ } elsif ($what eq "filewritten" && $friends_file_written) {
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($friends_file_written);
+ my $written = sprintf("%4d%02d%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec);
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_file_written', $written);
+ } else {
+ my ($verbal, $numerical) = $friends_version =~ /^(.+)\ \(([0-9]+)\)$/;
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_version', $verbal, $numerical);
+ }
+}
+
+# void print_releasenote()
+# suprisingly, prints a release note ;^)
+sub print_releasenote {
+ foreach my $line (split(/\n/, $release_note)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notice', $line);
+ }
+}
+
+# str friends_crypt($plain)
+# returns crypt()ed $plain, using random salt;
+# or "" if $plain is empty
+sub friends_crypt {
+ return if ($_[0] eq "");
+ return crypt("$_[0]", (join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]));
+}
+
+# bool friend_passwdok($idx, $pwd)
+# returns 1 if password is ok, 0 if isn't
+sub friends_passwdok {
+ my ($idx, $pwd) = @_;
+ return 1 if (crypt("$pwd", $friends[$idx]->{password}) eq $friends[$idx]->{password});
+ return 0;
+}
+
+# arr get_friends_channels($idx)
+# returns list of $friends[$idx] channels
+sub get_friends_channels {
+ return keys(%{$friends[$_[0]]->{channels}});
+}
+
+# arr get_friends_hosts($idx, $type)
+# returns list of $friends[$idx] regexp-hostmask if $type=$friends_REGEXP_HOSTS
+# returns list of plain-hostmasks if $type=$friends_PLAIN_HOSTS
+sub get_friends_hosts($$) {
+ if ($_[1] == $friends_REGEXP_HOSTS) {
+ return keys(%{$friends[$_[0]]->{regexp_hosts}});
+ } elsif ($_[1] == $friends_PLAIN_HOSTS) {
+ return keys(%{$friends[$_[0]]->{hosts}});
+ }
+ return undef;
+}
+
+# str get_friends_flags($idx[, $chan])
+# returns list of $chan flags for $idx
+# $chan can be also 'global' or undef
+# case insensitive about the $chan
+sub get_friends_flags {
+ my ($idx, $chan) = @_;
+ $chan = lc($chan);
+ if ($chan eq "" || $chan eq "global") {
+ return $friends[$idx]->{globflags};
+ } else {
+ foreach my $friendschan (get_friends_channels($idx)) {
+ if ($chan eq lc($friendschan)) {
+ return $friends[$idx]->{channels}->{$friendschan}->{flags};
+ }
+ }
+ }
+ return;
+}
+
+# str get_friends_delay($idx[, $chan])
+# returns $chan delay for $idx
+# returns "" if $chan is 'global' or undef
+# case insensitive about the $chan
+sub get_friends_delay {
+ my ($idx, $chan) = @_;
+ $chan = lc($chan);
+ if ($chan && $chan ne "global") {
+ foreach my $friendschan (get_friends_channels($idx)) {
+ if ($chan eq lc($friendschan)) {
+ return undef if ($friends[$idx]->{channels}->{$friendschan}->{delay} eq '');
+ return $friends[$idx]->{channels}->{$friendschan}->{delay};
+ }
+ }
+ }
+ return;
+}
+
+# struct friend new_friend($handle, $hoststr, $globflags, $chanflagstr, $password, $comment)
+# hoststr is: *!foo@host1 *!bar@host2 *!?baz@host3
+# chanstr is: #chan1,flags,delay #chan2,flags,delay
+sub new_friend {
+ my $friend = {};
+ my $idx = scalar(@friends);
+ $friend->{handle} = $_[0];
+ $all_handles->{lc($_[0])} = $idx;
+ $friend->{globflags} = $_[2];
+ $friend->{password} = $_[4];
+ $friend->{comment} = $_[5];
+ $friend->{friends} = [];
+
+ foreach my $host (split(/ +/, $_[1])) {
+ my $regexp_host = userhost_to_regexp($host);
+ my ($firstalpha) = $host =~ /\@(.)/;
+ $firstalpha = lc($firstalpha);
+
+ $friend->{hosts}->{$host} = $regexp_host;
+ $friend->{regexp_hosts}->{$regexp_host} = $host;
+ $all_regexp_hosts->{allhosts}->{$regexp_host} = lc($_[0]);
+ $all_regexp_hosts->{$firstalpha}->{$regexp_host} = lc($_[0]);
+ $all_hosts->{$host} = lc($_[0]);
+ }
+
+ foreach my $cfd (split(/ +/, $_[3])) {
+ # $cfd format: #foobar,oikl,15 (channelname,flags,delay)
+ my ($channel, $flags, $delay) = split(",", $cfd, 3);
+ $friend->{channels}->{$channel}->{exist} = 1;
+ $friend->{channels}->{$channel}->{flags} = $flags;
+ $friend->{channels}->{$channel}->{delay} = $delay;
+ }
+
+ return $friend;
+}
+
+# get_regexp_hosts_by_letter($letter)
+# returns those regexp masks whose host part begins with $letter, '?' or '*'
+sub get_regexp_hosts_by_letter($) {
+ my $l = lc(substr($_[0], 0, 1));
+ my @tmphosts = ();
+ push(@tmphosts, keys(%{$all_regexp_hosts->{$l}}));
+ push(@tmphosts, keys(%{$all_regexp_hosts->{'?'}}));
+ push(@tmphosts, keys(%{$all_regexp_hosts->{'*'}}));
+ return @tmphosts;
+}
+
+# bool is_allowed_flag($flag)
+# will be obsolete, soon.
+sub is_allowed_flag { return 1; }
+
+# bool is_ctcp_command($command)
+# check if $command is one of the implemented ctcp commands
+sub is_ctcp_command {
+ my ($command) = @_;
+ $command = uc($command);
+ foreach my $allowed (split(/[,\ \|]+/, uc(Irssi::settings_get_str('friends_ctcp_commands')))) {
+ return 1 if ($command eq $allowed);
+ }
+ return 0;
+}
+
+# int get_idx($nick, $userhost)
+# returns idx of the friend or -1 if not a friend
+# The New Approach (TM) :)
+sub get_idx($$) {
+ my ($nick, $userhost) = @_;
+ $userhost = lowercase_hostpart($nick.'!'.$userhost);
+ my ($letter) = $userhost =~ /\@(.)/;
+ my $idx = -1;
+
+ foreach my $regexp_host (get_regexp_hosts_by_letter($letter)) {
+ if ($userhost =~ /^$regexp_host$/) {
+ return get_idxbyhand($all_regexp_hosts->{allhosts}->{$regexp_host});
+ }
+ }
+
+ return -1;
+}
+
+# int get_idxbyhand($handle)
+# returns $idx of friend with $handle or -1 if no such handle
+# case insensitive
+sub get_idxbyhand($) {
+ my $handle = lc($_[0]);
+ if (exists $all_handles->{$handle}) {
+ return $all_handles->{$handle};
+ }
+ return -1;
+}
+
+# int get_handbyidx($idx)
+# returns $handle of friend with $idx or undef if no such $idx
+# case sensitive
+sub get_handbyidx($) {
+ my ($idx) = @_;
+ return undef unless ($idx > -1 && $idx < scalar(@friends));
+ return $friends[$idx]->{handle};
+}
+
+# bool friend_has_host($idx, $host)
+# checks wheter $host matches any of $friend[$idx]'s hostmasks
+# The New Approach (TM)
+sub friend_has_host($$) {
+ my ($idx, $host) = @_;
+ $host = lowercase_hostpart($host);
+ foreach my $regexp_host (keys (%{$friends[$idx]->{regexp_hosts}})) {
+ return 1 if ($host =~ /^$regexp_host$/);
+ }
+ return 0;
+}
+
+# void add_host($idx, $host)
+# adds $host wherever it's needed
+# $friends[$idx]->{handle} is A MUST for add_host() to work properly.
+sub add_host($$) {
+ my ($idx, $host) = @_;
+ my $regexp_host = userhost_to_regexp($host);
+ my ($firstalpha) = $host =~ /\@(.)/;
+ $firstalpha = lc($firstalpha);
+
+ $friends[$idx]->{hosts}->{$host} = $regexp_host;
+ $friends[$idx]->{regexp_hosts}->{$regexp_host} = $host;
+ $all_regexp_hosts->{allhosts}->{$regexp_host} = lc($friends[$idx]->{handle});
+ $all_regexp_hosts->{$firstalpha}->{$regexp_host} = lc($friends[$idx]->{handle});
+ $all_hosts->{$host} = lc($friends[$idx]->{handle});
+}
+
+# int del_host($idx, $host)
+# deletes $host from wherever it is
+# if given $host arg is '*', removes all hosts of this friend
+sub del_host($$) {
+ my ($idx, $host) = @_;
+ my $deleted = 0;
+
+ foreach my $regexp_host (keys (%{$friends[$idx]->{regexp_hosts}})) {
+ if ($host eq '*' || $host =~ /^$regexp_host$/) {
+ my $plain_host = $friends[$idx]->{regexp_hosts}->{$regexp_host};
+ my ($l) = $plain_host =~ /\@(.)/;
+
+ delete $friends[$idx]->{hosts}->{$plain_host};
+ delete $friends[$idx]->{regexp_hosts}->{$regexp_host};
+ delete $all_regexp_hosts->{allhosts}->{$regexp_host};
+ delete $all_regexp_hosts->{$l}->{$regexp_host};
+ delete $all_hosts->{$plain_host};
+ $deleted++;
+ }
+ }
+ return $deleted;
+}
+
+# bool friend_has_chanrec($idx, $chan)
+# checks wheter $friend[$idx] has a $chan record
+# case insensitive
+sub friend_has_chanrec {
+ my ($idx, $chan) = @_;
+ $chan = lc($chan);
+ foreach my $friendschan (get_friends_channels($idx)) {
+ return 1 if ($chan eq lc($friendschan));
+ }
+ return 0;
+}
+
+# bool add_chanrec($idx, $chan)
+# adds an empty $chan record to $friends[$idx]
+# case sensitive
+sub add_chanrec {
+ my ($idx, $chan) = @_;
+ return 0 unless ($idx > -1 && $idx < scalar(@friends));
+ $friends[$idx]->{channels}->{$chan}->{exist} = 1;
+ return 1;
+}
+
+# bool del_chanrec($idx, $chan)
+# deletes $chan record from $friends[$idx]
+# case *in*sensitive
+sub del_chanrec {
+ my ($idx, $chan) = @_;
+ my $deleted = 0;
+ foreach my $friendschan (get_friends_channels($idx)) {
+ if (lc($chan) eq lc($friendschan)) {
+ delete $friends[$idx]->{channels}->{$friendschan};
+ $deleted = 1;
+ }
+ }
+ return $deleted;
+}
+
+# arr del_friend($idxs)
+# removes friends
+# removes all hosts corresponding to this friend
+# returns array of removed friends
+sub del_friend($) {
+ my ($idxlist) = @_;
+ my @idxs = split(/ /, $idxlist);
+ return -1 unless (scalar(@idxs) > 0);
+ my @tmp = ();
+ my @result = ();
+ my @todelete = ();
+
+ foreach my $idx (@idxs) {
+ my $handle = get_handbyidx($idx);
+ if (!(!defined $handle || grep(/^\Q$handle\E$/i, @todelete))) {
+ push(@todelete, $handle);
+ del_host($idx, '*');
+ }
+ }
+ for (my $idx = 0; $idx < @friends; $idx++) {
+ if (grep(/^\Q$friends[$idx]->{handle}\E$/i, @todelete)) {
+ push(@result, $friends[$idx]);
+ } else {
+ push(@tmp, $friends[$idx]);
+ }
+ }
+ @friends = @tmp;
+ update_allhandles();
+ return @result;
+}
+
+# void update_all_handles()
+# updates $all_handles
+sub update_allhandles {
+ $all_handles = {};
+ for (my $idx = 0; $idx < @friends; $idx++) {
+ $all_handles->{lc($friends[$idx]->{handle})} = $idx
+ }
+}
+
+# bool is_unique_handle($handle)
+# checks if the $handle is unique for the whole friendlist
+# returns 1 if there's no such $handle
+# returns 0 if there is one.
+sub is_unique_handle($) {
+ return !exists $all_handles->{lc($_[0])};
+}
+
+# str choose_handle($proposed)
+# tries to choose a handle, closest to the $proposed one
+sub choose_handle {
+ my ($proposed) = @_;
+ my $counter = 0;
+ my $handle = $proposed;
+
+ # do this until we have an unique handle
+ while (!is_unique_handle($handle)) {
+ if (($handle !~ /([0-9]+)$/) && !$counter) {
+ # first, if handle doesn't end with a digit, append '2'
+ # (but only in first step)
+ $handle .= "2";
+ } elsif ($counter < 85) {
+ # later, increase the trailing number by one
+ # do that 84 times
+ my ($number) = $handle =~ /([0-9]+)$/;
+ ++$number;
+ $handle =~ s/([0-9]+)$/$number/;
+ } elsif ($counter == 85) {
+ # then, if it didn't helped, make $handle = $proposed."_"
+ $handle = $proposed . "_";
+ } elsif ($counter < 90) {
+ # if still unsuccessful, append "_" to the handle
+ # do that 4 times
+ $handle .= "_";
+ } else {
+ # if THAT didn't help -- make some silly handle
+ # and exit the loop
+ $handle = $proposed.'_'.(join '', (0..9, 'a'..'z')[rand 36, rand 36, rand 36, rand 36]);
+ last;
+ }
+ ++$counter;
+ }
+
+ # return our glorious handle ;-)
+ return $handle;
+}
+
+# bool friend_has_flag($idx, $flag[, $chan])
+# returns true if $friends[$idx] has $flag for $chan
+# (checks global flags, if $chan is 'global' or undef)
+# returns false if hasn't
+# case sensitive about the FLAG
+# case insensitive about the chan.
+sub friend_has_flag {
+ my ($idx, $flag, $chan) = @_;
+ $chan = "global" unless ($chan ne '');
+
+ return 1 if (get_friends_flags($idx, $chan) =~ /\Q$flag\E/);
+ return 0;
+}
+
+# bool friend_is_wrapper($idx, $chan, $goodflag, $badflag)
+# something to replace friend_is_* subs
+# true on: ($channel +$goodflag OR global +$goodflag) AND ($badflag == "" OR NOT $channel +$badflag))
+sub friend_is_wrapper($$$$) {
+ my ($idx, $chan, $goodflag, $badflag) = @_;
+ return 0 unless ($idx > -1);
+ if ((friend_has_flag($idx, $goodflag, $chan) ||
+ friend_has_flag($idx, $goodflag, undef)) &&
+ ($badflag eq "" || !friend_has_flag($idx, $badflag, $chan))) {
+ return 1;
+ }
+ return 0;
+}
+
+# bool add_flag($idx, $flag[, $chan])
+# adds $flag to $idx's $chan flags
+# $chan can be 'global' or undef
+# case insensitive about the $chan -- chooses the proper case.
+# returns 1 on success
+sub add_flag {
+ my ($idx, $flag, $chan) = @_;
+ $chan = lc($chan);
+ if ($chan eq "" || $chan eq "global") {
+ $friends[$idx]->{globflags} .= $flag;
+ return 1;
+ } else {
+ foreach my $friendschan (get_friends_channels($idx)) {
+ if ($chan eq lc($friendschan)) {
+ $friends[$idx]->{channels}->{$friendschan}->{flags} .= $flag;
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+# bool del_flag($idx, $flag[, $chan])
+# removes $flag from $idx's $chan flags
+# $chan can be 'global' or undef
+# case insensitive about the $chan -- chooses the proper case.
+sub del_flag {
+ my ($idx, $flag, $chan) = @_;
+ $chan = lc($chan);
+ if ($chan eq "" || $chan eq "global") {
+ $friends[$idx]->{globflags} =~ s/\Q$flag\E//g;
+ return 1;
+ } else {
+ foreach my $friendschan (get_friends_channels($idx)) {
+ if ($chan eq lc($friendschan)) {
+ $friends[$idx]->{channels}->{$friendschan}->{flags} =~ s/\Q$flag\E//i;
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+# bool change_delay($idx, $delay, $chan)
+# alters $idx's delay time for $chan
+# fails if $chan is 'global' or undef
+sub change_delay {
+ my ($idx, $delay, $chan) = @_;
+ $chan = lc($chan);
+ if ($chan && $chan ne "global") {
+ foreach my $friendschan (get_friends_channels($idx)) {
+ if ($chan eq lc($friendschan)) {
+ $friends[$idx]->{channels}->{$friendschan}->{delay} = $delay;
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+# void list_friend($window, $who, @data)
+# prints an info line about certain friend.
+# $who may be handle or idx
+# if you want to improve the look of the script, you should
+# change /format friends_*, probably.
+sub list_friend {
+ my ($win, $who, @data) = @_;
+ my $idx = $who;
+
+ $idx = get_idxbyhand($who) unless ($who =~ /^[0-9]+$/);
+
+ return unless ($idx > -1 && $idx < scalar(@friends));
+
+ my $globflags = get_friends_flags($idx, undef);
+
+ $win = Irssi::active_win() unless ($win);
+
+ $win->printformat(MSGLEVEL_CRAP, 'friends_line_head',
+ $idx,
+ get_handbyidx($idx),
+ (($globflags) ? "$globflags" : "[none]"),
+ (($friends[$idx]->{password}) ? "yes" : "no"));
+
+ $win->printformat(MSGLEVEL_CRAP, 'friends_line_hosts',
+ join(", ", get_friends_hosts($idx, $friends_PLAIN_HOSTS)) );
+
+ foreach my $chan (get_friends_channels($idx)) {
+ my $flags = get_friends_flags($idx, $chan);
+ my $delay = get_friends_delay($idx, $chan);
+ $win->printformat(MSGLEVEL_CRAP, 'friends_line_chan',
+ $chan,
+ (($flags) ? "$flags" : "[none]"),
+ (defined($delay) ? "$delay" : "random"));
+ }
+
+ if ($friends[$idx]->{comment}) {
+ $win->printformat(MSGLEVEL_CRAP, 'friends_line_comment', $friends[$idx]->{comment});
+ }
+
+ for my $item (@data) {
+ my ($ircnet, $nick, $chanstr) = split(" ", $item);
+ next unless (defined $ircnet);
+ $win->printformat(MSGLEVEL_CRAP, 'friends_line_currentnick', $nick, $ircnet) if ($nick ne '');;
+ $win->printformat(MSGLEVEL_CRAP, 'friends_line_channelson', join(", ", split(/,/, $chanstr)), $ircnet) if ($chanstr ne '');
+ }
+}
+
+# void add_operation($server, "#channel", "op|voice|deop|devoice|kick|kickban", timeout, "nick1", "nick2", ...)
+# adds a delayed (or not) operation
+sub add_operation {
+ my ($server, $channel, $operation, $timeout, @nicks) = @_;
+
+ # my dear queue, don't grow too big, mmkay? ;^)
+ my $maxsize = Irssi::settings_get_int('friends_max_queue_size');
+ $maxsize = $default_friends_max_queue_size unless ($maxsize > 0);
+ return if (@operationQueue >= $maxsize);
+
+ push(@operationQueue,
+ {
+ server=>$server, # server object
+ left=>$timeout, # seconds left
+ nicks=>[ @nicks ], # array of nicks
+ channel=>$channel, # channel name
+ operation=>$operation # operation ("op", "voice" and so on)
+ });
+
+ $timerHandle = Irssi::timeout_add(1000, 'timer_handler', 0) unless (defined $timerHandle);
+}
+
+# void timer_handler()
+# handles delay timer
+sub timer_handler {
+ my @ops = ();
+
+ # splice out expired timeouts. if they are expired, move them to
+ # local ops-queue. this allows creating new operations to the queue
+ # in the operation. (we're not (yet) doing that)
+
+ for (my $c = 0; $c < @operationQueue;) {
+ if ($operationQueue[$c]->{left} <= 0) {
+ push(@ops, splice(@operationQueue, $c, 1));
+ } else {
+ ++$c;
+ }
+ }
+
+ for (my $c = 0; $c < @ops; ++$c) {
+ my $op = $ops[$c];
+ my $channel = $op->{server}->channel_find($op->{channel});
+
+ # check if $channel is still active (you might've parted)
+ if ($channel) {
+ my @operationNicks = ();
+ foreach my $nickStr (@{$op->{nicks}}) {
+ my $nick = $channel->nick_find($nickStr);
+ # check if there's still such nick (it might've quit/parted)
+ if ($nick) {
+ if ($op->{operation} eq "op" && !$nick->{op}) {
+ push(@operationNicks, $nick->{nick});
+ }
+ if ($op->{operation} eq "voice" && !$nick->{voice} &&
+ (!$nick->{op} || Irssi::settings_get_bool('friends_voice_opped'))) {
+ push(@operationNicks, $nick->{nick});
+ }
+ if ($op->{operation} eq "deop" && $nick->{op}) {
+ push(@operationNicks, $nick->{nick});
+ }
+ if ($op->{operation} eq "devoice" && $nick->{voice}) {
+ push(@operationNicks, $nick->{nick});
+ }
+ if ($op->{operation} eq "kick") {
+ push(@operationNicks, $nick->{nick});
+ }
+ if ($op->{operation} eq "kickban") {
+ push(@operationNicks, $nick->{nick});
+ }
+ }
+ }
+ # final stage: issue desired command if we're a chanop
+ $channel->command($op->{operation}." ".join(" ", @operationNicks)) if ($channel->{chanop});
+ }
+ }
+
+ # decrement timeouts.
+ for (my $c = 0; $c < @operationQueue; ++$c) {
+ --$operationQueue[$c]->{left};
+ }
+
+ # if operation queue is empty, remove timer.
+ if (!@operationQueue && $timerHandle) {
+ Irssi::timeout_remove($timerHandle);
+ $timerHandle = undef;
+ }
+}
+
+# str replace_home($string)
+# replaces '~' with current $ENV{HOME}
+sub replace_home($) {
+ my ($string) = @_;
+ my $home = $ENV{HOME};
+ return undef unless ($string);
+ $string =~ s/^\~/$home/;
+ return $string;
+}
+
+# void load_friends($inputfile)
+# loads friends from file. uses $inputfile if supplied.
+# if not, uses friends_file setting. if this setting is empty,
+# uses default -- $friends_file
+sub load_friends {
+ my ($inputfile) = @_;
+ my $friendfile = undef;
+
+ if (defined($inputfile)) {
+ $friendfile = replace_home($inputfile);
+ } else {
+ $friendfile = replace_home(Irssi::settings_get_str('friends_file'));
+ }
+
+ $friendfile = $default_friends_file unless (defined $friendfile);
+
+ if (-e $friendfile && -r $friendfile) {
+ @friends = ();
+ $all_hosts = {};
+ $all_regexp_hosts = {};
+ $all_handles = {};
+
+ local *F;
+ open(F, "<", $friendfile) or return -1;
+ local $/ = "\n";
+ while (<F>) {
+ my ($handle, $hosts, $globflags, $chanstr, $password, $comment);
+ chop;
+
+ # dealing with empty lines
+ next if (/^[\w]*$/);
+
+ # dealing with comments
+ if (/^\#/) {
+ # script version
+ if (/^\# version = (.+)/) { $friends_file_version = $1; }
+ # timestamp
+ if (/^\# written = ([0-9]+)/) { $friends_file_written = $1; }
+ next;
+ }
+
+ # split by '%'
+ my @fields = split("%", $_);
+ foreach my $field (@fields) {
+ if ($field =~ /^handle=(.*)$/) { $handle = $1; }
+ elsif ($field =~ /^hosts=(.*)$/) { $hosts = $1; }
+ elsif ($field =~ /^globflags=(.*)$/) { $globflags = $1; }
+ elsif ($field =~ /^chanflags=(.*)$/) { $chanstr = $1; }
+ elsif ($field =~ /^password=(.*)$/) { $password = $1; }
+ elsif ($field =~ /^comment=(.*)$/) { $comment = $1; }
+ }
+
+ # handle cannot start with a digit
+ # skip friend if it does
+ next if ($handle =~ /^[0-9]/);
+
+ # if all fields were processed, and $handle is unique,
+ # make a friend and add it to $friends
+ if (is_unique_handle($handle)) {
+ push(@friends, new_friend($handle, $hosts, $globflags, $chanstr, $password, $comment));
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_duplicate', $handle);
+ }
+ }
+
+ close(F);
+
+ # if everything's ok -- print a message
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_loaded', scalar(@friends), $friendfile);
+ } else {
+ # whoops, bail out, but do not clear the friendlist.
+ Irssi::print("Cannot load $friendfile");
+ }
+}
+
+# void cmd_loadfriends($data, $server, $channel)
+# handles /loadfriends [file]
+sub cmd_loadfriends {
+ my ($file) = split(/ +/, $_[0]);
+ load_friends($file);
+}
+
+# void save_friends($auto)
+# saving friends to file
+sub save_friends {
+ my ($auto, $inputfile) = @_;
+ local *F;
+ my $friendfile = undef;
+ my $backup_suffix = Irssi::settings_get_str('friends_backup_suffix');
+ $backup_suffix = "." . time if ($backup_suffix eq '');
+
+ if (defined $inputfile) {
+ $friendfile = replace_home($inputfile);
+ } else {
+ $friendfile = replace_home(Irssi::settings_get_str('friends_file'));
+ }
+ $friendfile = $default_friends_file unless (defined $friendfile);
+
+ my $backupfile = $friendfile . $backup_suffix;
+ my $tmpfile = $friendfile . ".tmp" . time;
+
+ # be sane
+ my $old_umask = umask(077);
+
+ if (!defined open(F, ">", $tmpfile)) {
+ Irssi::print("Couldn't open $tmpfile for writing");
+ return 0;
+ }
+
+ # write script's version and update corresponding variable
+ $friends_file_version = $friends_version;
+ print(F "# version = $friends_file_version\n");
+ # write current unixtime and update corresponding variable
+ $friends_file_written = time;
+ print(F "# written = $friends_file_written\n");
+
+ # go through all entries
+ for (my $idx = 0; $idx < @friends; ++$idx) {
+ # get friend's channels, corresponding flags and delay values
+ # then put them as c,f,d fields into @chanstr
+ my @chanstr = ();
+ foreach my $chan (get_friends_channels($idx)) {
+ $chan =~ s/\%//g;
+ push(@chanstr, $chan.",".(get_friends_flags($idx, $chan)).",".
+ (get_friends_delay($idx, $chan)));
+ }
+
+ # write the actual line
+ print(F join("%",
+ "handle=".get_handbyidx($idx),
+ "hosts=".(join(" ", get_friends_hosts($idx, $friends_PLAIN_HOSTS))),
+ "globflags=".(get_friends_flags($idx, undef)),
+ "chanflags=".(join(" ", @chanstr)),
+ "password=".$friends[$idx]->{password},
+ "comment=".$friends[$idx]->{comment},
+ "\n"));
+ }
+ # done.
+
+ close(F);
+
+ rename($friendfile, $backupfile) if (Irssi::settings_get_bool('friends_backup_friendlist'));
+ rename($tmpfile, $friendfile);
+
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_saved', scalar(@friends), $friendfile) unless ($auto);
+
+ # restore umask
+ umask($old_umask);
+}
+
+# void cmd_savefriends($data, $server, $channel)
+# handles /savefriends [filename]
+sub cmd_savefriends {
+ my ($file) = split(/ +/, $_[0]);
+ eval {
+ save_friends(0, $file);
+ };
+ Irssi::print("Saving friendlist failed: $?") if ($?);
+}
+
+# void event_setup_saved($config, $auto)
+# calls save_friends to save friendslist while saving irssi's setup
+# (if friends_autosave is turned on)
+sub event_setup_saved {
+ my ($config, $auto) = @_;
+ return unless (Irssi::settings_get_bool('friends_autosave'));
+ eval {
+ save_friends($auto);
+ };
+ Irssi::print("Saving friendlist failed: $?") if ($?);
+}
+
+# void event_setup_reread($config)
+# calls load_friends() while setup is re-readed
+# (if friends_autosave is turned on)
+sub event_setup_reread {
+ load_friends() if (Irssi::settings_get_bool('friends_autosave'));
+}
+
+# int calculate_delay($idx, $chan)
+# calculates delay
+sub calculate_delay {
+ my ($idx, $chan) = @_;
+ my $delay = get_friends_delay($idx, $chan);
+ my $min = Irssi::settings_get_int('friends_delay_min');
+ my $max = Irssi::settings_get_int('friends_delay_max');
+
+ # lazy man's sanity checks :-P
+ $min = $default_delay_min if $min < 0;
+ $max = $default_delay_max if $min > $max;
+ $max = $max + $min if $min > $max;
+
+ # make a random delay unless we've got a fixed delay time already
+ $delay = int(rand ($max - $min)) + $min unless ($delay =~ /^[0-9]+$/);
+
+ return $delay;
+}
+
+# void check_friends($server, $channelstr, $options, @nickstocheck)
+# checks the given nicklist, channelname and server against the friendlist
+sub check_friends {
+ my ($server, $channelName, $options, @nicks) = @_;
+ my $channel = $server->channel_find($channelName);
+ my $delay = 30;
+ my %opList = ();
+ my %voiceList = ();
+
+ # server and channel -- a must.
+ return unless ($server && $channelName);
+
+ # proper !channels support, hopefully
+ my $noPrefix = $channelName;
+ $noPrefix = '!' . substr($channelName, 6) if ($channelName =~ /^\!/);
+
+ # get settings
+ my $voice_opped = Irssi::settings_get_bool('friends_voice_opped');
+
+ # for each nick from the given list
+ foreach my $nick (@nicks) {
+ # check if $nick is a friend
+ if ((my $idx = get_idx($nick->{nick}, $nick->{host})) > -1) {
+
+ # notify about the join if "showjoins" is set
+ if ($options =~ /showjoins/) {
+ my $globflags = get_friends_flags($idx, undef);
+ my $chanflags = get_friends_flags($idx, $noPrefix);
+
+ my $win = $server->window_item_find($channelName);
+ $win = Irssi::active_win() unless ($win);
+ $win->printformat(MSGLEVEL_CRAP, 'friends_joined',
+ $nick->{nick},
+ get_handbyidx($idx),
+ ($globflags) ? $globflags : "[none]",
+ $noPrefix,
+ ($chanflags) ? $chanflags : "[none]");
+ }
+
+ # notice1: password doesn't matter in this loop
+ # notice2: channel flags take precedence over the global ones
+
+ # handle auto-(op|voice)
+ if (friend_is_wrapper($idx, $noPrefix, "a", undef)) {
+ # add $nick to opList{delay} if he is a valid op
+ # and isn't opped already
+ # 'valid op' means: (chanflag +o OR globflag +o) AND NOT chanflag +d
+ if (friend_is_wrapper($idx, $noPrefix, "o", "d") && !$nick->{op}) {
+ # calculate delay, add to $opList{$delay}
+ $delay = calculate_delay($idx, $noPrefix);
+ $opList{$delay}->{$nick->{nick}} = 1;
+ }
+ # add $nick to voiceList{delay} if he is a valid voice
+ # and isn't voiced already
+ if (friend_is_wrapper($idx, $noPrefix, "v", undef) && !$nick->{voice} &&
+ (!$nick->{op} || $voice_opped)) {
+ # calculate delay, add to $voiceList{$delay}
+ $delay = calculate_delay($idx, $noPrefix);
+ $voiceList{$delay}->{$nick->{nick}} = 1;
+ }
+ }
+ }
+ }
+
+ # opping
+ foreach my $delay (keys %opList) {
+ add_operation($server, $channelName, "op", $delay, keys %{$opList{$delay}});
+ }
+ # voicing
+ foreach my $delay (keys %voiceList) {
+ add_operation($server, $channelName, "voice", $delay, keys %{$voiceList{$delay}});
+ }
+
+ timer_handler();
+}
+
+# void event_kick($server, $data, $nick)
+# handles kicks (for revenging)
+sub event_kick {
+ my ($server, $data, $kicker) = @_;
+ my ($channel, $kicked, $reason) = $data =~ /^([^ ]+) ([^ ]+) :(.*)$/;
+ my $channelInfo = $server->channel_find($channel);
+ my $myNick = $server->{nick};
+ my $victimInfo = undef;
+ my $kickerInfo = undef;
+ my $victimIdx = -1;
+ my $kickerIdx = -1;
+ my $noPrefix = $channel;
+ $noPrefix = '!' . substr($channel, 6) if ($channel =~ /^\!/);
+
+ return unless ($channelInfo);
+
+ # don't bother checking our own kicks, or self-kicks
+ return if ($kicker eq $myNick || $kicker eq $kicked);
+
+ $victimInfo = $channelInfo->nick_find($kicked);
+ $kickerInfo = $channelInfo->nick_find($kicker);
+ # we'll need both
+ return unless ($victimInfo && $kickerInfo);
+
+ $victimIdx = get_idx($victimInfo->{nick}, $victimInfo->{host});
+ $kickerIdx = get_idx($kickerInfo->{nick}, $kickerInfo->{host});
+
+ # check if we know the victim, and it wasn't a master who deopped
+ if ($victimIdx > -1 && !friend_is_wrapper($kickerIdx, $noPrefix, "m", undef)) {
+ # RRRRREVENGE!
+ my $revengemode = Irssi::settings_get_int('friends_revenge_mode');
+ if (Irssi::settings_get_bool('friends_revenge') && ($revengemode > -1 && $revengemode < 4) &&
+ friend_is_wrapper($victimIdx, $noPrefix, "p", undef)) {
+ # 0 Deop the user.
+ add_operation($server, $channel, "deop", 1, $kicker);
+ if ($revengemode > 0) {
+ # 1 Deop the user and give them the +D flag for the channel.
+ if ($kickerIdx < 0) {
+ push(@friends, new_friend(
+ choose_handle("bad1"), # handle
+ "*!".$kickerInfo->{host}, # hostmask
+ undef, # globflags
+ $noPrefix.",D,", # channel,chanflags,chandelay
+ undef, # password
+ "Kicked ".get_handbyidx($victimIdx)." off $noPrefix on $server->{tag}"));
+ } else {
+ friends_chflags($kickerIdx, "+D", $noPrefix);
+ }
+ if ($revengemode > 1 && $channelInfo->{chanop}) {
+ # 2 Deop the user, give them the +D flag for the channel, and kick them.
+ $channelInfo->command("KICK ". $channel . " ".$kicker. " Don't mess with my friends[.pl]");
+ if ($revengemode > 2) {
+ # 3 Deop the user, give them the +D flag for the channel, kick, and ban them.
+ $channelInfo->command("MODE ". $channel ." +b *!".$kickerInfo->{host});
+ }
+ }
+ }
+ }
+ }
+}
+
+# void event_modechange($server, $data, $nick)
+# handles modechanges and learning
+sub event_modechange {
+ my ($server, $data, $nick) = @_;
+ my ($channel, $modeStr, $nickStr) = $data =~ /^([^ ]+) ([^ ]+) (.*)$/;
+ my @modeargs = split(" ", $nickStr);
+ my $ptr = 0;
+ my $mode = undef;
+ my $gotOpped = 0;
+ my $learnFriends = Irssi::settings_get_bool('friends_learn');
+ my $opperInfo = undef;
+ my $opperIdx = -1;
+ my $learnFromOpper = 0;
+ my $channelInfo = $server->channel_find($channel);
+ my $myNick = $server->{nick};
+ # !channels support :)
+ my $noPrefix = $channel;
+ $noPrefix = '!' . substr($channel, 6) if ($channel =~ /^\!/);
+
+ # don't bother checking our own modes
+ return if ($nick eq $myNick);
+
+ # we need $channelInfo to do almost every other things;
+ return unless (defined $channelInfo);
+
+ $opperInfo = $channelInfo->nick_find($nick);
+ $opperIdx = get_idx($opperInfo->{nick}, $opperInfo->{host}) if ($opperInfo);
+
+ # learn if learning is enabled,
+ # we know the opper, and we're allowed to learn from him
+ if ($learnFriends && $opperIdx > -1 &&
+ (friend_is_wrapper($opperIdx, $noPrefix, "F", undef))) {
+ $learnFromOpper = 1;
+ }
+
+ # process the mode string
+ foreach my $char (split(//, $modeStr)) {
+
+ if ($char eq "+") { $mode = "+";
+ } elsif ($char eq "-") { $mode = "-";
+
+ # op/deop, it wasn't a self-op/deop
+ } elsif (lc($char) eq "o" && ($nick ne $modeargs[$ptr])) {
+ my $victim = $channelInfo->nick_find($modeargs[$ptr]);
+ my $victimIdx = -1;
+ $victimIdx = get_idx($victim->{nick}, $victim->{host}) if ($victim);
+
+ # someone +o foobar
+ if ($mode eq "+") {
+ # hooray, i got opped!
+ if ($modeargs[$ptr] eq $myNick) {
+ $gotOpped = 1;
+ # should learn?
+ } elsif ($learnFromOpper && $victim) {
+ # handle the learning stuff.
+ my $friend;
+
+ if ($victimIdx == -1) {
+ # we got someone not known before
+ # choose a handle for him and add him to our friendlist with +L $noPrefix
+ $friend = new_friend(
+ choose_handle($modeargs[$ptr]), # handle
+ "*!".$victim->{host}, # hostmask
+ undef, # globflags
+ $noPrefix.",L,", # channel,chanflags,chandelay
+ undef, # password
+ "Learnt (opped by $friends[$opperIdx]->{handle} on $noPrefix\@$server->{tag})" # comment
+ );
+ push(@friends, $friend);
+ } else {
+ # we know him already
+ $friend = $friends[$victimIdx];
+ }
+
+ if ($victimIdx == -1 || get_friends_flags($victimIdx, $noPrefix) eq "L") {
+ # add him to the opper's friendlist
+ # ($opperIdx != -1, we've checked that with $learnFromOpper earlier)
+ push(@{$friends[$opperIdx]->{friends}}, $friend);
+ }
+
+ } elsif (friend_is_wrapper($victimIdx, $noPrefix, "D", undef) && !friend_is_wrapper($opperIdx, $noPrefix, "m", undef)) {
+ add_operation($server, $channel, "deop", 1, $modeargs[$ptr]);
+ }
+
+ # deop
+ } elsif ($mode eq "-") {
+ if ($victim) {
+ # check if we know the victim, and it wasn't a master who deopped
+ if ($victimIdx > -1 && !friend_is_wrapper($opperIdx, $noPrefix, "m", undef)) {
+ # RRRRREVENGE!
+ my $revengemode = Irssi::settings_get_int('friends_revenge_mode');
+ if (Irssi::settings_get_bool('friends_revenge') && ($revengemode > -1 && $revengemode < 4) &&
+ friend_is_wrapper($victimIdx, $noPrefix, "p", undef)) {
+ # 0 Deop the user.
+ add_operation($server, $channel, "deop", 1, $nick);
+ if ($revengemode > 0 && $opperInfo) {
+ # 1 Deop the user and give them the +D flag for the channel.
+ if ($opperIdx < 0) {
+ push(@friends, new_friend(
+ choose_handle("bad1"), # handle
+ "*!".$opperInfo->{host}, # hostmask
+ undef, # globflags
+ $noPrefix.",D,", # channel,chanflags,chandelay
+ undef, # password
+ "Deopped ".get_handbyidx($victimIdx)." on $noPrefix\@$server->{tag}"));
+ } else {
+ friends_chflags($opperIdx, "+D", $noPrefix);
+ }
+
+ if ($revengemode > 1 && $channelInfo->{chanop}) {
+ # 2 Deop the user, give them the +D flag for the channel, and kick them.
+ $channelInfo->command("KICK ". $channel . " ".$opperInfo->{nick}. " Don't mess with my friends[.pl]");
+ if ($revengemode > 2) {
+ # 3 Deop the user, give them the +D flag for the channel, kick, and ban them.
+ $channelInfo->command("MODE ". $channel ." +b *!".$opperInfo->{host});
+ }
+ }
+ }
+ }
+ # if a +r'ed person was deopped, perform a reop
+ if (friend_is_wrapper($victimIdx, $noPrefix, "r", "d")) {
+ add_operation($server, $channel, "op", calculate_delay($victimIdx, $channel), $modeargs[$ptr])
+ }
+ }
+ }
+ }
+ # increase pointer, 'o' mode has argument, *always*
+ $ptr++;
+ } elsif ($char =~ /[beIqdhvk]/ || ($char eq "l" && $mode eq "+")) {
+ # increase pointer, these modes have arguments as well
+ $ptr++;
+ }
+ }
+
+ if ($gotOpped) {
+ # calling check_friends with !BLARHchannel, since removing BLARH is done there
+ check_friends($server, $channel, undef, $channelInfo->nicks());
+ }
+}
+
+# void event_massjoin($channel, $nicklist)
+# handles join event
+sub event_massjoin {
+ my ($channel, $nicksList) = @_;
+ my @nicks = @{$nicksList};
+ my $server = $channel->{'server'};
+ my $channelName = $channel->{name};
+ my $options;
+ $options = "showjoins|" if Irssi::settings_get_bool("friends_show_flags_on_join");
+
+ my $begin = time;
+
+ check_friends($server, $channelName, $options, @nicks);
+
+ if ((my $duration = time - $begin) >= 1) {
+ # if checking took more than 1 second -- print a message about it
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_checking', $channelName, $duration, $server->{address});
+ }
+}
+
+# void event_nicklist_changed($channel, $nick, $oldnick)
+# some kind of nick-tracking
+# alters operationQueue if someone from there has changed nick
+sub event_nicklist_changed {
+ my ($channel, $nick, $oldnick) = @_;
+
+ # nicknames are case insensitive
+ return if (lc($oldnick) eq lc($nick->{nick}));
+
+ # cycle through all operation queues
+ for (my $c = 0; $c < @operationQueue; ++$c) {
+ # temporary array
+ my @nickarr = ();
+ # is there any nick in this queue that needs altering?
+ my $found = 0;
+
+ # skip if tags don't match
+ next unless ($operationQueue[$c]->{server}->{tag} eq $channel->{server}->{tag});
+
+ # cycle through all nicks in single operation queue
+ foreach my $opnick (@{$operationQueue[$c]->{nicks}}) {
+ # if $oldnick was in the queue
+ if (lc($oldnick) eq lc($opnick)) {
+ # ... replace it with the new one
+ push(@nickarr, $nick->{nick});
+ $found = 1;
+ } else {
+ # ... else -- keep the old one
+ push(@nickarr, $opnick);
+ }
+ }
+
+ # replace $opQ[$c]->{nicks} with our new nicklist if any nick needed updating
+ $operationQueue[$c]->{nicks} = [ @nickarr ] if ($found);
+ }
+}
+
+# void event_server_disconnected($server, $anything)
+# removes all queues related to $server from @operationQueue
+sub event_server_disconnected {
+ my ($server, $anything) = @_;
+ my @removed = ();
+
+ # cycle through all operation queues
+ for (my $c = 0; $c < @operationQueue;) {
+ if ($operationQueue[$c]->{server}->{tag} eq $server->{tag}) {
+ push(@removed, splice(@operationQueue, $c, 1));
+ } else {
+ ++$c;
+ }
+ }
+
+ # if operation queue is empty, remove the timer.
+ if (scalar(@removed) && !@operationQueue && $timerHandle) {
+ Irssi::timeout_remove($timerHandle);
+ $timerHandle = undef;
+ }
+}
+
+# void cmd_opfriends($data, $server, $channel)
+# handles /opfriends #channel
+sub cmd_opfriends {
+ my ($data, $server, $channel) = @_;
+ my ($chan) = split(/ +/, $data);
+ my $usage = "/OPFRIENDS [channel]";
+ my @chanstocheck = ();
+
+ if (!$server) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No server item in current window");
+ return;
+ }
+
+ # no argument given
+ if ($chan eq "") {
+ if (!$channel) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No usable channel item in current window");
+ return;
+ } elsif ($channel->{type} ne "CHANNEL") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "Current window item is not a channel");
+ return;
+ } else {
+ push(@chanstocheck, $channel->{name});
+ }
+ # all channels on current server
+ } elsif ($chan eq "*") {
+ foreach my $c ($server->channels()) {
+ push(@chanstocheck, $c->{name});
+ }
+ # specified channel on current server
+ } else {
+ push(@chanstocheck, $chan);
+ }
+
+ foreach my $channelName (@chanstocheck) {
+ my $chanInfo = $server->channel_find($channelName);
+ if (!$chanInfo) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notonchan', $channelName);
+ next;
+ }
+
+ # !channels support
+ my $noPrefix = $chanInfo->{name};
+ $noPrefix = '!' . substr($chanInfo->{name}, 6) if ($chanInfo->{name} =~ /^\!/);
+
+ my @opnicks = ();
+ foreach my $nick ($chanInfo->nicks()) {
+ # skip already opped nicks
+ next if ($nick->{op});
+ # check for friends
+ my $idx = get_idx($nick->{nick}, $nick->{host});
+ # skip not-friends
+ next unless ($idx > -1);
+ # add $nick's nick to oplist if enough flags for this channel
+ push(@opnicks, $nick->{nick}) if (friend_is_wrapper($idx, $noPrefix, "o", "d"));
+ }
+
+ # add stuff to the operation queue
+ add_operation($server, $noPrefix, "op", "0", @opnicks);
+ }
+
+ timer_handler();
+}
+
+# void cmd_queue($data, $server, $channel)
+# expands to queue show|purge|flush
+sub cmd_queue($$$) {
+ my ($data, $server, $channel) = @_;
+ Irssi::command_runsub("queue", $data, $server, $channel);
+}
+
+# bool queue_flush_expand(%what)
+# "... and few lines of The Magic Code. Now. Your poison is ready."
+sub queue_flush_expand {
+ my ($flush) = @_;
+ my $result = 0;
+
+ foreach my $s (keys(%{$flush})) {
+ # is this server active?
+ my $server = Irssi::server_find_tag($s);
+ next unless (defined $server);
+
+ foreach my $c (keys(%{$flush->{$s}})) {
+ # is this channel active?
+ my $channel = $server->channel_find($c);
+ next unless (defined $channel);
+
+ # for each pending operation
+ foreach my $o (sort keys(%{$flush->{$s}->{$c}})) {
+ my @nicklist = ();
+ foreach my $nickStr (sort keys(%{$flush->{$s}->{$c}->{$o}})) {
+ # is this nick still here?
+ if (my $nick = $channel->nick_find($nickStr)) {
+ push(@nicklist, $nick->{nick});
+ }
+ }
+
+ if (my $nickstr = join(" ", @nicklist)) {
+ $channel->command($o." ".$nickstr);
+ $result = 1;
+ }
+ }
+ }
+ }
+ return $result;
+}
+
+# void queue_show($data, $server, $channel)
+# handles /QUEUE SHOW
+# prints @operationQueue's contents
+sub cmd_queue_show {
+ if (!@operationQueue) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_empty');
+ return;
+ }
+
+ # cycle through all operation queues
+ for (my $c = 0; $c < @operationQueue; ++$c) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_line1',
+ $c,
+ $operationQueue[$c]->{left},
+ $operationQueue[$c]->{operation}
+ );
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_line2',
+ $operationQueue[$c]->{server}->{address},
+ $operationQueue[$c]->{channel},
+ join(", ", @{$operationQueue[$c]->{nicks}})
+ );
+ }
+}
+
+# void cmd_queue_flush($data, $server, $channel)
+# handles /QUEUE FLUSH <number|all>
+# flushes given/all queue(s)
+sub cmd_queue_flush {
+ my ($data) = split(/ +/, $_[0]);
+ my $usage = "/QUEUE FLUSH <number|all>";
+ my @flushqueue = ();
+ my $flushdata = {};
+ my @removed = ();
+
+ if (!@operationQueue) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_empty');
+ return;
+ }
+
+ if ($data eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ if ($data =~ /^all/i) {
+ @flushqueue = @operationQueue;
+ @operationQueue = ();
+ push(@removed, $data);
+ } elsif ($data =~ /^[0-9,]+$/) {
+ my $numstr = join(" ", split(/,/, $data));
+ for (my $num = 0; $num < @operationQueue;) {
+ if ($numstr =~ /\b$num\b/) {
+ push(@flushqueue, splice(@operationQueue, $num, 1));
+ push(@removed, $num);
+ } else {
+ $num++
+ }
+ }
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage);
+ return;
+ }
+
+ if (@flushqueue) {
+ # don't ask... ;^)
+ foreach my $q (@flushqueue) {
+ my $s = $q->{server}->{tag};
+ my $c = $q->{channel};
+ my $o = $q->{operation};
+ foreach my $n (@{$q->{nicks}}) {
+ $flushdata->{$s}->{$c}->{$o}->{$n} = 1 unless ($o eq "voice" &&
+ exists $flushdata->{$s}->{$c}->{op}->{$n} &&
+ !Irssi::settings_get_bool('friends_voice_opped'));
+ }
+ }
+ my $result = ((queue_flush_expand($flushdata)) ? "seems ok" : "looks like nothing done");
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_removed', "Flushed", join(", ", @removed), $result);
+ }
+
+ if (!@operationQueue && $timerHandle) {
+ Irssi::timeout_remove($timerHandle);
+ $timerHandle = undef;
+ }
+}
+
+# void cmd_queue_purge($data, $server, $channel)
+# handles /QUEUE PURGE <number|all>
+# removes given/all queue(s)
+sub cmd_queue_purge {
+ my ($data) = split(/ +/, $_[0]);
+ my $usage = "/QUEUE PURGE <number|all>";
+ my $result;
+ my @removed;
+
+ if (!@operationQueue) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_empty');
+ return;
+ }
+
+ if ($data eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ if ($data =~ /^all/i) {
+ @operationQueue = ();
+ $result = "OK";
+ push(@removed, $data);
+ } elsif ($data =~ /^[0-9,]+$/) {
+ my $numstr = join(" ", split(/,/, $data));
+ for (my $num = 0; $num < @operationQueue;) {
+ if ($numstr =~ /\b$num\b/) {
+ splice(@operationQueue, $num, 1);
+ push(@removed, $num);
+ $result = "OK";
+ } else {
+ $num++
+ }
+ }
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage);
+ return;
+ }
+
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_removed', "Purged", join(", ", @removed), $result) if (defined $result);
+
+ if (!@operationQueue && $timerHandle) {
+ Irssi::timeout_remove($timerHandle);
+ $timerHandle = undef;
+ }
+}
+
+# void friends_chflags($idx, $string[, $chan])
+# parses the $string and calls add_flag() or del_flag()
+sub friends_chflags {
+ my ($idx, $string, $chan) = @_;
+ my $mode = undef;
+ my $char;
+
+ $chan = "global" if ($chan eq "" || lc($chan) eq "global");
+
+ foreach my $char (split(//, $string)) {
+ if ($char eq "+") { $mode = "+";
+ } elsif ($char eq "-") { $mode = "-";
+ } elsif ($mode) {
+ if ($mode eq "+") {
+ # ADDING flags
+ # add chan record, if needed
+ add_chanrec($idx, $chan) if ($chan ne "global" && !friend_has_chanrec($idx, $chan));
+ if (!friend_has_flag($idx, $char, $chan)) {
+ # add this flag if he doesn't have it yet
+ add_flag($idx, $char, $chan);
+ }
+ } elsif ($mode eq "-") {
+ # REMOVING flags
+ if ($chan eq "global" || friend_has_chanrec($idx, $chan)) {
+ del_flag($idx, $char, $chan);
+ }
+ }
+ }
+ }
+}
+
+# void cmd_chflags($data, $server, $channel)
+# handles /chflags <handle> <+-flags> [#channel]
+sub cmd_chflags {
+ my ($handle, $flags, @chans) = split(/ +/, $_[0]);
+ my $usage = "/CHFLAGS <handle> <+/-flags> [#channel1] [#channel2] ...";
+
+ # strip %'s
+ $handle =~ s/\%//g;
+
+ # not enough args
+ if ($handle eq "" || $flags eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ # bad args
+ # if the 'flags' part doesn't start with + or -
+ if ($flags !~ /^[\+\-]/) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage);
+ return;
+ }
+
+ # get idx, yell and return if it isn't valid
+ my $idx = get_idxbyhand($handle);
+ if ($idx == -1) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
+ return;
+ }
+
+ # if #channel wasn't specified -- we'll deal with global flags
+ push(@chans, "global") unless (@chans);
+
+ # go through all channels specified
+ foreach my $chan (@chans) {
+ # strip %'s
+ $chan =~ s/\%//g;
+
+ # 'executing +foo-bar for someone (where)'
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_chflagexec', $flags, get_handbyidx($idx), $chan);
+ # make changes
+ friends_chflags($idx, $flags, $chan);
+
+ my $flagstr = get_friends_flags($idx, $chan);
+ # 'current $chan flags for someone are: +blah/[none]'
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_currentflags', (($flagstr) ? $flagstr : "[none]"), get_handbyidx($idx), $chan);
+ }
+}
+
+# void cmd_chhandle($data, $server, $channel)
+# handles /chhandle <oldhandle> <newhandle>
+sub cmd_chhandle {
+ my ($oldhandle, $newhandle) = split(/ +/, $_[0]);
+ my $usage = "/CHHANDLE <oldhandle> <newhandle>";
+
+ # strip %'s
+ $newhandle =~ s/\%//g;
+
+ # not enough args
+ if ($oldhandle eq "" || $newhandle eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ # get idx, yell and return if it's not valid
+ my $idx = get_idxbyhand($oldhandle);
+ if ($idx == -1) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $oldhandle);
+ return;
+ }
+
+ # proper case for later printformat
+ $oldhandle = get_handbyidx($idx);
+
+ # handle cannot start with a digit
+ if ($newhandle =~ /^[0-9]/) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_badhandle', $newhandle,
+ "Handle may not start with a digit");
+ return;
+ }
+
+ if (lc($newhandle) eq lc($oldhandle)) {
+ # funny case, only changes case of letters, omit the whole change_handle()
+ $friends[$idx]->{handle} = $newhandle;
+ } else {
+ # check if $newhandle is unique
+ # if not, print appropriate message and return
+ if (!is_unique_handle($newhandle)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notuniqhandle', $newhandle);
+ return;
+ }
+ # ok, everything seems fine now, let's change the handle.
+ change_handle($oldhandle, $newhandle);
+ }
+
+ # ... and print a message
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_changed_handle', $oldhandle, $newhandle);
+}
+
+# void change_handle($oldhandle, $newhandle)
+# changes handle in appropriate structures
+sub change_handle($$) {
+ my ($old, $new) = @_;
+ my $idx = get_idxbyhand($old);
+ my $lc_new = lc($new);
+ foreach my $host (get_friends_hosts($idx, $friends_PLAIN_HOSTS)) {
+ my ($l) = $host =~ /\@(.)/;
+ my $regexp_host = userhost_to_regexp($host);
+ $all_regexp_hosts->{allhosts}->{$regexp_host} = $lc_new;
+ $all_regexp_hosts->{lc($l)}->{$regexp_host} = $lc_new;
+ $all_hosts->{$host} = $lc_new;
+ delete $all_handles->{lc($old)};
+ $all_handles->{$lc_new} = $idx;
+ $friends[$idx]->{handle} = $new;
+ }
+}
+
+# void cmd_chpass($data, $server, $channel)
+# handles /chpass <handle> [pass]
+# if pass is empty, removes password
+# otherwise, crypts it and sets as current one
+sub cmd_chpass {
+ my ($handle, $pass) = split(/ +/, $_[0]);
+ my $usage = "/CHPASS <handle> [newpassword]";
+
+ # not enough args
+ if ($handle eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ # get idx, yell and return if it's not valid
+ my $idx = get_idxbyhand($handle);
+ if ($idx == -1) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
+ return;
+ }
+
+ # crypt and set password. then print a message
+ $friends[$idx]->{password} = friends_crypt("$pass");
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_chpassexec', get_handbyidx($idx));
+}
+
+# void cmd_chdelay($data, $server, $channel)
+# handles /chdelay <handle> <delay> <#channel>
+# use delay=0 to get instant opping
+# use delay>0 to get fixed opping delay
+# use delay='random' or delay='none' or delay = 'remove'
+# to remove fixed delay (make it random)
+sub cmd_chdelay {
+ my ($handle, $delay, $chan) = split(/ +/, $_[0]);
+ my $usage = "/CHDELAY <handle> <delay> <#channel>";
+ my $value = undef;
+
+ # strip %'s
+ $chan =~ s/\%//g;
+
+ # not enough args
+ if ($handle eq "" || $delay eq "" || $chan eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ # if $chan doesn't start with one of the [!&#+]
+ if ($chan !~ /^[\!\&\#\+]/) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage);
+ return;
+ }
+
+ # check validness of $delay
+ if ($delay =~ /^[0-9]+$/) {
+ # numeric value
+ $value = $delay;
+ } elsif ($delay =~ /^(remove|random|none)$/i) {
+ # 'remove', 'random' or 'none'
+ $value = undef;
+ } else {
+ # badargs, return
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage);
+ return;
+ }
+
+ # get idx, yell and return if it's not valid
+ my $idx = get_idxbyhand($handle);
+ if ($idx == -1) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
+ return;
+ }
+
+ # check if $idx has got $chan record.
+ # add one if needed
+ add_chanrec($idx, $chan) unless (friend_has_chanrec($idx, $chan));
+
+ # finally, set it, and print a message
+ change_delay($idx, $value, $chan);
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_changed_delay', get_handbyidx($idx),
+ $chan, (defined($value) ? $value : "[random]"));
+}
+
+# void cmd_comment($data, $server, $channel)
+# handles /comment <handle> [comment]
+# if comment is empty, removes it
+# otherwise, sets it as the current one
+sub cmd_comment {
+ my ($handle, $comment) = split(" ", $_[0], 2);
+ my $usage = "/COMMENT <handle> [comment]";
+
+ # not enough args
+ if ($handle eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ # get idx, yell and return if it's not valid
+ my $idx = get_idxbyhand($handle);
+ if ($idx == -1) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
+ return;
+ }
+
+ # remove %'s and trailing spaces (just-in-case ;)
+ $comment =~ s/\%//g;
+ $comment =~ s/[\ ]+$//;
+
+ # finally, set it, and print a message
+ $friends[$idx]->{comment} = $comment;
+
+ if ($comment ne '') {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_comment_added', get_handbyidx($idx), $comment);
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_comment_removed', get_handbyidx($idx));
+ }
+}
+
+# void cmd_listfriend($data, $server, $chanel)
+# handles /listfriends [what]
+# 'what' can be either handle, channel name, 1,2,5,15-style, host mask or empty.
+sub cmd_listfriends {
+ if (@friends == 0) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_empty');
+ } else {
+ my ($data) = @_;
+ my $counter = 0;
+ # remove whitespaces
+ $data =~ s/[\t\ ]+//g;
+ my $win = Irssi::active_win();
+
+ if ($data =~ /^[\!\&\#\+]/) {
+ # deal with channel
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', "channel " . $data);
+ for (my $idx = 0; $idx < @friends; ++$idx) {
+ if (friend_has_chanrec($idx, $data)) {
+ list_friend($win, $idx, undef);
+ $counter++;
+ }
+ }
+ } elsif ($data =~ /^[0-9,]+$/) {
+ # deal with 1,2,5,15 style
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', $data);
+ foreach my $idx (split(/,/, $data)) {
+ if ($idx < @friends) {
+ list_friend($win, $idx, undef);
+ $counter++;
+ }
+ }
+ } elsif ($data =~ /^.*\!.*\@.*$/) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', "matching " . $data);
+ # /* FIXME */
+ my $regexp_data = userhost_to_regexp($data);
+ for (my $idx = 0; $idx < @friends; ++$idx) {
+ foreach my $regexp_host (get_friends_hosts($idx, $friends_REGEXP_HOSTS)) {
+ if ($data =~ /^$regexp_host$/ || $friends[$idx]->{regexp_hosts}->{$regexp_host} =~ /^$regexp_data$/) {
+ list_friend($win, $idx, undef);
+ $counter++;
+ last;
+ }
+ }
+ }
+ } elsif ($data ne "") {
+ if ((my $idx = get_idxbyhand($data)) > -1) {
+ # deal with handle
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', $data);
+ list_friend($win, $idx, undef);
+ $counter++;
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $data);
+ }
+ } else {
+ # deal with every entry
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', "all");
+ for (my $idx = 0; $idx < @friends; ++$idx) {
+ list_friend($win, $idx, undef);
+ $counter++;
+ }
+ }
+ if ($counter) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist_count', $counter, (($counter > 1) ? "s" : ""));
+ }
+ }
+}
+
+# void cmd_addfriend($data, $server, $channel)
+# handles /addfriend <handle> <hostmask> [flags]
+# if 'flags' is empty, uses friends_default_flags instead
+sub cmd_addfriend {
+ my ($handle, $host, $flags) = split(/ +/, $_[0]);
+ my $server = $_[1];
+ my $usage = "/ADDFRIEND <handle|nick> [<hostmask> [flags]]";
+
+ # strip %'s
+ $handle =~ s/\%//g;
+ $host =~ s/\%//g;
+
+ # not enough args
+ if ($handle eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ # handle cannot start with a digit
+ if ($handle =~ /^[0-9]/) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_badhandle', $handle, "Handle may not start with a digit");
+ return;
+ }
+
+ # assume we want /addfriend somenick
+ if ($host eq "") {
+ # no server item in current window
+ if (!$server) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No server item in current window");
+ return;
+ }
+
+ # redirect userhost reply to event_isfriend_userhost()
+ # caution: This works only with Irssi 0.7.98.CVS (20011117) and newer
+ $server->redirect_event("userhost", 1, $handle, 0, undef, {
+ "event 302" => "redir userhost_addfriend"});
+ # send our query
+ $server->send_raw("USERHOST :$handle");
+ return;
+ }
+
+ # check must be unique
+ if (!is_unique_handle($handle)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notuniqhandle', $handle);
+ return;
+ }
+
+ # add friend.
+ push(@friends, new_friend($handle, $host, undef, undef, undef, undef));
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_added', $handle);
+
+ # check 'flags' parameter, add default flags if empty.
+ $flags = Irssi::settings_get_str('friends_default_flags') unless ($flags);
+
+ # add flags and print them if needed
+ if ($flags) {
+ # check if $flags start with a '+'. if not, prepend one.
+ $flags = "+".$flags unless ($flags =~ /^\+/);
+
+ # our new friend should have $idx=(scalar(@friends)-1) now, so we'll use it.
+ my $idx = scalar(@friends) - 1;
+
+ friends_chflags($idx, $flags, "global");
+ $flags = get_friends_flags($idx, undef);
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_currentflags', $flags, $handle, "global") if ($flags);
+ }
+}
+
+# void event_addfriend_userhost($server, $reply, $servername)
+# handles redirected USERHOST replies
+# (part of /addfriend)
+sub event_addfriend_userhost {
+ my ($mynick, $reply) = split(/ +/, $_[1]);
+ my $server = $_[0];
+ my ($nick, $user, $host) = $reply =~ /^:?([^\*=]*)\*?=.(.*)@(.*)/;
+ my $string = $nick . '!' . $user . '@' . $host;
+ my $friend_matched = 0;
+
+ # try matching ONLY if the response is positive
+ if (defined $nick && defined $user && defined $host) {
+ if ((my $idx = get_idx($nick, $user.'@'.$host)) > -1) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_already_added', $nick, get_handbyidx($idx));
+ return;
+ }
+ # handle
+ my $handle = choose_handle($nick);
+ # *~^=-ident
+ $user =~ s/^[\~\+\-\^\=]+/\*/;
+
+ # add friend.
+ push(@friends, new_friend($handle, '*!'.$user.'@'.$host, undef, undef, undef, undef));
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_added', $handle);
+ return;
+ }
+
+ # failed
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No such nick");
+}
+
+# void cmd_delfriend($data, $server, $channel)
+# handles /delfriend <handle|number>
+# supports /delfriend 2-5,foohand,1,4,10,11-22
+sub cmd_delfriend {
+ my ($who) = split(/ +/, $_[0]);
+ my $usage = "/DELFRIEND <handle|number>";
+
+ # strip %'s
+ $who =~ s/\%//g;
+
+ # not enough args
+ if ($who eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ my @todelete = ();
+ foreach my $what (split(/[\ ,]/, $who)) {
+ if ($what =~ /^[0-9]+$/) {
+ # /delfriend 15
+ next unless ($what > -1 && $what < scalar(@friends));
+ push(@todelete, $what) unless (grep(/^$what$/, @todelete));
+ } elsif ($what =~ /^([0-9]+)\-([0-9]+)$/) {
+ # /delfriend 2-10
+ my ($start, $end) = $what =~ /([0-9]+)\-([0-9]+)/;
+ next if ($start > $end);
+ for my $i ($start .. $end) {
+ next unless ($i > -1 && $i < scalar(@friends));
+ push(@todelete, $i) unless (grep(/^$i$/, @todelete));
+ }
+ } else {
+ # /delfriend foobar
+ my $delidx = get_idxbyhand($what);
+ push(@todelete, $delidx) unless ($delidx < 0 || grep(/^$delidx$/, @todelete));
+ }
+ }
+ @todelete = sort {$a <=> $b} @todelete;
+
+ return unless (@todelete);
+
+ my @result = del_friend(join(" ", @todelete));
+ foreach my $deleted (@result) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_removed', $deleted->{handle});
+ }
+}
+
+# void cmd_addhost($data, $server, $channel)
+# handles /addhost <handle> <hostmask1> [hostmask2] ...
+# hostmask may not overlap with any of the current ones
+sub cmd_addhost {
+ my ($handle, @hosts) = split(/ +/, $_[0]);
+ my $usage = "/ADDHOST <handle> <hostmask1> [hostmask2] [hostmask3] ...";
+
+ # not enough args
+ if ($handle eq "" || !@hosts) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ # get idx, yell and return if it's not valid
+ my $idx = get_idxbyhand($handle);
+ if ($idx == -1) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
+ return;
+ }
+
+ for (my $i = 0; $i < scalar(@hosts); $i++) {
+ my $data = $hosts[$i];
+ $data =~ s/\%//g;
+ my $regexp_data = userhost_to_regexp($data);
+ my $found = 0;
+ my $who = "";
+
+ # /* FIXME */
+ foreach my $plain_host (keys %{$all_hosts}) {
+ if (!$found && $plain_host =~ /^$regexp_data$/) {
+ $found = 1;
+ $who = get_handbyidx(get_idxbyhand($all_hosts->{$plain_host}));
+ last;
+ }
+ }
+
+ # /* FIXME again */
+ foreach my $regexp_host (get_friends_hosts($idx, $friends_REGEXP_HOSTS)) {
+ last if ($found);
+ if ($data =~ /^$regexp_host$/ || $friends[$idx]->{regexp_hosts}->{$regexp_host} =~ /^$regexp_data$/) {
+ $found = 1;
+ $who = get_handbyidx($idx);
+ last;
+ }
+ }
+
+ if (!$found) {
+ add_host($idx, $data);
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_added', get_handbyidx($idx), $data);
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_exists', $who, $data);
+ }
+ }
+}
+
+# void cmd_delhost($data, $server, $channel)
+# handles /delhost <handle> <hostmask>
+# hostmask should be EXACTLY the same as one in $friends[$idx]->{hosts}
+sub cmd_delhost {
+ my ($handle, $host) = split(/ +/, $_[0]);
+ my $usage = "/DELHOST <handle> <hostmask>";
+
+ # strip %'s
+ $host =~ s/\%//g;
+
+ # not enough args
+ if ($handle eq "" || $host eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ # get idx, yell and return if it's not valid
+ my $idx = get_idxbyhand($handle);
+ if ($idx == -1) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
+ return;
+ }
+
+ # delete host, print appropriate message
+ if (del_host($idx, $host)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_removed', get_handbyidx($idx), $host);
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_notexists', get_handbyidx($idx), $host);
+ }
+}
+
+# void cmd_delchanrec($data, $server, $channel)
+# handles /delchanrec <handle> <#channel>
+sub cmd_delchanrec {
+ my ($handle, $chan) = split(/ +/, $_[0]);
+ my $usage = "/DELCHANREC <handle> <#channel>";
+
+ # strip %'s
+ $chan =~ s/\%//g;
+
+ # not enough args
+ if ($handle eq "" || $chan eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ # get idx, yell and return if it's not valid
+ my $idx = get_idxbyhand($handle);
+ if ($idx == -1) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
+ return;
+ }
+
+ # delete chanrec, print appropriate message
+ if (del_chanrec($idx, $chan)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_chanrec_removed', get_handbyidx($idx), $chan);
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_chanrec_notexists', get_handbyidx($idx), $chan);
+ }
+}
+
+# void cmd_findfriends($data, $server, $channel)
+# handles /findfriends [handle]
+# prints online friends
+sub cmd_findfriends {
+ my ($data) = split(/ +/, $_[0]);
+ my $f2w = Irssi::settings_get_str('friends_findfriends_to_windows');
+ my $win = undef;
+ my $lc_data = lc($data);
+ $win = Irssi::active_win() unless ($f2w || $data eq '');
+
+ # gathering info
+ my $by_hand = {};
+ foreach my $channel (Irssi::channels()) {
+ my $myNick = $channel->{server}->{nick};
+ my $tag = lc($channel->{server}->{tag});
+ foreach my $nick ($channel->nicks()) {
+ # don't count myself
+ next if ($nick->{nick} eq $myNick);
+ if ((my $idx = get_idx($nick->{nick}, $nick->{host})) > -1) {
+ $by_hand->{lc($friends[$idx]->{handle})}->{$tag}->{$channel->{name}} = $nick->{nick};
+ }
+ }
+ }
+
+ # looking for a specified handle
+ if ($data ne '') {
+ my $handle = undef;
+ foreach my $h (keys %{$by_hand}) {
+ next if ($lc_data ne $h);
+ $handle = $h;
+ last;
+ }
+ return unless (defined $handle);
+
+ # tricky part.
+ my @data = ();
+ foreach my $ircnet (keys %{$by_hand->{$handle}}) {
+ my ($nick, $chan);
+ foreach $chan (keys %{$by_hand->{$handle}->{$ircnet}}) {
+ $nick = $by_hand->{$handle}->{$ircnet}->{$chan};
+ last;
+ }
+ my $chanstr = join(",", sort keys %{$by_hand->{$handle}->{$ircnet}});
+ push(@data, join(" ", $ircnet, $nick, $chanstr));
+ }
+ # list them.
+ list_friend(Irssi::active_win(), $handle, @data);
+
+ # looking for anyone
+ } else {
+ foreach my $handle (keys %{$by_hand}) {
+ foreach my $ircnet (keys %{$by_hand->{$handle}}) {
+ my $server = Irssi::server_find_tag($ircnet);
+ next unless (defined $server);
+ foreach my $chan (sort keys %{$by_hand->{$handle}->{$ircnet}}) {
+ my @data = ();
+ my $nick = $by_hand->{$handle}->{$ircnet}->{$chan};
+ $win = $server->window_item_find($chan);
+ $win = Irssi::active_win() unless (defined $win && $f2w);
+ my $chanstr = join(",", sort keys %{$by_hand->{$handle}->{$ircnet}});
+ push(@data, join(" ", $ircnet, $nick, $chanstr));
+ list_friend($win, $handle, @data);
+ }
+ }
+ }
+ }
+}
+
+# void cmd_isfriend($data, $server, $channel)
+# handles /isfriend <nick>
+sub cmd_isfriend {
+ my ($data, $server, $channel) = @_;
+ my $usage = "/ISFRIEND <nick>";
+
+ # remove trailing spaces
+ $data =~ s/[\t\ ]+$//;
+
+ # not enough args
+ if ($data eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
+ return;
+ }
+
+ # no server item in current window
+ if (!$server) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No server item in current window");
+ return;
+ }
+
+ # redirect userhost reply to event_isfriend_userhost()
+ # caution: This works only with Irssi 0.7.98.CVS (20011117) and newer
+ $server->redirect_event("userhost", 1, $data, 0, undef, {
+ "event 302" => "redir userhost_friends"});
+ # send our query
+ $server->send_raw("USERHOST :$data");
+}
+
+# void event_isfriend_userhost($server, $reply, $servername)
+# handles redirected USERHOST replies
+# (part of /isfriend)
+sub event_isfriend_userhost {
+ my ($mynick, $reply) = split(/ +/, $_[1]);
+ my $server = $_[0];
+ my ($nick, $user, $host) = $reply =~ /^:?([^\*=]*)\*?=.(.*)@(.*)/;
+ my $string = $nick . '!' . $user . '@' . $host;
+ my $friend_matched = 0;
+
+ # try matching ONLY if the response is positive
+ if (defined $nick && defined $user && defined $host) {
+ if ((my $idx = get_idx($nick, $user.'@'.$host)) > -1) {
+ my @chans = ();
+ foreach my $channel ($server->channels()) {
+ push(@chans, $channel->{name}) if ($channel->nick_find($nick));
+ }
+ my $chanstr = join(",", @chans);
+ list_friend(Irssi::active_win(), $idx, join(" ", $server->{tag}, $nick, $chanstr));
+ $friend_matched++;
+ }
+ }
+
+ # print message
+ if ($friend_matched) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_endof', "/isfriend", $nick);
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $nick);
+ }
+}
+
+# void event_whois($server, $text, $servername)
+# handles additional whois data
+sub event_whois {
+ my ($server, $text, $servername) = @_;
+ return unless (Irssi::settings_get_bool('friends_show_whois_extra'));
+
+ my ($on, $nick, $user, $host, $as, $rn) = split(/[\ ]:?/, $text, 6);
+ my $idx = get_idx($nick, $user.'@'.$host);
+ return unless ($idx > -1);
+
+ $server->printformat($nick, MSGLEVEL_CRAP, 'friends_whois', get_handbyidx($idx), ($friends[$idx]->{globflags} ? $friends[$idx]->{globflags} : "none"));
+}
+
+# void cmd_flushlearnt($data, $server, $channel)
+# cycles through all users and removes every chanrec with flag L
+# then, if no other stuff left (specific delay, other chanrecs,
+# global flags, password maybe) -- deletes user.
+# clears the opping tree too
+sub cmd_flushlearnt {
+ my @todelete = ();
+ # cycle through the whole friendlist
+ for (my $idx = 0; $idx < @friends; ++$idx) {
+ my $was_learnt = 0;
+
+ # foreach friend, clear his opping tree
+ $friends[$idx]->{friends} = [];
+
+ # now go through all friend's channel entries
+ foreach my $chan (get_friends_channels($idx)) {
+ # if 'L' is the only flag for this chan
+ if (get_friends_flags($idx, $chan) eq "L") {
+ # remove channel record and print a message
+ $was_learnt = del_chanrec($idx, $chan);
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_chanrec_removed', get_handbyidx($idx), $chan);
+ }
+ }
+
+ # delete friend, if he has exactly 1 host, no global flags,
+ # neither password, nor chanrecs, and he was learnt.
+ if ($was_learnt && scalar(get_friends_hosts($idx, $friends_REGEXP_HOSTS)) == 1 && !get_friends_flags($idx, undef) &&
+ !get_friends_channels($idx) && !$friends[$idx]->{password}) {
+ push(@todelete, $idx) unless (grep(/^$idx$/, @todelete));
+ }
+ }
+ return unless @todelete;
+
+ @todelete = sort {$a <=> $b} @todelete;
+ my @result = del_friend(join(" ", @todelete));
+ foreach my $deleted (@result) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_removed', $deleted->{handle});
+ }
+}
+
+# void cmd_opping_tree($data, $server, $channel)
+# prints the Opping Tree
+sub cmd_oppingtree {
+ my $found = 0;
+ # cycle through the whole friendlist
+ for (my $idx = 0; $idx < @friends; ++$idx) {
+ # get friend's friends
+ my @friendFriends = @{$friends[$idx]->{friends}};
+ if (@friendFriends) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "Opping tree:") unless ($found);
+ $found = 1;
+ # print info about our friend
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_optree_line1', get_handbyidx($idx));
+ my %masks;
+ # get all masks opped by him
+ foreach my $friend (@friendFriends) {
+ foreach my $host (keys(%{$friend->{hosts}})) {
+ $masks{$host}++;
+ last;
+ }
+ }
+ # print them, along with the opcount
+ foreach my $friend (sort keys %masks) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_optree_line2', $masks{$friend}, $friend);
+ }
+ }
+ }
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "Opping tree is empty.") unless ($found);
+}
+
+# void event_ctcpmsg($server, $args, $sender, $senderhsot, $target)
+# handles ctcp requests
+sub event_ctcpmsg {
+ my ($server, $args, $sender, $userhost, $target) = @_;
+
+ # return, if ctcp is not for us
+ my $myNick = $server->{nick};
+ return if (lc($target) ne lc($myNick));
+
+ # return, if we don't process ctcp requests
+ return unless (Irssi::settings_get_bool('friends_use_ctcp'));
+
+ # return in case of strange things
+ return unless (defined $sender && defined $userhost);
+
+ my @cmdargs = split(/ +/, $args);
+
+ # prepare arguments:
+ # get 1st arg, uppercase it
+ my $command = uc($cmdargs[0]);
+ # get 2nd arg
+ my $channelName = $cmdargs[1];
+ # get 3rd arg
+ my $password = $cmdargs[2];
+
+ # check if $command is one of friends_ctcp_commands. return if it isn't
+ return unless (is_ctcp_command($command));
+
+ # this is supposed to be processed BEFORE any other ctcp commands
+ # /ctcp nick IDENT handle password
+ if ($command eq "IDENT") {
+ my $idxguess = get_idxbyhand($channelName);
+ # looks like a valid friend, password already set, provided password looks fine
+ if ($idxguess > -1 && $friends[$idxguess]->{password} ne "" && friends_passwdok($idxguess, $password)) {
+ # do the IDENT stuff here.
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpident', $channelName, $sender.'!'.$userhost);
+ add_host($idxguess, "*!$userhost");
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_added', $channelName, '*!'.$userhost);
+ $server->command("/^NOTICE $sender Identified as " . get_handbyidx($idxguess));
+ } else {
+ my $reason = "No reason ;)";
+ if ($idxguess < 0) {
+ $reason = "No such handle: $channelName";
+ } elsif ($friends[$idxguess]->{password} eq "") {
+ $reason = "Can't IDENT $channelName without password set";
+ } elsif (!friends_passwdok($idxguess, $password)) {
+ $reason = "Bad password for $channelName";
+ }
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $sender.'!'.$userhost, $reason);
+ }
+ goto SIGSTOP;
+ }
+
+ my $idx = get_idx($sender, $userhost);
+
+ # if get_idx* failed, return.
+ if ($idx == -1) {
+ my $reason = "Not a friend" . (($command ne "PASS") ? " for $channelName" : "");
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $sender.'!'.$userhost, $reason);
+ goto SIGSTOP;
+ }
+
+ # we'll use handle instead of $sender!$userhost in messages
+ my $handle = get_handbyidx($idx);
+
+ # check if $channelName was supplied.
+ # (first argument, should be always given)
+ if ($channelName eq "") {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough arguments");
+ goto SIGSTOP;
+ }
+
+ # /ctcp nick PASS pass [newpass]
+ if ($command eq "PASS") {
+ # if someone has password already set - we can only *change* it
+ if ($friends[$idx]->{password}) {
+ # if cmdargs[1] ($channelName, that is) is a valid password (current)
+ if (!friends_passwdok($idx, $channelName)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
+ goto SIGSTOP;
+ }
+ # and $cmdargs[2] ($password, that is) contains something ...
+ if (defined $password) {
+ # ... process allowed password change.
+ # in this case, old password is in $channelName
+ # and new password is in $password
+ $friends[$idx]->{password} = friends_crypt("$password");
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcppass', $handle, $sender."!".$userhost);
+ # send a quiet notice to sender
+ $server->command("/^NOTICE $sender Password changed to: $password");
+ } else {
+ # in this case, notify sender about his current password quietly
+ $server->command("/^NOTICE $sender You already have a password set");
+ }
+ # if $idx doesn't have a password, we will *set* it
+ } else {
+ # in this case, new password is in $channelName
+ # and $password is unused
+ $friends[$idx]->{password} = friends_crypt("$channelName");
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcppass', $handle, $sender.'!'.$userhost);
+ # send a quiet notice to sender
+ $server->command("/^NOTICE $sender Password set to: $channelName");
+ }
+ goto SIGSTOP;
+ }
+
+ # get channel object. if not found -- yell, stop the signal, and return
+ my $channel = $server->channel_find($channelName);
+ if (!$channel) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not on channel $channelName");
+ goto SIGSTOP;
+ }
+
+ my $sender_rec = $channel->nick_find($sender);
+
+ # /ctcp nick OP #channel password
+ if ($command eq "OP") {
+ if (!friend_is_wrapper($idx, $channelName, "o", "d")) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags");
+ goto SIGSTOP;
+ }
+ if (!friends_passwdok($idx, $password)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
+ goto SIGSTOP;
+ }
+
+ # process allowed opping
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName);
+ $channel->command("op $sender") if ($sender_rec && !$sender_rec->{op});
+ goto SIGSTOP;
+
+ # /ctcp nick VOICE #channel password
+ } elsif ($command eq "VOICE") {
+ if (!friend_is_wrapper($idx, $channelName, "v", undef)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags");
+ goto SIGSTOP;
+ }
+ if (!friends_passwdok($idx, $password)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
+ goto SIGSTOP;
+ }
+
+ # process allowed voicing
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName);
+ $channel->command("voice $sender") if ($sender_rec && !$sender_rec->{voice});
+ goto SIGSTOP;
+
+ # /ctcp nick INVITE #channel password
+ } elsif ($command eq "INVITE") {
+ if (!friend_is_wrapper($idx, $channelName, "i", undef)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags");
+ goto SIGSTOP;
+ }
+ if (!friends_passwdok($idx, $password)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
+ goto SIGSTOP;
+ }
+
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName);
+ if (!$channel->{chanop} && !$sender_rec) {
+ # friend is outside channel, but we're not opped
+ $server->command("/^NOTICE $sender I'm not opped on $channelName");
+ } elsif (!$sender_rec) {
+ # process allowed invite
+ $channel->command("invite $sender");
+ }
+ goto SIGSTOP;
+
+ # /ctcp nick KEY #channel password
+ } elsif ($command eq "KEY") {
+ if (!friend_is_wrapper($idx, $channelName, "k", undef)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags");
+ goto SIGSTOP;
+ }
+ if (!friends_passwdok($idx, $password)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
+ goto SIGSTOP;
+ }
+
+ # process allowed key giving
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName);
+ if ($channel->{key} && !$sender_rec) {
+ # give a key if channel is +k'ed and $sender is not on $channelName
+ $server->command("/^NOTICE $sender Key for $channelName is: $channel->{key}");
+ }
+ goto SIGSTOP;
+
+ # /ctcp nick UNBAN #channel password
+ } elsif ($command eq "UNBAN") {
+ if (!friend_is_wrapper($idx, $channelName, "u", undef)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags");
+ goto SIGSTOP;
+ }
+ if (!friends_passwdok($idx, $password)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
+ goto SIGSTOP;
+ }
+
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName);
+ if (!$channel->{chanop}) {
+ # notify him that we're not opped, unless he's here and he can see that ;^)
+ $server->command("/^NOTICE $sender I'm not opped on $channelName") if (!$sender_rec);
+ } else {
+ # process allowed unban
+ foreach my $ban ($channel->bans()) {
+ if ($server->mask_match_address($ban->{ban}, $sender, $userhost)) {
+ $server->command("MODE $channelName -b $ban->{ban}");
+ }
+ }
+ }
+ goto SIGSTOP;
+
+ # /ctcp nick LIMIT #channel password
+ } elsif ($command eq "LIMIT") {
+ if (!friend_is_wrapper($idx, $channelName, "l", undef)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags");
+ goto SIGSTOP;
+ }
+ if (!friends_passwdok($idx, $password)) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
+ goto SIGSTOP;
+ }
+
+ # process allowed limit raising
+ Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName);
+ if (!$channel->{chanop}) {
+ # notify him that we're not opped, unless he's here and he can see that ;^)
+ $server->command("/^NOTICE $sender I'm not opped on $channelName") if (!$sender_rec);
+ } else {
+ my @nicks = $channel->nicks();
+ if ($channel->{limit} && $channel->{limit} <= scalar(@nicks)) {
+ # raise the limit if it's needed
+ $server->command("MODE $channelName +l " . (scalar(@nicks) + 1));
+ }
+ }
+ goto SIGSTOP;
+ }
+
+ # stop the signal if we processed the request
+SIGSTOP:
+ Irssi::signal_stop();
+}
+
+# void cmd_friendsversion($data, $server, $channel)
+# handles /friendsversion
+# prints script's and friendlist's version
+sub cmd_friendsversion() {
+ print_version("script");
+ print_version("filever");
+ print_version("filewritten");
+}
+
+# settings
+Irssi::settings_add_int('misc', 'friends_delay_min', $default_delay_min);
+Irssi::settings_add_int('misc', 'friends_delay_max', $default_delay_max);
+Irssi::settings_add_int('misc', 'friends_max_queue_size', $default_friends_max_queue_size);
+Irssi::settings_add_int('misc', 'friends_revenge_mode', $default_friends_revenge_mode);
+Irssi::settings_add_bool('misc', 'friends_revenge', $default_friends_revenge);
+Irssi::settings_add_bool('misc', 'friends_learn', $default_friends_learn);
+Irssi::settings_add_bool('misc', 'friends_voice_opped', $default_friends_voice_opped);
+Irssi::settings_add_bool('misc', 'friends_use_ctcp', $default_friends_use_ctcp);
+Irssi::settings_add_bool('misc', 'friends_autosave', $default_friends_autosave);
+Irssi::settings_add_bool('misc', 'friends_backup_friendlist', $default_friends_backup_friendlist);
+Irssi::settings_add_bool('misc', 'friends_show_flags_on_join', $default_friends_show_flags_on_join);
+Irssi::settings_add_bool('misc', 'friends_findfriends_to_windows', $default_friends_findfriends_to_windows);
+Irssi::settings_add_bool('misc', 'friends_show_whois_extra', $default_friends_show_whois_extra);
+Irssi::settings_add_str('misc', 'friends_ctcp_commands', $default_friends_ctcp_commands);
+Irssi::settings_add_str('misc', 'friends_default_flags', $default_friends_default_flags);
+Irssi::settings_add_str('misc', 'friends_file', $default_friends_file);
+Irssi::settings_add_str('misc', 'friends_backup_suffix', $default_friends_backup_suffix);
+
+# commands
+Irssi::command_bind('addfriend', 'cmd_addfriend');
+Irssi::command_bind('delfriend', 'cmd_delfriend');
+Irssi::command_bind('addhost', 'cmd_addhost');
+Irssi::command_bind('delhost', 'cmd_delhost');
+Irssi::command_bind('delchanrec', 'cmd_delchanrec');
+Irssi::command_bind('chhandle', 'cmd_chhandle');
+Irssi::command_bind('chdelay', 'cmd_chdelay');
+Irssi::command_bind('loadfriends', 'cmd_loadfriends');
+Irssi::command_bind('savefriends', 'cmd_savefriends');
+Irssi::command_bind('listfriends', 'cmd_listfriends');
+Irssi::command_bind('findfriends', 'cmd_findfriends');
+Irssi::command_bind('isfriend', 'cmd_isfriend');
+Irssi::command_bind('chflags', 'cmd_chflags');
+Irssi::command_bind('chpass', 'cmd_chpass');
+Irssi::command_bind('comment', 'cmd_comment');
+Irssi::command_bind('oppingtree', 'cmd_oppingtree');
+Irssi::command_bind('opfriends', 'cmd_opfriends');
+Irssi::command_bind('queue', 'cmd_queue');
+Irssi::command_bind('queue show', 'cmd_queue_show');
+Irssi::command_bind('queue flush', 'cmd_queue_flush');
+Irssi::command_bind('queue purge', 'cmd_queue_purge');
+Irssi::command_bind('flushlearnt', 'cmd_flushlearnt');
+Irssi::command_bind('friendsversion', 'cmd_friendsversion');
+
+# events
+Irssi::signal_add_last('massjoin', 'event_massjoin');
+Irssi::signal_add_last('event mode', 'event_modechange');
+Irssi::signal_add_last('event 311', 'event_whois');
+Irssi::signal_add('default ctcp msg', 'event_ctcpmsg');
+Irssi::signal_add('redir userhost_friends', 'event_isfriend_userhost');
+Irssi::signal_add('redir userhost_addfriend', 'event_addfriend_userhost');
+Irssi::signal_add('setup saved', 'event_setup_saved');
+Irssi::signal_add('setup reread', 'event_setup_reread');
+Irssi::signal_add('nicklist changed', 'event_nicklist_changed');
+Irssi::signal_add('server disconnected', 'event_server_disconnected');
+Irssi::signal_add('server connect failed', 'event_server_disconnected');
+Irssi::signal_add_first('event kick', 'event_kick');
+
+print_releasenote() if (defined($release_note));
+load_friends();
diff --git a/scripts/fserve.pl b/scripts/fserve.pl
new file mode 100644
index 0000000..0fdc350
--- /dev/null
+++ b/scripts/fserve.pl
@@ -0,0 +1,3578 @@
+#!/usr/bin/perl -w
+#############################################################################
+#
+# FServe - file server for Irssi using DCC
+#
+# Copyright (C) 2001 Martin Persson
+# Copyright (C) 2003 Andriy Gritsenko
+# Copyright (C) 2002-2004 Piotr Krukowiecki
+#
+#
+# If you have any comments, bug reports or anything else
+# please contact me at piotr at pingu.ii.uj.edu.pl
+#
+# "Official" home page is at http://pingu.ii.uj.edu.pl/~piotr/irssi
+#
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+#
+# Changelog
+# ====================================================================
+#
+# TODO:
+# - when sending e.g. 3/2 files (e.g. because of min_upload), fserve
+# ad should say it's 3/2 sends, not 2/2 as it is now
+# - BUG: doesn't work if root_dir contains '+' ?
+# - Improve distro: /fs distro clear, etc
+# - possibility to, in case of failed send, not to resend file at once
+# but to requeue it in slot X
+# - More control in sends/queues (e.g. changing resends left, etc)
+# - /fs show_current_sends_to_channel
+# - restricted @find
+# - user priorities: new priority_user option in queue_priority +
+# /fs priouser nick
+# - @find should search thorough dirs as well.
+# - incorporate flood protection
+# ? make sure all server tags and user nicks are first lc()'ed
+# ? don't use send_user_msg, it's redundant
+# ? don't use message levels, but set window number
+# instead (might be better)
+# - Add '/fs queue all' or '/fs queue *' etc.
+#
+# 2.0.0 (2004.05.09)
+# * released rc4 without changes. Still a lot to do, but it's quite stable.
+#
+# 2.0.0rc4 (2004.01.27)
+# * fixed "() queued (0 B)" queued files
+#
+# 2.0.0rc3 (2003.06.19)
+# * fserve.pl works with old (before 0.8.6) irssi
+# * bugfix: min_upload was not working
+# * more documentation
+#
+# 2.0.0rc2 (2003.06.09)
+# * fixed 'send speed < 0' bug
+# * some queue-oriented fixes
+# * fixed '/fs delt' to update remaining sends and queues
+# * added '/fs queue *' to display all queues.
+#
+# 2.0.0rc1 (2003.06.01) Happy Child's Day :)
+# * Changed format of config file, it won't work with old (1.2.4 and
+# older file). If you're upgrading from 1.3.x and newer, just add
+# "[ConfigFileVersion 1.0]" (without '"') at the beginning of the
+# file.
+# This should be the last user-visible change of config/queue files.
+# * More documentation in /fs help
+# * Reseting upload_counter after having sent file
+# * renamed ignore_chat to ctcp_only
+# * renamed short_notice to custom_notice, added custom_notice_fields
+# * @find responses more Sysreset-like
+#
+# Important changes between 1.2.4 and 2.0.0rc1
+# (for detailed version look at fserve-1.4.0pre6)
+# Many thanks to Andriy Gritsenko for his work on the fserve.
+# * multiple server support
+# * multiple queue support (patch from A.G)
+# * good documentation: '/fs help' (although it's still not complete)
+# * changed format of queue file, saved sends and queues won't be back.
+# * many bugfixes, small fixes, changes in server logic etc.
+# * big patch from A.G, too much changes to list here.
+#
+#
+# 1.2.4
+# * bug workaround: removing ghost users (not tested... i don't have
+# such problems...)
+# * Removed window_close_on_quit - it was causing irssi to crash
+# * Patch from Daniel Seifert (dseifert at gmx dot de):
+# - added dont_notify option (to define channels where no notifies
+# should be sent to)
+# - english corrections
+#
+# 1.2.3
+# * Added:
+# - offline_message which is displayed when someone wants to access
+# disabled fserve
+# - fserve responds to !olist if (restricted_level > 0) and to
+# !vlist if (restricted_level == 1)
+# - fserve responds to "!list <my irc nick>"
+# * bug (?) workaround: sometimes fserve thinks it's still sending
+# the file when it's not. Now it's checking for such ghost sends
+# and removes them from sends list
+# * bugfix: can send files containing "'" now
+#
+# 1.2.2
+# * works with irssi 0.8.6 now, but doesn't work with irssi 0.8.5 and
+# former (incompatybile change in irssi 0.8.6 :( )
+#
+# 1.2.1
+# * bugfix: @find didn't reported any files if there was only one match
+#
+# 1.2.0
+# * IMPORTANT CHANGE: there is no longer 'ops_priority' setting. You must
+# use 'queue_priority' instead (irssi will switch to it automatically
+# when loading old config). queue_priority is a list of space separated
+# priorities: "normal", "voice", "halfop", "op" and "others". Queue
+# is sorted according to the order in which they appear in queue_priority.
+# For example, if you set it to 'voice others normal' then first in queue
+# will be voiced people, then people with priority not mentioned in
+# queue_priority (in this case halfops and ops), then normal people.
+# If 'others' doesn't exists in queue_priority it's assumed to be at
+# the end
+# * Added:
+# - '/fs sortqueue' to sort queue according to queue_prority
+# - count_send_as_queue setting. If set to 1 user sends take
+# place in queue. For example, if it's set and user_slots == 1,
+# user can have only one send, or only one queued file.
+# - distro mode (/fs set distro, distro_file). When distro = 1
+# fileserver counts how many times each file was sent, and first
+# sends files with lowest send count.
+# In fact, distro setting isn't simply 0/1. It's a PROBABILITY of
+# using distro mode for the send. The values should be from range
+# [0,1], where 0 means don't use distro mode at all, and 1 means
+# allways use distro mode. For example when it's set to 0.7 it'll
+# use distro mode in 7 cases of 10 (more or less).
+# - '/fs distro stats' displays send count for files
+# * bugfix:
+# - send speed was wrongly calculated.
+# - fserve could sometimes use wrong network
+# - exit, bye shoult works now. Patch from Jan Rekorajski
+# (baggins at sith.mimuw.edu.pl). Chat windows are closed unless
+# close_window_on_quit is set to 0
+# * in conffile, queuefile and log_name you can use $IRSSI as part of the
+# path. It will be changed to Irssis home directory.
+# * hopefully better support for fserve explorers etc (changed 'dir' output)
+# * people who use different command char then '/' in /command shouldn't
+# have problems now
+# * some other fixes/changes
+#
+# 1.1.3
+# * added:
+# - +v/+%/+o only fserve. setting restricted_level to 3 means only ops
+# can access, to 2 only ops and halfops, to 1 only ops, halfops and
+# voiced users can access. if it's 0 everybody can access.
+#
+# 1.1.2
+# * added:
+# - !request support (/fs set request)
+#
+# 1.1.1
+# * bugfix:
+# - works with files containing more than one space in row
+# (e.g. 'blah blah')
+# * added:
+# - /fs set autosave_on_close - when set to 1 sends and queues
+# will be saved on /fs off
+#
+# 1.1.0
+# * bugfix:
+# - Enabling debug (/fs set debug 1) works now
+# * New:
+# - /fs set content - adds "On Fserve:(content)" to notice.
+# - /fs set motdfile - gets MOTD from file
+# - /fs set recache_interval - does /fs recache every recache_interval
+# seconds
+# - /ctcp ... NoResend
+#
+# 1.0.0
+# -----
+# * added:
+# - sending small files without waiting in queues
+# (/fs set instant_send). Patch from Jan Rekorajski
+# (baggins at sith.mimuw.edu.pl)
+# - @find support (/fs set find, /fs set find_results). Patch from
+# Jan Rekorajski (baggins at sith.mimuw.edu.pl
+# - queuefile and $conffile in $fs_prefs{}
+# - /fs notify #channel1 #channel2 #etc
+# - current upstream is displayed in server notice
+# - resends ($max_resends) and better min_cps handling ($speedp). New
+# log position (dcc_soft_fail) if resend is possibile
+# - MOTD - '/fs set motd blah blah'
+# * bugfixes
+# - fserver should respond to all !list's (comparing # names not cases s.)
+# - fixed '/fs insert file'
+# - displays notice with correct colors even if Note: contains braces
+# - queued position reported after queueing file by +o/+v with
+# ops_priority on
+# * moved most usefull variables to %fs_prefs (/fs set ...)
+# * priority users are moved to the beginnign of the queue
+# * 'Autosaving...' is not printed anymore unless in debug mode
+# * Previously if ops_priority was on and nick was +o/+v the file was added
+# even if there was no free queue slot. Now it's not added, unless
+# ops_priority > 2.
+# * if irc server disconnects, fserve will change to 'frozen' state and will
+# wait for reconnection, then will wait next 150s to join channels etc.
+# If send will fail in that time then it will be moved to queue.
+# If you want to manually connect to new irc server, do /fs off, /fs on
+#
+# --
+# Changes above by Cvbge (piotr at pingu.ii.uj.edu.pl)
+# --
+#
+# 0.6.0
+# -----
+#
+# * Merged patch from Ethan Fischer (allanon@crystaltokyo.com)
+# - added ignore_chat option that, when turned on, ignores the
+# trigger if said in the channel; it also changes the trigger
+# advertisement to "/ctcp nick !trigger"
+# - added ops_priority option that, when set to 1, force-adds
+# requests from to the top of the download queue regardless of
+# queue size; when set to 2, it does the same thing for voices
+# - added log_name option to specify the name of a logfile which
+# will be used to store transfer logs; the log contains the time
+# a dcc transfer finishes, whether it finished or failed, filename,
+# nick, bytes sent, start time, and end time
+# - added a kludge to kill dcc chats after an "exit" in sig_timeout()
+# - added a -clear option to the set command (eg, /fs set -clear
+# log_name) which sets the variable to an empty string
+#
+# * Merged patch from Brian (btherl@optushome.com.au)
+# - Avoid division by zero when dcc send takes 0 time to complete
+# - new user command "read" - allows reading of small (<30k) files,
+# such as checksum files
+# - set line delimeter before load_config()
+# - formatting of function headers
+#
+# thanks for the patches guys :)
+#
+# * the bytecounter now also counts the number of bytes sent
+# for failed transfers as well as successful transfers
+# (with respects to resumed files)
+# * some bugfixes I don't remember ;)
+#
+#############################################################################
+
+# Best viewed with TAB size = 4 !
+
+use strict;
+no strict 'refs';
+
+use Irssi;
+use Irssi::Irc;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "2.0.0";
+my $conffile = '$IRSSI/fserve.conf';
+
+%IRSSI = (
+ authors => 'Piotr Krukowiecki & others',
+ contact => 'piotr at pingu.ii.uj.edu.pl',
+ name => 'FServe',
+ description => 'File server for irssi',
+ license => 'GPL v2',
+ url => 'http://pingu.ii.uj.edu.pl/~piotr/irssi'
+);
+
+
+my @welcome_msg = (
+ "FServe $VERSION for Irssi",
+ "-",
+ "Commands: ls dir cd get read dequeue clr_queue queue sends",
+ " help who stats quit",
+);
+
+my @help_msg = (
+ "-=[ Available commands ]=-",
+ " ls / dir - list files in current directory",
+ " cd <dir> - changes current directory to <dir>",
+ " (note: <dir> is case sensitive!)",
+ " get <file> - inserts <file> into the queue",
+ " read <file> - displays contents of <file>",
+ " dequeue <nr> - removes file in slot <nr>",
+ " clr_queue[s] - removes your queued files",
+ " queue[s] - lists the queue",
+ " sends - lists active sends",
+ " who - lists users online",
+ " stats - shows some statistice",
+ " quit - closes the connection",
+);
+
+my @srv_help_msg = (
+ "command - [params] description\003\n",
+ "on - [0] enables fileserver",
+ "off - [0] disables fileserver",
+ "save - [0] save config file",
+ "load - [0] load config file",
+ "saveq - [0] saves sends/queues",
+ "loadq - [0] loads the queues",
+ "set - [0/2] sets variables",
+ "addq - [0] adds new queue",
+ "delq - [1] deletes queue",
+ "selq - [1] sets default queue for next 4 commands",
+ "setq - [0/2] sets queue variables",
+ "queue - [0-1] lists file queue",
+ "sortq - [0-1] sorts queue",
+ "move - [2-3] moves queue slots around",
+ "insert - [3] inserts a file in queue",
+ "clear - [1] removes queued files",
+ "sends - [0] lists active sends",
+ "who - [0] lists users online",
+ "stats - [0] shows server statistics",
+ "recache - [0] updates filecache\003\n",
+ "Usage: /fs <command> [<arguments>]",
+ "For parameter info type /fs <cmd>",
+ "Please read beginning of the fserve.pl (the changelog)",
+ "for more information",
+);
+
+###############################################################################
+# fileserver preferences (/fs set <var> <data>)
+# default values, feel free to change them
+###############################################################################
+my %fs_prefs = (
+ auto_save => 599,
+ autosave_on_close => 1,
+ clr_dir => "\00312",
+ clr_file => "\00315",
+ clr_hi => "\00312",
+ clr_txt => "\00315",
+ count_send_as_queue => 0,
+ debug => 0,
+ distro => 0,
+ distro_file => '$IRSSI/fserve.distro',
+ idle_time => 120,
+ ignores => "",
+ log_name => '$IRSSI/fserve.log', # FIXME should be renamed to logfile or similar
+ max_queues => 10,
+ max_sends => 2,
+ max_time => 600,
+ max_users => 5,
+ min_upload => 0,
+ motd => '',
+ motdfile => '',
+ offline_message => '', # is displayed when someone wants to enter disabled fserve
+ queuefile => '$IRSSI/fserve.queue',
+ recache_interval => 3607,
+);
+
+my %fs_queue_defaults = (
+ channels => '#CHANGE_ME',
+ content => '',
+ ctcp_only => 1,
+ custom_notice => 1,
+ custom_notice_fields=> "trigger sends queues min_cps note content",
+ dont_notify => "",
+ find => 3,
+ guaranted_queues => 0,
+ guaranted_sends => 0,
+ ignore_msg => 1,
+ ignores => "",
+ instant_send => 10240,
+ max_queues => 10,
+ max_resends => 3,
+ max_sends => 2,
+ min_cps => 9728,
+ motd => '',
+ nice => 0,
+ note => '',
+ notify_interval => 0,
+ notify_on_join => 0,
+ queue_priority => "",
+ request => "",
+ restricted_level => 0,
+ root_dir => '/path/to/files/CHANGE_ME',
+ servers => 'CHANGE_ME',
+ speed_warnings => 1,
+ trigger => '!trigger',
+ user_slots => 3,
+);
+
+###############################################################################
+# fileserver statistics
+###############################################################################
+my %fs_stats = (
+ record_cps => 0,
+ rcps_nick => "",
+ sends_ok => 0, # sends succeeded
+ sends_fail => 0, # sends failed
+ transfd => 0, # total bytes transferred
+ login_count => 0, # total number of logins
+);
+
+my @fs_queues = ();
+my @fs_sends = ();
+my %fs_users = ();
+my %fs_distro = ();
+
+###############################################################################
+# private variables
+###############################################################################
+my $fs_enabled = 0; # always start disabled
+my $online_time = 0; # time since last script restart
+my $timer_tag;
+my $logfp;
+my @kill_dcc;
+my $upload_counter = 0;
+my $last_upload = 0;
+my $last_upload_check = 0;
+my $motdfile_modified = 0; #when was motd file last modified
+my @motd = ();
+my $default_queue = 0;
+my $next_queue = 0;
+my $FD = "'"; # old irssi (<0.8.6) doesn't use "'" in /dcc send 'file'
+
+###############################################################################
+# setup signal handlers
+###############################################################################
+Irssi::signal_add_first('event privmsg', 'sig_event_privmsg');
+Irssi::signal_add_first('event join', 'sig_event_join');
+Irssi::signal_add_first('default ctcp msg', 'sig_ctcp_msg');
+Irssi::signal_add_last('dcc chat message', 'sig_dcc_msg');
+
+Irssi::signal_add_last('dcc connected', 'sig_dcc_connected');
+Irssi::signal_add('dcc destroyed', 'sig_dcc_destroyed');
+
+Irssi::signal_add('nicklist changed', 'sig_nicklist_changed');
+
+Irssi::command_bind('fs', 'sig_fs_command');
+print_msg("FServe version $VERSION");
+print_log("FServe starting up");
+
+$_ = $conffile;
+s/\$IRSSI/Irssi::get_irssi_dir()/e or s/~/$ENV{"HOME"}/;
+if (-e) {
+ load_config();
+} else {
+ print_msg("If this is your first time using this fserve");
+ print_msg("I advise you to read help (/fs help)");
+}
+if (!@fs_queues) {
+ print_debug("Added inital trigger");
+ push (@fs_queues, { %fs_queue_defaults });
+ @{$fs_queues[$#fs_queues]->{queue}} = ();
+}
+
+{
+ my $ver = 'Very Old';
+ eval { $ver = Irssi::version(); };
+ if ($ver - 20021117 < 0) {
+ print_debug("Detected old irssi version: $ver") ;
+ $FD = "";
+ }
+}
+
+if ($fs_prefs{distro} and $fs_prefs{distro_file}) {
+ $_ = $fs_prefs{distro_file};
+ s/\$IRSSI/Irssi::get_irssi_dir()/e or s/~/$ENV{"HOME"}/;
+ if (-e) {
+ load_distro($_) and print_msg("Distro file loaded");
+ }
+}
+
+###############################################################################
+# prints debug messages in the (fserve_dbg) window
+###############################################################################
+sub print_debug
+{
+ if ($fs_prefs{debug}) {
+ Irssi::print("<DBG> @_", MSGLEVEL_CLIENTERROR);
+ }
+}
+
+###############################################################################
+# prints server message in current window
+###############################################################################
+sub print_msg
+{
+ Irssi::active_win()->print("$fs_prefs{clr_txt} @_");
+}
+
+sub print_what_we_did {
+ Irssi::print("@_", MSGLEVEL_CLIENTCRAP);
+}
+
+sub max($$) { return @_[0]>@_[1]?@_[0]:@_[1]; }
+sub min($$) { return @_[0]<@_[1]?@_[0]:@_[1]; }
+
+###############################################################################
+###############################################################################
+##
+## Signal handler routines
+##
+###############################################################################
+###############################################################################
+
+sub get_max_sends($) {
+ my $qn = @_[0];
+
+ my $qu_msends = $fs_queues[$qn]->{max_sends};
+ my $gl_msends = $fs_prefs{max_sends};
+ my $guaranted_sends = $fs_queues[$qn]->{guaranted_sends};
+
+ my $current_sends = $fs_queues[$qn]->{sends};
+ my $free_sends =
+ max( $guaranted_sends - $current_sends,
+ min($gl_msends - @fs_sends, $qu_msends - $current_sends) );
+ $free_sends = 0 if ($free_sends < 0);
+ my $max_sends = max( $guaranted_sends, min($qu_msends,$gl_msends) );
+
+ return ($current_sends, $free_sends, $max_sends);
+}
+
+sub get_max_queues($) {
+ my $qn = @_[0];
+
+ my $qu_mqueues = $fs_queues[$qn]->{max_queues};
+ my $gl_mqueues = $fs_prefs{max_queues};
+ my $guaranted_queues = $fs_queues[$qn]->{guaranted_queues};
+ # TODO: keep this somewhere?
+ my $gl_current_queues = 0;
+ foreach (0 .. $#fs_queues) {
+ $gl_current_queues += @{$fs_queues[$_]->{queue}};
+ }
+
+ my $current_queues = @{$fs_queues[$qn]->{queue}};
+ my $free_queues =
+ max( $guaranted_queues - $current_queues,
+ min($gl_mqueues - $gl_current_queues,
+ $qu_mqueues - $current_queues) );
+ $free_queues = 0 if ($free_queues < 0);
+ my $max_queues = max( $guaranted_queues, min($qu_mqueues, $gl_mqueues) );
+
+ return ($current_queues, $free_queues, $max_queues);
+}
+
+###############################################################################
+# updates some variables when DCC CHAT is established
+###############################################################################
+sub sig_dcc_connected
+{
+ my ($dcc) = @_;
+ my $tag = $dcc->{servertag};
+ my $user_id = $dcc->{nick}."@".$tag;
+ print_debug("DCC connected: $dcc->{type} $user_id");
+
+ return if ($dcc->{type} ne "CHAT" || !defined $fs_users{$user_id});
+
+ print_debug("User $user_id connected!");
+ $fs_users{$user_id}{status} = 0;
+ $fs_users{$user_id}{time} = 0;
+ $fs_stats{login_count}++;
+
+ foreach (@welcome_msg) {
+ send_user_msg($tag, $dcc->{nick}, $_);
+ }
+ send_user_msg($tag, $dcc->{nick}, "-");
+
+ my $qn = $fs_users{$user_id}{queue};
+ my ($curr_queues, $free_queues, $max_queues) = get_max_queues($qn);
+ my ($curr_sends, $free_sends, $max_sends) = get_max_sends($qn);
+
+ send_user_msg($tag, $dcc->{nick}, "Current/Free/Max Sends: ".
+ "$curr_sends/$free_sends/$max_sends");
+ send_user_msg($tag, $dcc->{nick}, "Current/Free/Max Queues: ".
+ "$curr_queues/$free_queues/$max_queues");
+ send_user_msg($tag, $dcc->{nick}, "Your queue: ".
+ count_user_files($tag, $dcc->{nick}, $qn).
+ "/$fs_queues[$qn]->{user_slots}");
+
+ send_user_msg($tag, $dcc->{nick}, "Instant send: ".
+ size_to_str($fs_queues[$qn]{instant_send}))
+ if ($fs_queues[$qn]{instant_send} > 0);
+
+ if ($fs_prefs{motdfile}) {
+ send_user_msg($tag, $dcc->{nick}, "-");
+ my $f = $fs_prefs{motdfile};
+ $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/;
+ if (! ((-f $f) and (-r $f))) {
+ print_msg("FServe: '$f' doesn't exists, isn't plain file or is not readable");
+ } else {
+ my $lm = (stat($f))[9];
+ if ($motdfile_modified < $lm) {
+ $motdfile_modified = $lm;
+ @motd = ();
+ open(FILE, "<", $f);
+ while(<FILE>) {
+ chomp;
+ s/\t/ /g;
+ push @motd, $_;
+ }
+ close(FILE, $f);
+ }
+ foreach (@motd) {
+ send_user_msg($tag, $dcc->{nick}, $_);
+ }
+ }
+ }
+
+ if (length($fs_prefs{motd})) {
+ send_user_msg($tag, $dcc->{nick}, "-");
+ send_user_msg($tag, $dcc->{nick}, "$fs_prefs{motd}");
+ }
+ if (length($fs_queues[$qn]{motd})) {
+ send_user_msg($tag, $dcc->{nick}, "-");
+ send_user_msg($tag, $dcc->{nick}, "$fs_queues[$qn]{motd}");
+ }
+ send_user_msg($tag, $dcc->{nick}, "-");
+ send_user_msg($tag, $dcc->{nick}, '[\]');
+}
+
+###############################################################################
+# cleanups after DCC CHAT/SEND disconnects
+###############################################################################
+sub sig_dcc_destroyed
+{
+ my ($dcc) = @_;
+ my $nick = $dcc->{nick};
+ my $server = $dcc->{server};
+ my $server_tag = $dcc->{servertag};
+ my $user_id = $nick.'@'.$server_tag;
+
+ print_debug("DCC destroyed: $dcc->{type} $user_id '$dcc->{arg}'");
+
+ if ($dcc->{type} eq "CHAT" && defined $fs_users{$user_id}) {
+ delete $fs_users{$user_id};
+ print_debug("Users left: ".keys %fs_users);
+ } elsif ($dcc->{type} eq "SEND") {
+ foreach my $sn (0 .. $#fs_sends) {
+ print_debug("check slot $sn: ".
+ "user=$fs_sends[$sn]->{nick}\@$fs_sends[$sn]->{server_tag}, ".
+ "file=$fs_sends[$sn]->{file}.");
+ if ($fs_sends[$sn]->{nick} eq $nick &&
+ $fs_sends[$sn]->{server_tag} eq $server_tag &&
+ $fs_sends[$sn]->{file} eq $dcc->{arg}) {
+ print_debug("found send in slot $sn");
+ if ($dcc->{transfd} == $fs_sends[$sn]->{size}) {
+ print_log("dcc_finish $dcc->{arg} $user_id ".
+ "$dcc->{skipped} $dcc->{transfd} ".
+ "$dcc->{starttime} ".time());
+ print_debug("file was finished");
+ $fs_stats{sends_ok}++;
+ if ($fs_prefs{distro}) {
+ $fs_distro{$dcc->{arg}}{$dcc->{transfd}}++;
+ save_distro();
+ }
+
+ ## Update speed record (if new)
+ if (time() > $dcc->{starttime}) {
+ my $speed = ($dcc->{transfd}-$dcc->{skipped})/
+ (time() - $dcc->{starttime});
+
+ if ($speed > $fs_stats{record_cps}) {
+ $fs_stats{record_cps} = $speed;
+ $fs_stats{rcps_nick} = $nick;
+ }
+ }
+ } else {
+ if ($fs_sends[$sn]->{transfd} == -1) {
+ # send was too slow
+ print_log("dcc_abort $dcc->{arg} $user_id ".
+ "$dcc->{skipped} $dcc->{transfd} ".
+ "$dcc->{starttime} ".time());
+ } else {
+ $fs_sends[$sn]->{resends} += 1;
+ $fs_sends[$sn]->{warns} = 0;
+ $fs_sends[$sn]->{dontwarn} = 0;
+ delete $fs_sends[$sn]->{transfd};
+
+ if ($fs_sends[$sn]->{resends} <=
+ $fs_queues[$fs_sends[$sn]{queue}]{max_resends}) {
+
+ # queue it for resending
+ # don't resend right now, you may be treated as flood
+ my $fsq = $fs_queues[$fs_sends[$sn]->{queue}]->{queue};
+ # TODO should be parametrized (in which slot requeue)
+ my $resended_queue = 0;
+ foreach (0 .. $#{$fsq}) {
+ last if (!${$fsq}[$_]->{resends});
+ $resended_queue++;
+ }
+ $resended_queue = 1
+ if (!$resended_queue && @{$fsq}>0);
+ print_debug("requeued $dcc->{arg} for ".
+ "$user_id in slot $resended_queue, ".
+ "resend $fs_sends[$sn]->{resends}");
+ splice(@{$fsq}, $resended_queue, 0, { %{$fs_sends[$sn]} });
+ $server->command("^NOTICE ".
+ "$fs_sends[$sn]->{nick} ".
+ "$fs_prefs{clr_txt} Send failed on try ".
+ $fs_sends[$sn]->{resends}." of ".
+ ($fs_queues[$fs_sends[$sn]{queue}]{max_resends}+1).
+ ". Type /ctcp ".
+ "$$server{nick} NoReSend to cancel "
+ ."any further resends.")
+ if ($server && $server->{connected});
+ print_what_we_did("NOTICE ".
+ "$fs_sends[$sn]->{nick} ".
+ "$fs_prefs{clr_txt} Send failed on try ".
+ $fs_sends[$sn]->{resends}." of ".
+ ($fs_queues[$fs_sends[$sn]{queue}]{max_resends}+1).
+ ". Type /ctcp ".
+ "$$server{nick} NoReSend to cancel "
+ ."any further resends.")
+ if ($server && $server->{connected});
+ print_log("dcc_soft_fail $dcc->{arg} $user_id ".
+ "$dcc->{skipped} $dcc->{transfd} ".
+ "$dcc->{starttime} ".time());
+ } else {
+ print_log("dcc_fail $dcc->{arg} $user_id ".
+ "$dcc->{skipped} $dcc->{transfd} ".
+ "$dcc->{starttime} ".time());
+ }
+ }
+ $fs_stats{sends_fail}++;
+ }
+
+ ## Update bytes transferred
+ $fs_stats{transfd} += ($dcc->{transfd} - $dcc->{skipped});
+ splice(@fs_sends, $sn, 1); # FIXME : decrease number of sends?
+ print_debug("SEND closed to $user_id, file: ".
+ "$dcc->{arg}, bytes sent: ".
+ ($dcc->{transfd}-$dcc->{skipped}).
+ " (sent from slot $sn, ".@fs_sends." slots now)");
+ return;
+ }
+ }
+ }
+}
+
+###############################################################################
+# handles dcc chat messages
+###############################################################################
+sub sig_dcc_msg
+{
+ my $dcc = shift (@_);
+ my $msg = @_[0];
+ my $user_id = $dcc->{nick}.'@'.$dcc->{servertag};
+
+ # ignore messages from unconnected dcc chats
+ return unless ($fs_enabled && defined $fs_users{$user_id});
+
+ # reset idle time for user
+ $fs_users{$user_id}{status} = 0;
+
+ my ($cmd, $args) = split(' ', $msg, 2);
+ $cmd = lc($cmd);
+
+ if ($cmd eq "dir" || $cmd eq "ls") {
+ list_dir($user_id, "$args");
+ } elsif ($cmd eq "cd") {
+ change_dir($user_id, "$args");
+ } elsif ($cmd eq "cd..") { # darn windows users ;)
+ change_dir($user_id, '..');
+ } elsif ($cmd eq "get") {
+ queue_file($user_id, "$args");
+ } elsif ($cmd eq "dequeue") {
+ $args =~ s/^\D*(\d+)\D*$/$1/; # stupid leechers, we have to remove garbage
+ dequeue_file($user_id, $args);
+ } elsif ($cmd eq "clr_queue" || $cmd eq "clr_queues") {
+ clear_queue($user_id, 0, $fs_users{$user_id}{queue});
+ } elsif ($cmd eq "queue" || $cmd eq "queues") {
+ display_queue($user_id, $fs_users{$user_id}{queue});
+ } elsif ($cmd eq "sends") {
+ display_sends($user_id);
+ } elsif ($cmd eq "who") {
+ display_who($user_id);
+ } elsif ($cmd eq "stats") {
+ display_stats($user_id);
+ } elsif ($cmd eq "read") {
+ display_file($user_id, "$args");
+ } elsif ($cmd eq "help") {
+ foreach (@help_msg) {
+ send_user_msg($dcc->{servertag}, $dcc->{nick}, $_);
+ }
+ } elsif ($cmd eq "exit" || $cmd eq "quit" || $cmd eq "bye") {
+ push(@kill_dcc, $user_id);
+ }
+}
+
+###############################################################################
+# server, nick, queue_number
+###############################################################################
+sub try_connecting_user ($$$)
+{
+ my ($server, $sender, $qn) = @_;
+ my $tag = $server->{tag};
+
+ if (defined($fs_users{$sender."@".$tag})) {
+ if (!$fs_users{$sender."@".$tag}{ignore} &&
+ $fs_queues[$qn]->{ignore_msg}) {
+ $server->command("^NOTICE $sender $fs_prefs{clr_txt}".
+ "A DCC chat offer has already been sent to you!");
+ print_what_we_did("NOTICE $sender $fs_prefs{clr_txt}".
+ "A DCC chat offer has already been sent to you!");
+ }
+
+ $fs_users{$sender."@".$tag}{ignore} = 1;
+ return 1;
+ }
+
+ if (keys(%fs_users) < $fs_prefs{max_users}) {
+ if (!$fs_queues[$qn]->{restricted_level}) {
+ initiate_dcc_chat($server, $sender, $qn);
+ return 1;
+ } else {
+ foreach (split (' ', $fs_queues[$qn]->{channels})) {
+ my $ch = $server->channel_find($_);
+ next if !$ch;
+ my $n = $ch->nick_find($sender);
+ next if !$n;
+ if (($n->{op}) or
+ (($fs_queues[$qn]->{restricted_level} < 3) && $n->{halfop}) or
+ (($fs_queues[$qn]->{restricted_level} < 2) && $n->{voice})) {
+ initiate_dcc_chat($server, $sender, $qn);
+ return 1;
+ }
+ }
+ $server->command("^NOTICE $sender $fs_prefs{clr_txt}I'm sorry,"
+ ." but this trigger is restricted. You need to be an".
+ (($fs_queues[$qn]->{restricted_level} == 3) ? " op" :
+ (($fs_queues[$qn]->{restricted_level} == 2) ? " op or halfop" :
+ " op, halfop or voiced")) . " to access this trigger");
+ print_what_we_did("NOTICE $sender $fs_prefs{clr_txt}I'm sorry,"
+ ." but this trigger is restricted. You need to be an".
+ (($fs_queues[$qn]->{restricted_level} == 3) ? " op" :
+ (($fs_queues[$qn]->{restricted_level} == 2) ? " op or halfop" :
+ " op, halfop or voiced")) . " to access this trigger");
+ }
+ } else {
+ $server->command("^NOTICE $sender $fs_prefs{clr_txt}".
+ "Sorry, server is full (".
+ $fs_prefs{clr_hi}.$fs_prefs{max_users}.
+ $fs_prefs{clr_txt}.")!");
+ print_what_we_did("NOTICE $sender $fs_prefs{clr_txt}".
+ "Sorry, server is full (".
+ $fs_prefs{clr_hi}.$fs_prefs{max_users}.
+ $fs_prefs{clr_txt}.")!");
+ }
+ return 0;
+}
+
+
+###############################################################################
+# handles ctcp messages
+###############################################################################
+sub sig_ctcp_msg
+{
+ my ($server, $args, $sender, $addr, $target) = @_;
+ $args = uc($args);
+ $args =~ s/\s*$//; # strip ending spaces
+ my $tag = $server->{tag};
+
+ return if ($fs_prefs{ignores} &&
+ $server->masks_match($fs_prefs{ignores}, $sender, $addr));
+
+ if (!$fs_enabled) {
+ # find queue where the trigger is
+ foreach (0 .. $#fs_queues) {
+ next if ($args ne uc($fs_queues[$_]->{trigger}));
+ next if ($fs_queues[$_]{ignores} &&
+ $server->masks_match($fs_queues[$_]{ignores}, $sender, $addr));
+
+ foreach my $s (split(' ', $fs_queues[$_]->{servers})) {
+ if (uc($s) eq uc($tag) &&
+ user_in_channel($server, $sender, $fs_queues[$_])) {
+
+ $server->command("^NOTICE $sender $fs_prefs{clr_txt}".
+ "Sorry, fserve is currently offline. $fs_prefs{offline_message}");
+ print_what_we_did("NOTICE $sender $fs_prefs{clr_txt}".
+ "Sorry, fserve is currently offline. $fs_prefs{offline_message}");
+ Irssi::signal_stop();
+ return;
+ }
+ } # loop over servers
+ } # loop over queues
+ Irssi::signal_stop();
+ return;
+ }
+
+ print_debug("CTCP from $sender: '$args'");
+
+ if ($args eq "NORESEND") {
+ my $found = 0;
+ foreach (0 .. $#fs_sends) {
+ if ($fs_sends[$_]{nick} eq $sender &&
+ $fs_sends[$_]{server} eq $tag) {
+ print_debug("$sender: Canceling resends of $fs_sends[$_]->{file}");
+ $fs_sends[$_]->{resends} = $fs_queues[$fs_sends[$_]{queue}]{max_resends};
+ $found++;
+ }
+ }
+ my $message = ($found?
+ "Resend: All resends ($found) for currently sending ".
+ "files have been canceled." :
+ "Resend: You currently have no sending files set ".
+ "to resend.");
+ $server->command("^MSG $sender $message");
+ print_what_we_did("MSG $sender $message");
+ Irssi::signal_stop();
+ return;
+ } # end NORESEND
+
+
+ foreach my $qn (0 .. $#fs_queues) {
+ next if ($args ne uc($fs_queues[$qn]->{trigger}));
+ print_debug("Got trigger in queue $qn");
+ next if ($fs_queues[$qn]{ignores} &&
+ $server->masks_match($fs_queues[$qn]{ignores}, $sender, $addr));
+ print_debug("Not ignoring user");
+
+ print_debug("Servers are $fs_queues[$qn]->{servers}");
+ foreach my $s (split(' ', $fs_queues[$qn]->{servers})) {
+ print_debug("Checking server $s against $tag");
+ next if (uc($tag) ne uc($s) ||
+ !user_in_channel($server, $sender, $fs_queues[$qn]));
+ print_debug("Good tag and user in chan");
+
+ if (try_connecting_user($server, $sender, $qn)) {
+ Irssi::signal_stop();
+ return;
+ }
+ }
+ }
+ Irssi::signal_stop();
+ return;
+}
+
+###############################################################################
+# notifies joining users
+###############################################################################
+sub sig_event_join
+{
+ my ($server, $data, $sender, $addr) = @_;
+ my ($target) = ($data =~ /:(.*)/);
+
+ return if (!$fs_enabled);
+
+ foreach my $qn (0 .. $#fs_queues) {
+ next if (!$fs_queues[$qn]->{notify_on_join});
+ next if ($fs_queues[$qn]{ignores} &&
+ $server->masks_match($fs_queues[$qn]{ignores}, $sender, $addr));
+
+ foreach my $s (split(' ', $fs_queues[$qn]->{servers})) {
+ next if (uc($s) ne uc($server->{tag}));
+ foreach my $channel (split(' ', $fs_queues[$qn]->{channels})) {
+ next if (uc($channel) ne uc($target));
+ show_notice($server, $sender, $qn);
+ } # loop over channels
+ } # loop over servers
+
+ } # loop over queues
+
+}
+
+###############################################################################
+# handles channel and private messages
+###############################################################################
+sub sig_event_privmsg
+{
+ my ($server, $data, $sender, $addr) = @_;
+ my ($target, $text) = split(/ :/, $data, 2);
+
+ return if (!$fs_enabled);
+ return if ($fs_prefs{ignores} &&
+ $server->masks_match($fs_prefs{ignores}, $sender, $addr));
+
+ foreach my $qn (0 .. $#fs_queues) {
+ next if ($fs_queues[$qn]{ignores} &&
+ $server->masks_match($fs_queues[$qn]{ignores}, $sender, $addr));
+ foreach my $s (split(' ', $fs_queues[$qn]->{servers})) {
+ next if (uc($s) ne uc($server->{tag}));
+ foreach my $channel (split(' ', $fs_queues[$qn]->{channels})) {
+ next if (uc($channel) ne uc($target));
+
+
+ # trigger typed
+ if (!$fs_queues[$qn]->{ctcp_only} &&
+ uc($text) eq uc($fs_queues[$qn]->{trigger})) {
+ try_connecting_user($server, $sender, $qn);
+ return;
+ }
+
+ # strip extra spaces
+ $_ = uc($text);
+ s/\s+$//; s/^\s+$//; s/\s+/ /g;
+ if (($_ eq '!LIST') || ($_ eq ('!LIST '.uc($$server{nick}))) ||
+ ($_ eq '!OLIST' and $fs_queues[$qn]->{restricted_level}) ||
+ ($_ eq '!VLIST' and $fs_queues[$qn]->{restricted_level} == 1)
+ ) {
+ show_notice($server, $sender, $qn);
+ }
+ if (length($fs_queues[$qn]->{request}) && ($_ eq '!REQUEST'))
+ {
+ my $msg = "[$fs_prefs{clr_hi}Request$fs_prefs{clr_txt}] ".
+ "Message:[$fs_prefs{clr_hi}$fs_queues[$qn]->{request}".
+ "$fs_prefs{clr_txt}] - FServe $VERSION";
+ $server->command("^NOTICE $sender $fs_prefs{clr_txt}$msg");
+ print_what_we_did("NOTICE $sender $fs_prefs{clr_txt}$msg");
+ }
+
+ if ($fs_queues[$qn]->{find}) {
+ if (/^\@FIND /) {
+ if ($sender !~ /^#/) {
+ show_find($server, $sender, $text, $qn);
+ }
+ }
+ }
+
+ } # loop over channels
+ } # loop over servers
+ } # loop over queues
+}
+
+
+###############################################################################
+# updates userinfo on nick changes
+###############################################################################
+sub sig_nicklist_changed
+{
+ my ($chan, $nick, $oldnick) = @_;
+ my $server_tag = $chan->{server}{tag};
+
+ print_debug("NICK CHANGE: $oldnick -> $nick->{nick}\@$server_tag on $chan->{name}");
+
+ foreach my $qn (0 .. $#fs_queues) {
+
+ my $ch_ok = 0;
+ my $srv_ok = 0;
+ foreach (split(' ', $fs_queues[$qn]->{channels})) {
+ if (uc($_) eq uc($chan->{name})) {
+ $ch_ok = 1;
+ last;
+ }
+ }
+ foreach (split(' ', $fs_queues[$qn]->{servers})) {
+ if (uc($_) eq uc($server_tag)) {
+ $srv_ok = 1;
+ last;
+ }
+ }
+
+ next unless ($ch_ok && $srv_ok);
+
+
+ my $old_user_id = $oldnick.'@'.$server_tag;
+ my $user_id = $nick->{nick}.'@'.$server_tag;
+
+ if (defined $fs_users{$old_user_id}) {
+ print_debug("Changing connected user data");
+ # update user data
+ my $rec = $fs_users{$old_user_id};
+ delete $fs_users{$old_user_id};
+ $fs_users{$user_id} = { %{$rec} };
+ }
+
+ # update queue
+ my $fsq = $fs_queues[$qn]->{queue};
+ foreach (0 .. $#{$fsq}) {
+ if (${$fsq}[$_]->{nick} eq $oldnick &&
+ ${$fsq}[$_]->{server_tag} eq $server_tag) {
+ print_debug("Changing queued file data");
+ ${$fsq}[$_]->{nick} = $nick->{nick};
+ }
+ }
+
+ # DONT update sends - irssi bug?
+ # irssi doesn't change nick in dcc sends
+# foreach (0 .. $#fs_sends) {
+# if ($fs_sends[$_]->{nick} eq $oldnick &&
+# $fs_sends[$_]->{server_tag} eq $server_tag) {
+# $fs_sends[$_]->{nick} = $nick->{nick};
+# }
+# }
+
+ }
+}
+
+###############################################################################
+# sig_timeout(): called once every second
+###############################################################################
+sub sig_timeout
+{
+ # kill connections that said "bye", campers, ghost users etc.
+ foreach (@kill_dcc) {
+ my ($nick, $servertag) = split('@', $_);
+ my $server = Irssi::server_find_tag($servertag);
+ next if (!$server || !$server->{connected});
+ print_debug("Closing dcc chat to $nick on $servertag");
+ $server->command("DCC CLOSE CHAT $nick");
+ }
+ @kill_dcc = ();
+
+ my $time = time();
+
+ # check for campers...
+ foreach (keys %fs_users) {
+ $fs_users{$_}{time}++;
+ if ($fs_users{$_}{status} >= 0) {
+ $fs_users{$_}{status}++;
+ my ($nick, $server_tag) = split('@', $_);
+
+ if ($fs_users{$_}{status} > $fs_prefs{idle_time}) {
+ send_user_msg($server_tag, $nick,
+ "Idletime ($fs_prefs{clr_hi}".
+ "$fs_prefs{idle_time}$fs_prefs{clr_txt} sec) ".
+ "reached, disconnecting!");
+ push(@kill_dcc, $_);
+ } elsif ($fs_users{$_}{time} > $fs_prefs{max_time}) {
+ send_user_msg($server_tag, $nick,
+ "Does this look like a campsite? (".
+ "$fs_prefs{clr_hi}$fs_prefs{max_time} ".
+ "sec$fs_prefs{clr_txt})");
+ push(@kill_dcc, $_);
+ }
+ # 7 minutes for user to connect
+ } elsif ($fs_users{$_}{status} == -1 and $fs_users{$_}{time} > 420) {
+ print_msg("BUG workaround: probably ghost user '$_'. Removing from user list .");
+ delete $fs_users{$_};
+ }
+ }
+
+ return if (! $fs_enabled);
+
+ $online_time++;
+
+ # auto save config file
+ if ($fs_prefs{auto_save} && $time % $fs_prefs{auto_save} == 0) {
+ print_debug("Autosaving...");
+ save_config();
+ save_queue();
+ }
+
+ # update all $queue->{sends}
+ # FIXME: Do this 'the old way'
+ # FIXME: BUG: since number of sends is computed only every second
+ # users could exploit this and gain more sends/queues then allowed
+ foreach (0 .. $#fs_queues) { $fs_queues[$_]->{sends} = 0; }
+ foreach (0 .. $#fs_sends) { $fs_queues[$fs_sends[$_]->{queue}]->{sends}++; }
+# foreach (0 .. $#fs_queues) {
+# print_debug("Trigger #" . $_ . " have " . $fs_queues[$_]->{sends} .
+# " sends.") ;
+# }
+
+ # First send forced sends
+ my $file_sent = 0;
+ foreach (0 .. $#fs_queues) {
+ if ($fs_queues[$_]->{sends} < $fs_queues[$_]->{guaranted_sends}) {
+ if (run_queue($fs_queues[$_]) == 0) {
+ $file_sent = 1;
+ $upload_counter = 0;
+ print_debug("Sent forced queue");
+ last;
+ }
+ }
+ }
+
+ # send only one file per second.
+ if (!$file_sent) {
+ if (send_next_file() == 0) {
+ $file_sent = 1;
+ $upload_counter = 0;
+ print_debug("Sent normal queue");
+ }
+ }
+
+ # check for min upload (up to 2*max_sends+1)
+ # FIXME don't use 2*m_s+1 but parametrize
+ if (!$file_sent && @fs_sends >= $fs_prefs{max_sends} &&
+ $time > $last_upload_check &&
+ @fs_sends <= 2*$fs_prefs{max_sends} && ($time % 60) == 0) {
+ my $curr_ups = 0;
+ foreach my $dcc (Irssi::Irc::dccs()) {
+ if ($dcc->{type} eq 'SEND') {
+ $curr_ups += ($dcc->{transfd}-$dcc->{skipped})/($time - $last_upload_check);
+ }
+ }
+ $curr_ups -= $last_upload;
+ $last_upload += $curr_ups;
+ $last_upload_check = $time;
+ if ($curr_ups > 0 && $curr_ups < $fs_prefs{min_upload}) {
+ $upload_counter++;
+ print_debug("Upload $curr_ups is below minimal, counter is $upload_counter");
+ if ($upload_counter > 4) {
+ send_next_file(1);
+ $upload_counter = 0;
+ }
+ } else {
+ $upload_counter = 0;
+ }
+ }
+
+ # recache files
+ if ($fs_prefs{recache_interval} &&
+ $time % $fs_prefs{recache_interval} == 0) {
+ update_files();
+ }
+
+ # notify channels
+ foreach my $qn (0 .. $#fs_queues) {
+ if ($fs_queues[$qn]->{notify_interval} &&
+ $time % $fs_queues[$qn]->{notify_interval} == 0) {
+ foreach (split(' ', $fs_queues[$qn]->{channels})) {
+ foreach my $s (split(' ', $fs_queues[$qn]->{servers})) {
+ my $server = Irssi::server_find_tag($s);
+ next if (!$server || !$server->{connected});
+ show_notice($server, $_, $qn);
+ }
+ }
+ }
+ }
+
+ # check speed of sends
+ if (($time % 60) == 0) {
+ for (my $s = $#fs_sends; $s >= 0; $s--) {
+ if ($fs_queues[$fs_sends[$s]{queue}]{min_cps}) {
+ check_send_speed($s);
+ }
+ }
+ }
+}
+
+###############################################################################
+# check_send_speed(): aborts send in $slot if speed < $fs_prefs{min_cps}
+###############################################################################
+sub check_send_speed
+{
+ my ($s) = @_;
+ print_debug("check_sends_speed: checking speed of ".
+ "$fs_sends[$s]->{nick}\@$fs_sends[$s]->{server_tag}".
+ " $fs_sends[$s]->{file}");
+
+ foreach my $dcc (Irssi::Irc::dccs()) {
+ print_debug("check_sends_speed: checking DCC ".
+ "$dcc->{nick}\@$dcc->{servertag} $dcc->{arg}");
+
+ next if ($dcc->{type} ne 'SEND' ||
+ $dcc->{nick} ne $fs_sends[$s]->{nick} ||
+ $dcc->{servertag} ne $fs_sends[$s]->{server_tag} ||
+ $dcc->{arg} ne $fs_sends[$s]->{file});
+
+ print_debug ("Found send");
+ return unless ($dcc->{starttime});
+
+ if (defined $fs_sends[$s]->{transfd}) {
+ my $speed = ($dcc->{transfd}-$fs_sends[$s]->{transfd})/60;
+ my $min_cps = $fs_queues[$fs_sends[$s]{queue}]{min_cps};
+ if ($speed < 0) {
+ print_msg("BUG: send speed < 0 ($speed). Send number $s, ".
+ "dcc->transfd='$dcc->{transfd}', fs_sends->transfd='".
+ $fs_sends[$s]->{transfd} . "', skipped='".
+ $dcc->{skipped}. "', starttime='$dcc->{starttime}'. ".
+ "Please report this to maintainer (the best is to attach ".
+ "log output of last couple of minutes). Listing sends:");
+ display_sends('!fserve!');
+ }
+ if ($speed < $min_cps) {
+ # too slow...
+
+ if ($fs_sends[$s]->{warns} <
+ $fs_queues[$fs_sends[$s]{queue}]->{speed_warnings}) {
+
+ # but he/she still has a chanse...
+ my $warn_msg;
+ my $last_warn_msg;
+
+ print_debug("$dcc->{nick}: send is too slow ($speed),".
+ " but warns=".$fs_sends[$s]->{warns});
+
+ if (!$fs_sends[$s]->{dontwarn}) {
+
+ if ($fs_sends[$s]->{warns} == 0) {
+ $warn_msg = "First warning";
+ } elsif ($fs_sends[$s]->{warns} == 1) {
+ $warn_msg = "Second warning";
+ } else {
+ $warn_msg = "Warning";
+ $fs_sends[$s]->{dontwarn} = 1;
+ $last_warn_msg = ' Next warnings will be suppressed.';
+ }
+ my $server = $dcc->{server};
+ if ($server && $server->{connected}) {
+ $server->command("^NOTICE $fs_sends[$s]->{nick} ".
+ $fs_prefs{clr_txt}.$warn_msg.
+ ": the speed of your send (".
+ $fs_prefs{clr_hi}.size_to_str($speed)."/s".
+ $fs_prefs{clr_txt}.") is less than min CPS ".
+ "requirement (".$fs_prefs{clr_hi}.
+ size_to_str($min_cps)."/s".
+ $fs_prefs{clr_txt}.").".$last_warn_msg);
+ print_what_we_did("NOTICE $fs_sends[$s]->{nick} ".
+ $fs_prefs{clr_txt}.$warn_msg.
+ ": the speed of your send (".
+ $fs_prefs{clr_hi}.size_to_str($speed)."/s".
+ $fs_prefs{clr_txt}.") is less than min CPS ".
+ "requirement (".$fs_prefs{clr_hi}.
+ size_to_str($min_cps)."/s".
+ $fs_prefs{clr_txt}.").".$last_warn_msg);
+ }
+ }
+
+ $fs_sends[$s]->{warns} += 1;
+ } else {
+ # we must finish him :(
+ my $server = $dcc->{server};
+ print_debug("$dcc->{nick}: warns=".
+ $fs_sends[$s]->{warns}.
+ " and speed is too slow ($speed)");
+ if ($server && $server->{connected}) {
+ $server->command("^NOTICE $fs_sends[$s]->{nick} ".
+ $fs_prefs{clr_txt}."The speed of your send (".
+ $fs_prefs{clr_hi}.size_to_str($speed)."/s".
+ $fs_prefs{clr_txt}.") is less than min CPS ".
+ "requirement (".$fs_prefs{clr_hi}.
+ size_to_str($min_cps)."/s".
+ $fs_prefs{clr_txt}."), aborting...");
+ print_what_we_did("NOTICE $fs_sends[$s]->{nick} ".
+ $fs_prefs{clr_txt}."The speed of your send (".
+ $fs_prefs{clr_hi}.size_to_str($speed)."/s".
+ $fs_prefs{clr_txt}.") is less than min CPS ".
+ "requirement (".$fs_prefs{clr_hi}.
+ size_to_str($min_cps)."/s".
+ $fs_prefs{clr_txt}."), aborting...");
+
+ $fs_sends[$s]{transfd} = -1;
+ $server->command("DCC CLOSE SEND $dcc->{nick}");
+ }
+ # FIXME: don't return here?
+ return; # don't touch $fs_sends[$s] anymore!
+ }
+ } else {
+ if ($fs_sends[$s]->{warns}) {
+ print_debug("$dcc->{nick}: speed is ok ($speed), reset speed warnings");
+ $fs_sends[$s]->{warns} = 0;
+ }
+ }
+ }
+ $fs_sends[$s]->{transfd} = $dcc->{transfd};
+ return;
+ }
+ # Could not find active send matching out record - delete it
+ # Don't know why it happens, one possibility is the file name in
+ # dcc_destroyed do not match the one recoreded in fs_sends, but don't
+ # know how it's possibile
+ print_debug("BUG?: cannot find file $fs_sends[$s]->{file} sending to ".
+ "$fs_sends[$s]->{nick}\@$fs_sends[$s]->{server_tag}");
+ print_debug("Active sends:");
+ foreach (Irssi::Irc::dccs()) {
+ print_debug("$_->{nick}\@$_->{servertag} -> $_->{arg}")
+ if ($_->{type} eq 'SEND');
+ }
+ print_debug("Removing lost send");
+ splice(@fs_sends, $s, 1);
+}
+
+
+sub do_help
+{
+ my $arg = lc(join(" ", @_));
+ print_msg ("Arg is '$arg'");
+
+ if (! $arg) { print_msg("
+Help for FServe
+
+All FServe commands are executed using '/fs <command>'
+syntax.
+To get more help about specific topic type
+'/fs help <topic>'.
+
+List of available help topics:
+* commands - available commands
+* tutorial - how to set up simple file server
+* bugs - known bugs/limitations (TODO)
+"); return; }
+
+ if ($arg eq "commands") { print_msg("
+List of FServe commands.
+
+To get more help about specific command type
+'/fs help <command>'.
+
+v* on - enable fileserver
+v* off - disable fileserver
+v* save - save config file
+v* load - load config file
+v* saveq - save sends and queues
+v* loadq - load queues
+v* set - list/set global settings
+v* sett - list/set trigger variables
+v* addt - add new trigger
+v* delt - delete trigger
+v* selt - set default trigger
+v* queue - list file queue
+v* sortt - sort trigger
+v* move - move queue slots around
+* insert - insert a file into queue
+* clear - remove queued files
+* sends - list active sends
+* who - list online online
+* stats - show server statistics
+* distro - show distro statistics
+* recache - update filecache
+* notify - show fserve ad to user/channel
+* help - show help
+"); return; }
+
+ if ($arg eq "on") { print_msg("
+ON
+
+Enables FServe, updates filecache.
+Doesn't load saved queues.
+
+See also: LOADQ
+"); return; }
+
+ if ($arg eq "off") { print_msg("
+OFF
+
+Disables FServe.
+If 'autosave_on_close' is 1 saves sends and queues.
+
+See also: SAVEQ
+"); return; }
+
+ if ($arg eq "save") { print_msg("
+SAVE
+
+Saves config file.
+"); return; }
+
+ if ($arg eq "load") { print_msg("
+LOAD
+
+Loads config file.
+"); return; }
+
+ if ($arg eq "saveq") { print_msg("
+SAVEQ
+
+Saves sends and queues.
+
+See also: LOADQ
+"); return; }
+
+ if ($arg eq "loadq") { print_msg("
+LOADQ
+
+Loads sends and queues (sends are put
+in the queues as first)
+
+See also: SAVEQ
+"); return; }
+
+ if ($arg eq "set") { print_msg("
+SET [-clear] [variable value]
+
+If used without arguments lists global settings.
+
+You can unset variable with -clear switch,
+for example: /fs set -clear offline_message
+
+To get help for specific variable use
+/fs help set <variable_name>
+
+See also: SETT
+"); return; }
+
+ if ($arg eq "sett") { print_msg("
+SETT [-clear] [variable value]
+
+If used without arguments lists current trigger
+settings.
+You can select current trigger with '/fs selt <number>'
+
+You can unset variable with -clear switch,
+for example: /fs sett -clear offline_message
+
+To get help for specific variable use
+/fs help sett <variable_name>
+
+See also: SET, SELT
+"); return; }
+
+ if ($arg eq "addt") { print_msg("
+ADDT
+
+Adds new trigger.
+
+See also: SELT
+"); return; }
+
+ if ($arg eq "delt") { print_msg("
+DELT <trigger number>
+
+Removes trigger.
+It does not remove files from queues.
+
+See also: SELT
+"); return; }
+
+ if ($arg eq "selt") { print_msg("
+SELT <trigger number>
+
+Selects default trigger.
+
+The default trigger is used as default for
+MOVE, QUEUE, SETT, SORTT commands.
+"); return; }
+
+ if ($arg eq "queue") { print_msg("
+QUEUE [<trigger number>]
+
+Displays queued files.
+If used without argument uses default trigger.
+You can use '*' as an argument to display all
+queued files.
+
+See also: SELT
+"); return; }
+
+ if ($arg eq "sortt") { print_msg("
+SORTT [<trigger number>]
+
+Sorts queued files according to queue_priority.
+If used without argument uses default trigger.
+
+See also: SELT
+"); return; }
+
+ if ($arg eq "move") { print_msg("
+MOVE [<trigger number>] <from> <to>
+
+Moves files queued in trigger <trigger number> (or default
+trigger) from position <from> to position <to>.
+
+See also: SELT
+"); return; }
+
+ if ($arg eq "distro") { print_msg("
+DISTRO stats
+
+Displays send count for files
+
+See also: SET distro
+"); return; }
+
+ if ($arg eq "set auto_save") { print_msg("
+SET auto_save <seconds>
+
+Every <seconds> seconds saves config, sends and
+queues
+
+See also: SET autosave_on_close
+"); return; }
+
+ if ($arg eq "set autosave_on_close") { print_msg("
+SET autosave_on_close 0|1
+
+When set to 1 sends and queues will be saved in /fs off
+
+See also: SET auto_save
+"); return; }
+
+ if ($arg =~ /^set clr_(dir|file|hi|txt)$/) { print_msg("
+SET clr_dir <color>
+SET clr_file <color>
+SET clr_hi <color>
+SET clr_txt <color>
+
+This settings controll colors in fserve.
+Currently it's a little bit inconsistent.
+You can set <color> using ^C<txt_color>,<bg_color>
+(standart irssi/bitchx colors), for example
+/SET clr_txt ^C12
+to set text color to blue.
+
+Remember to use xy color codes, i.e. don't use
+^C9 but use ^C09. If not displaying files that start
+with a number will be fscked ;)
+"); return; }
+
+ if ($arg eq "set count_send_as_queue") { print_msg("
+SET count_send_as_queue 0|1
+
+If set to 1 sends user have are counted as queues.
+So if user have 1 send and 2 file queued, and
+user_slots is set to 3 the user won't be able
+to queue any more files (because has 2 queues and
+1 send = 3 files). If count_send_as_queue was 0
+the user would be able to queue one more file.
+
+See also: SETT user_slots
+"); return; }
+
+ if ($arg eq "set debug") { print_msg("
+SET debug 0|1
+
+When set to 1 enables diagnostic messages
+"); return; }
+
+ if ($arg eq "set distro" || $arg eq "set distro_file" ) { print_msg("
+SET distro <probability>
+SET distro_file <file_name>
+
+When <probability> is 1 fileserver counts how many times
+each file was sent, and first sends files with lowest send
+count.
+
+In fact, distro setting isn't simply 0/1. It's a PROBABILITY of
+using distro mode for the send. The values should be from range
+[0,1], where 0 means don't use distro mode at all, and 1 means
+allways use distro mode.
+
+For example when it's set to 0.7 it'll use distro mode in 7
+cases of 10 (more or less).
+
+See also: DISTRO
+"); return; }
+
+ if ($arg eq "set idle_time" || $arg eq "set max_time") { print_msg("
+SET idle_time <s1>
+SET max_time <s2>
+
+Controls how much time the user can be connected with
+fserve on dcc chat.
+
+User will be disconnected after either:
+<s1> seconds of inactivity
+<s2> seconds since connecting
+"); return; }
+
+ if ($arg eq "set ignores" || $arg eq "sett ignores") { print_msg("
+SET ignores <mask> <mask2> ...
+SETT ignores <mask> <mask2> ...
+
+Using this settings you can 'ban' users from the fserve.
+Fserve won't respond to !list nor trigger.
+
+The <mask> is in normal nick!ident\@host format,
+you can use '*' and '?'.
+"); return; }
+
+ if ($arg eq "set log_name") { print_msg("
+SET log_name <file>
+
+Logs file transfers to <file>
+
+You can use \$IRSSI and ~ that specify irssi's home
+and your home directory.
+"); return; }
+
+ if ($arg eq "set max_queues" ||
+ $arg =~ /^sett (max_queues|guaranted_queues)$/){ print_msg("
+SET max_queues <val>
+SETT max_queues <val>
+SETT guaranted_queues <val>
+
+Those setting are responsibile for number of queues for
+the trigger and for whole fserve.
+
+Algorithm used to compute number of free/max queues:
+
+Maximum queues :=
+ max( guaranted_queues,
+ min(global max_queues, trigger max_queues) )
+
+Free queues :=
+ max( guaranted_queues - number of trigger queues,
+ min( global max_queues - number of all queues,
+ trigger max_queues - number of queue queues ) )
+
+In short:
+a) the trigger has at least guaranted_queues queues
+b) maximum number of queues is the smallest value of
+ global and trigger max_queues, except for (a)
+
+See also: SET max_sends
+
+TODO: examples of usage
+"); return; }
+
+ if ($arg eq "set max_sends" ||
+ $arg =~ /^sett (max_sends|guaranted_sends)$/){ print_msg("
+SET max_sends <val>
+SETT max_sends <val>
+SETT guaranted_sends <val>
+
+Those setting are responsibile for number of sends for
+the trigger and for the whole fserve.
+
+Algorithm used to compute number of free/max sends:
+
+Maximum sends :=
+ max( guaranted_sends,
+ min(global max_sends, trigger max_sends) )
+
+Free sends :=
+ max( guaranted_sends - number of trigger sends,
+ min( global max_sends - number of all sends,
+ trigger max_sends - number of trigger sends ) )
+
+In short:
+a) the trigger has at least guaranted_sends sends
+b) maximum number of sends is the smallest value of
+ global and trigger max_sends, except for (a)
+
+See also: SET max_queues, SET min_upload
+"); return; }
+
+ if ($arg eq "set max_users") { print_msg("
+SET max_users <number>
+
+Sets how many users can connect to the fserve.
+"); return; }
+
+ if ($arg eq "set min_upload") { print_msg("
+SET min_upload <bps>
+
+Tries to make sure that sum of upload speeds
+of all dcc sends is >= <bps>. If for 4 minutes
+it's no it tries to send next file, even if
+there is already max_sends sends.
+"); return; }
+
+ if ($arg eq "set motd" or $arg eq "set motdfile" or
+ $arg eq "sett motd") { print_msg("
+SET <motd>
+SET <motd_file>
+SETT <motd>
+
+Specifies messages that will be displayed in welcome message
+after user connects to fserve.
+The message can be read from file <motd_file>.
+In <motd_file> you can use \$IRSSI and ~ that specify irssi's
+home and your home directory.
+"); return; }
+
+ if ($arg eq "set offline_message") { print_msg("
+SET offline_message <message>
+
+When fserve is offline and user tries to connect
+to it using ctcp trigger fserve sends notice:
+'Sorry, fserve is currently offline. <message>'
+"); return; }
+
+ if ($arg eq "set queuefile") { print_msg("
+SET queuefile <file>
+
+Saves sends and queues to <file>
+
+You can use \$IRSSI and ~ that specify irssi's
+home and your home directory.
+"); return; }
+
+ if ($arg eq "set recache_interval") { print_msg("
+SET recache_interval <seconds>
+
+Every <seconds> does /fs recache.
+"); return; }
+
+ if ($arg eq "sett channels") { print_msg("
+SETT channels <#channel1> [#channel2 ...]
+
+Space separated list of channels on which this
+trigger will work.
+
+See also: SETT servers
+"); return; }
+
+ if ($arg eq "sett content" or $arg eq "sett note") { print_msg("
+SETT content <content>
+SETT note <note>
+
+Text that can be displayed in fserve ad.
+
+See also: SETT custom_notice
+"); return; }
+
+ if ($arg eq "sett ctcp_only") { print_msg("
+SETT ctcp_only 0|1
+
+If set to 1 fserve will ignore triggers typed
+on channels. It'll only respond to /ctcp.
+
+If set to 0 it will respond to both triggers typed
+on channels and used in /ctcp.
+"); return; }
+
+ if ($arg eq "sett custom_notice" || $arg eq "sett custom_notice_fields") { print_msg("
+SETT custom_notice 0|1
+SETT custom_notice_fields <list of fields>
+
+Controls what will be included in fserver ad.
+If custom_notice is 0 then everything is included.
+If it's 1 then only fields specified in <list of fields>
+will be included.
+If it's 1 and custom_notice_fields is empty then fserve
+doesn't show ad at all (but it still respond to trigger
+etc.)
+
+Possibile fields: trigger, sends, queues, min_cps, online,
+accessed, snagged, record, current_upstream, serving,
+note, content
+
+Example:
+/fs sett custom_notice_fields trigger note content
+"); return; }
+
+ if ($arg eq "sett dont_notify") { print_msg("
+"); return; }
+ if ($arg eq "sett find") { print_msg("
+"); return; }
+ if ($arg eq "sett ignore_msg") { print_msg("
+"); return; }
+ if ($arg eq "sett instant_send") { print_msg("
+"); return; }
+ if ($arg eq "sett max_resends") { print_msg("
+"); return; }
+ if ($arg eq "sett min_cps") { print_msg("
+"); return; }
+ if ($arg eq "sett nice") { print_msg("
+"); return; }
+ if ($arg eq "sett notify_interval") { print_msg("
+"); return; }
+
+ if ($arg eq "sett notify_on_join") { print_msg("
+SETT notify_on_join 0|1
+
+When on, users joining a served channel will
+be sent an fserve notice.
+"); return; }
+
+ if ($arg eq "sett queue_priority") { print_msg("
+"); return; }
+ if ($arg eq "sett request") { print_msg("
+"); return; }
+ if ($arg eq "sett restricted_level") { print_msg("
+"); return; }
+ if ($arg eq "sett root_dir") { print_msg("
+"); return; }
+
+ if ($arg eq "sett servers") { print_msg("
+SETT servers <server_tag> [server_tag_2 ...]
+
+Space separated list of server tags on which this
+trigger will work.
+Please read tutorial on how to add server tags.
+
+See also SETT channels, tutorial
+"); return; }
+
+ if ($arg eq "sett speed_warnings") { print_msg("
+"); return; }
+ if ($arg eq "sett trigger") { print_msg("
+"); return; }
+
+ if ($arg eq "sett user_slots") { print_msg("
+SETT user_slots <number>
+
+Number of file user can queue (sometimes
+files being sent counts as well - see
+SET count_send_as_queue).
+
+See also: SET count_send_as_queue
+"); return; }
+
+ if ($arg eq "tutorial") {
+ print_msg("
+Setting up simple file server.
+
+After loading fserve you need to at least
+- add first trigger with '/fs addt'
+- set up 'root_dir', 'servers' and 'channels'
+ For example:
+ /fs sett root_dir /home/me/fs_root
+ /fs sett servers aniv
+ /fs sett channels #smurfs
+
+The 'aniv' is the name if irc network you'll be using.
+You can add irc networks with '/ircnet add', for example:
+/ircnet add aniv
+and then
+/server add -ircnet aniv irc.aniverse.com
+
+You can now enable the FServe with '/fs on'!
+
+Some other things you should know:
+- you can list global and trigger-specific settings with
+ '/fs set' and '/fs sett'
+- you can add more triggers with '/fs addt' and choose default
+ trigger with '/fs selt <number>'
+- 'servers' and 'channels' can be a list of space separated
+ values, for example '#smurfs #gumibears #wuzzles'
+- '/fs help' has help for all FServe commands and settings
+");
+ return;
+ }
+
+ if ($arg eq "bugs") { print_msg("
+Limitations:
+
+There can be only one send per user on irc server, no matter
+how many trigger there are. Maybe this should be changed to
+1 send/trigger or even be parametrized. Comments welcomme.
+"); return; }
+
+ print_msg("No such help topic: $arg");
+}
+
+##############################################################################
+# Handle an "/fs *" type command
+###############################################################################
+sub sig_fs_command
+{
+ my ($cmd_line, $server, $win_item) = @_;
+ my @args = split(' ', $cmd_line);
+
+ if (@args <= 0 || lc($args[0]) eq 'help') {
+ shift @args;
+ do_help(@args);
+ return;
+ }
+
+ # convert command to lowercase
+ my $cmd = lc(shift(@args));
+
+ if ($cmd eq 'on') {
+ unless ($fs_enabled) {
+ update_files();
+ $timer_tag = Irssi::timeout_add(1000, 'sig_timeout', 0);
+ $fs_enabled = 1;
+ }
+ print_msg("Fileserver online!");
+ } elsif ($cmd eq 'off') {
+ if ($fs_enabled) {
+ $fs_enabled = 0;
+ Irssi::timeout_remove($timer_tag);
+ print_msg("Sends & Queue saved")
+ if ($fs_prefs{autosave_on_close} && (!save_queue()));
+ print_msg("Distro file saved") if ($fs_prefs{distro} and !save_distro());
+ }
+ print_msg("Fileserver offline!");
+ } elsif ($cmd eq 'set' || $cmd eq 'sett') {
+ my $hash;
+ if ($cmd eq 'set') {
+ $hash = \%fs_prefs;
+ } else {
+ $hash = $fs_queues[$default_queue];
+ }
+ if (@args == 0) {
+ my $msg = "[$fs_prefs{clr_hi}FServe Variables$fs_prefs{clr_txt}]";
+ if ($cmd eq 'sett') {
+ $msg .= " for queue $default_queue";
+ }
+ print_msg($msg);
+ foreach (sort(keys %{$hash})) {
+ if (/clr/) {
+ print_msg("$_ $fs_prefs{clr_hi}=$fs_prefs{clr_txt} ".
+ "$hash->{$_}COLOR");
+ } elsif ($cmd eq 'sett' && ($_ eq 'queue' || $_ eq 'cache' ||
+ $_ eq 'sends' || $_ eq 'filecount' || $_ eq 'bytecount')) {
+ next;
+ } else {
+ print_msg("$_ $fs_prefs{clr_hi}=$fs_prefs{clr_txt} ".
+ $hash->{$_});
+ }
+ }
+ print_msg("\003\n$fs_prefs{clr_txt}Ex: /fs set max_users 4");
+ } elsif (@args < 2) {
+ print_msg("Error: usage /fs $cmd <var> <value>");
+ } elsif ($args[0] eq '-clear' && defined $hash->{$args[1]}) {
+ print_msg("Clearing $args[1]");
+ $hash->{$args[1]} = "";
+ if ($args[1] eq 'log_name' && $logfp) {
+ print_log("Closing log.");
+ close($logfp);
+ undef $logfp;
+ }
+ } elsif (defined $hash->{$args[0]}) {
+ my $var = shift(@args);
+ return if ($cmd eq 'sett' && ($var eq 'queue' || $var eq 'cache' ||
+ $var eq 'sends' || $var eq 'filecount' || $var eq 'bytecount'));
+ $hash->{$var} = "@args";
+ if ($var =~ /^clr/) {
+ print_msg("Setting: $var $fs_prefs{clr_hi}=$hash->{$var}COLOR");
+ } else {
+ print_msg("Setting: $var $fs_prefs{clr_hi}=$fs_prefs{clr_txt} ".
+ $hash->{$var});
+ }
+ if ($var eq 'log_name') {
+ if ($logfp) {
+ print_log("Closing log.");
+ close($logfp);
+ undef $logfp;
+ }
+ print_log("Opening log.");
+ } elsif ($var eq 'motdfile') {
+ $motdfile_modified = 0;
+ }
+ } else {
+ print_msg("Error: unknown variable ($args[0])");
+ }
+ } elsif ($cmd eq 'save') {
+ print_msg("Config file saved!") if (!save_config());
+ } elsif ($cmd eq 'load') {
+ print_msg("Config file loaded!") if (!load_config());
+ } elsif ($cmd eq 'saveq') {
+ print_msg("Sends & Queue saved!") if (!save_queue());
+ } elsif ($cmd eq 'loadq') {
+ print_msg("Queue loaded!") if (!load_queue());
+ } elsif ($cmd eq 'who') {
+ display_who('!fserve!');
+ } elsif ($cmd eq 'recache') {
+ update_files();
+ } elsif ($cmd eq 'queue') {
+ if (@args < 1) {
+ display_queue('!fserve!', $default_queue);
+ } elsif ($args[0] eq '*') {
+ foreach (0 .. $#fs_queues) {
+ display_queue('!fserve!', $_);
+ }
+ } elsif ($args[0] > $#fs_queues) {
+ print_msg("Usage /fs queue [<queue>]");
+ } else {
+ display_queue('!fserve!', $args[0]);
+ }
+ } elsif ($cmd eq 'sends') {
+ display_sends('!fserve!');
+ } elsif ($cmd eq 'sortt') {
+ if (@args < 1) {
+ sort_queue($default_queue);
+ } elsif ($args[0] > $#fs_queues) {
+ print_msg("Usage /fs sortt [<queue>]");
+ } else {
+ sort_queue($args[0]);
+ }
+ } elsif ($cmd eq 'stats') {
+ display_stats('!fserve!');
+ foreach (0 .. $#fs_queues) {
+ print_msg("Queue $_: ".scalar(@{$fs_queues[$_]->{queue}}).'/'.
+ $fs_queues[$_]->{max_queues}." files");
+ }
+ } elsif ($cmd eq 'insert') {
+ if (@args < 3 || $args[0] > $#fs_queues) {
+ print_msg("Usage /fs insert <queue> <nick> <file>");
+ return;
+ }
+ my $qn = shift(@args);
+ my $nick_id = shift(@args);
+ srv_queue_file($nick_id, "@args", $qn);
+ } elsif ($cmd eq 'move') {
+ if (@args < 2 || (@args > 2 && $args[0] > $#fs_queues)) {
+ print_msg("Usage /fs move [<queue>] <from> <to>");
+ } elsif (@args == 2) {
+ srv_move_slot($args[0], $args[1], $fs_queues[$default_queue]->{queue});
+ } else {
+ srv_move_slot($args[1], $args[2], $fs_queues[$args[0]]->{queue});
+ }
+ } elsif ($cmd eq 'clear') {
+ if (@args < 1) {
+ print_msg("Usage /fs clear <nick> | /fs clear -all");
+ return;
+ }
+ foreach (0 .. $#fs_queues) {
+ if ($args[0] eq '-all') {
+ my @nullqueue = ();
+ $fs_queues[$_]->{queue} = [ @nullqueue ];
+ } else {
+ clear_queue($args[0], 1, $_);
+ }
+ }
+ } elsif ($cmd eq 'notify') {
+ return unless ($fs_enabled);
+ # TODO /fs notify #channel server
+ # FIXME not working?
+ foreach my $qn (0 .. $#fs_queues) {
+ if (@args == 0) {
+ foreach my $s (split(' ', $fs_queues[$qn]->{servers})) {
+ my $server = Irssi::server_find_tag($s);
+ next if (!$server || !$server->{connected});
+ foreach (split(' ', $fs_queues[$qn]->{channels})) {
+ show_notice($server, $_, $qn);
+ }
+ }
+ } else {
+ foreach my $s (split(' ', $fs_queues[$qn]->{servers})) {
+ my $server = Irssi::server_find_tag($s);
+ next if (!$server || !$server->{connected});
+ foreach (@args) {
+ show_notice($server, $_, $qn)
+ if ($fs_queues[$qn]->{channels} =~ /.*$_.*/i);
+ }
+ }
+ }
+ }
+ } elsif ($cmd eq 'distro') {
+ if ($args[0] eq 'stats') {
+ foreach (sort keys %fs_distro) {
+ foreach my $size (sort keys %{$fs_distro{$_}}) {
+ print_msg("$_ (".$size." B) $fs_distro{$_}{$size}");
+ }
+ }
+ } else {
+ print_msg("Usage: /fs distro stats");
+ }
+ } elsif ($cmd eq 'selt') {
+ if (@args < 1 || $args[0] > $#fs_queues) {
+ print_msg("Usage: /fs selt <queue>");
+ return;
+ }
+ $default_queue = $args[0];
+ print_msg("Selecting trigger: $default_queue");
+ } elsif ($cmd eq 'addt') {
+ print_msg("Adding trigger: ".scalar(@fs_queues));
+ push (@fs_queues, { %fs_queue_defaults });
+ @{$fs_queues[$#fs_queues]->{queue}} = ();
+ } elsif ($cmd eq 'delt') {
+ if (@args < 1 || $args[0] > $#fs_queues) {
+ print_msg("Usage: /fs delt <trigger_no>");
+ return;
+ } elsif (@fs_queues < 2) {
+ print_msg("You cannot remove last trigger!");
+ return;
+ }
+ my $qn = $args[0];
+ if ($fs_queues[$qn]->{sends}) {
+ print_msg('There are on-going sends for this trigger,');
+ print_msg('please stop them first before removing the trigger.');
+ print_msg('(If you think fserve.pl should act differently');
+ print_msg('in this case please drop me a mail. Thanks)');
+ return;
+ }
+ splice (@fs_queues, $qn, 1);
+ foreach (@fs_sends) {
+ if ($_->{queue} > $qn) {
+ $_->{queue}--;
+ }
+ }
+ foreach ($qn .. $#fs_queues) {
+ foreach my $q (@{$fs_queues[$_]->{queue}}) {
+ $q->{queue}--;
+ }
+ }
+ if ($default_queue >= $qn) {
+ $default_queue--;
+ }
+ print_msg("Trigger $qn deleted");
+ } else {
+ print_msg("Unrecognized command /fs $cmd");
+ }
+}
+
+###############################################################################
+###############################################################################
+##
+## Script subroutines
+##
+###############################################################################
+###############################################################################
+
+###############################################################################
+# initiate_dcc_chat($server, $nick, $qn): inits a dcc chat & sets some
+# variables for $nick
+###############################################################################
+sub initiate_dcc_chat
+{
+ my ($server, $nick, $qn) = @_;
+
+ print_debug("Initiating DCC CHAT to $nick for queue $qn");
+
+ my %nickinfo = ();
+ $nickinfo{status} = -1;
+ $nickinfo{time} = 0;
+ $nickinfo{ignore} = 0;
+ $nickinfo{dir} = '/';
+ $nickinfo{queue} = $qn;
+ $nickinfo{server} = $server->{tag};
+
+ $fs_users{$nick."@".$server->{tag}} = { %nickinfo };
+ $server->command("DCC CHAT $nick");
+}
+
+###############################################################################
+# show_notice($server, $dest, $qn): displays server notice to $dest
+# ($dest = #channel or nick)
+###############################################################################
+sub show_notice
+{
+ my ($server, $dest, $qn) = @_;
+ my $queue = $fs_queues[$qn];
+
+ foreach ($fs_queues[$qn]{dont_notify}) {
+ return if ($_ eq $dest);
+ }
+
+ my $msg = "\002(\002FServe Online\002)\002";
+
+ my @fields_list = ("trigger", "sends", "queues", "min_cps", "online",
+ "accessed", "snagged", "record", "current_upstream", "serving",
+ "note", "content");
+
+ if ($queue->{custom_notice}) {
+ return if (!$queue->{custom_notice_fields}); # Don't send the ad
+ @fields_list = split(' ', $queue->{custom_notice_fields});
+ }
+
+ foreach (@fields_list) {
+ /trigger/ && do {
+ $msg .= " Trigger:(/ctcp $$server{nick} $queue->{trigger})";
+ next;
+ };
+ /sends/ && do {
+ my ($curr_sends, $free_sends, $max_sends) = get_max_sends($qn);
+ $msg .= " Sends:(".($max_sends-$free_sends)."/$max_sends)";
+ next;
+ };
+ /queues/ && do {
+ my ($curr_queues, $free_queues, $max_queues) = get_max_queues($qn);
+ $msg .= " Queues:(".($max_queues-$free_queues)."/$max_queues)";
+ next;
+ };
+ /min_cps/ && do {
+ if ($queue->{min_cps}) {
+ $msg .= ' Min CPS:('.size_to_str($queue->{min_cps}).'/s)';
+ }
+ next;
+ };
+ /online/ && do {
+ $msg .= ' Online:('.(keys %fs_users)."/$fs_prefs{max_users})";
+ next;
+ };
+ /accessed/ && do {
+ $msg .= " Accessed:($fs_stats{login_count} times)";
+ next;
+ };
+ /snagged/ && do {
+ $msg .= ' Snagged:('.size_to_str($fs_stats{transfd}).' in '.
+ ($fs_stats{sends_ok}+$fs_stats{sends_fail}).' files)';
+ next;
+ };
+ /record/ && do {
+ if ($fs_stats{record_cps}) {
+ $msg .= ' Record CPS:('.size_to_str($fs_stats{record_cps}).
+ '/s by '.$fs_stats{rcps_nick}.')';
+ }
+ next;
+ };
+ /current_upstream/ && do {
+ my $curr_ups = 0;
+ foreach my $dcc (Irssi::Irc::dccs()) {
+ if ($dcc->{type} eq 'SEND') {
+ $curr_ups += ($dcc->{transfd}-$dcc->{skipped})/
+ (time() - $dcc->{starttime} + 1);
+ }
+ }
+ $msg .= ' Current Upstream:('.size_to_str($curr_ups).'/s)';
+ next;
+ };
+ /serving/ && do {
+ $msg .= ' Serving:('.size_to_str($queue->{bytecount}).' in '.
+ "$queue->{filecount} files)";
+ next;
+ };
+ /note/ && do {
+ if (length($queue->{note})) {
+ $msg .= " Note:($fs_prefs{clr_hi}$queue->{note}$fs_prefs{clr_txt})";
+ }
+ next;
+ };
+ /content/ && do {
+ if (length($queue->{content})) {
+ $msg .= " On FServe:($fs_prefs{clr_hi}$queue->{content}$fs_prefs{clr_txt})";
+ }
+ next;
+ };
+ print_debug("Unknown notice field: $_");
+ }
+
+ $msg =~ s/\(/\($fs_prefs{clr_hi}/g;
+ $msg =~ s/\)/$fs_prefs{clr_txt}\)/g;
+
+ $msg .= " [FServe.pl $VERSION]";
+
+ if ($dest =~ /^#/) {
+ $server->command("MSG $dest $fs_prefs{clr_txt}$msg");
+ } else {
+ $server->command("^NOTICE $dest $fs_prefs{clr_txt}$msg");
+ print_what_we_did("NOTICE $dest $fs_prefs{clr_txt}$msg");
+ }
+}
+
+###############################################################################
+# show_find($server, $who, $file, $qn): displays @find notice to $who
+###############################################################################
+sub show_find
+{
+ my ($server, $who, $file, $qn) = @_;
+
+ $file =~ s/^\@find //i;
+ $file = "\Q$file\E";
+ $file =~ s/([\\]?[* ])+/.*/g;
+
+ print_debug("requested find patter '$file' in queue $qn");
+ # prepare list
+ my @founds = ();
+ foreach my $dir (keys %{$fs_queues[$qn]->{cache}}) {
+ my $files = $fs_queues[$qn]->{cache}{$dir}{files};
+ my $sizes = $fs_queues[$qn]->{cache}{$dir}{sizes};
+
+ $dir =~ s/$/\//;
+ $dir =~ s/^\/+//;
+ foreach my $i (0 .. $#{$files}) {
+ $_ = ${$files}[$i];
+# print_debug("Checking against '$_'");
+ if (/$file/i) { # hmm.. check Sysreset response...
+# print_debug("This file matches!");
+ push (@founds, (scalar(@founds)+1).". File: (".
+ $fs_prefs{clr_dir}.$dir.$_.$fs_prefs{clr_txt}.") Size:(".
+ size_to_str(${$sizes}[$i]).")");
+ }
+ }
+ }
+
+ if (!@founds) {
+ return;
+ }
+
+ my ($curr_sends, $free_sends, $max_sends) = get_max_sends($qn);
+ my ($curr_queues, $free_queues, $max_queues) = get_max_queues($qn);
+
+ my $message = "(\@Find Results) - [FServe.pl $VERSION]";
+ $server->command("^MSG $who $message");
+ print_what_we_did("MSG $who $message");
+ $message = "Found ".@founds." file(s) on trigger:(".$fs_prefs{clr_hi}.
+ "/ctcp $server->{nick} $fs_queues[$qn]->{trigger}".$fs_prefs{clr_txt}.
+ ") Sends:(".($max_sends-$free_sends)."/$max_sends)".
+ " Queues:(".($max_queues-$free_queues)."/$max_queues)";
+ $server->command("^MSG $who $message");
+ print_what_we_did("MSG $who $message");
+
+ foreach (0 .. $#founds) {
+ last if ($_ >= $fs_queues[$qn]->{find});
+ $server->command("^MSG $who $founds[$_]");
+ print_what_we_did("MSG $who $founds[$_]");
+ }
+ if (@founds > $fs_queues[$qn]->{find}) {
+ $server->command("^MSG $who Too many results to display!");
+ print_what_we_did("MSG $who Too many results to display!");
+ } else {
+ $server->command("^MSG $who End of \@Find.");
+ print_what_we_did("MSG $who End of \@Find.");
+ }
+}
+
+###############################################################################
+# change_dir($nick, $dir): changes directory for $nick
+###############################################################################
+sub change_dir
+{
+ my ($nick, $dir) = @_;
+ my ($irc_nick, $server_tag) = split('@', $nick);
+ my $qn = $fs_users{$nick}{queue};
+
+ $dir =~ s/\x03//g; # remove colors if any
+ my @dir_fields = ();
+ unless (substr($dir, 0, 1) eq '/') {
+ @dir_fields = split('/', $fs_users{$nick}{dir});
+ }
+
+ foreach (split('/', $dir)) {
+ next if ($_ eq '.');
+ if ($_ eq '..') {
+ pop(@dir_fields);
+ } else {
+ push(@dir_fields, $_);
+ }
+ }
+
+ my $new_dir = '/'.join('/', @dir_fields);
+ $new_dir =~ s/\/+/\//g; # remove excessive '/'
+
+ if (defined $fs_queues[$qn]->{cache}{$new_dir}) {
+ $fs_users{$nick}{dir} = $new_dir;
+ send_user_msg($server_tag, $irc_nick,
+ "[$fs_prefs{clr_hi}$new_dir$fs_prefs{clr_txt}]");
+ } else {
+ send_user_msg($server_tag, $irc_nick,
+ "[$fs_prefs{clr_hi}$new_dir$fs_prefs{clr_txt}] doesn't exist!");
+ }
+}
+
+###############################################################################
+# list_dir($nick): list contents of current directory for $nick
+###############################################################################
+sub list_dir
+{
+ my ($nick) = @_;
+ my ($irc_nick, $server_tag) = split('@', $nick);
+ my $qn = $fs_users{$nick}{queue};
+ my $dir = $fs_queues[$qn]->{cache}{$fs_users{$nick}{dir}};
+ my @filelist = ();
+
+ $_ = $fs_users{$nick}{dir};
+ s/\/+$//;
+ send_user_msg($server_tag, $irc_nick,
+ "Listing [$fs_prefs{clr_hi}$_/*.*$fs_prefs{clr_txt}]");
+
+ # print the directories sorted
+ send_user_msg($server_tag, $irc_nick, $fs_prefs{clr_dir}."..")
+ if ($fs_users{$nick}{dir} ne "/");
+ send_user_msg($server_tag, $irc_nick,
+ $fs_prefs{clr_dir}.$_.$fs_prefs{clr_txt}.'/')
+ foreach (sort(@{${$dir}{dirs}}));
+
+ # prepare filelist
+ foreach (0 .. $#{${$dir}{files}}) {
+ push(@filelist, ${$dir}{files}[$_]." ".
+ size_to_str(${$dir}{sizes}[$_]));
+ }
+
+ # print the files sorted
+ send_user_msg($server_tag, $irc_nick, $fs_prefs{clr_file}.$_)
+ foreach(sort(@filelist));
+ send_user_msg($server_tag, $irc_nick,
+ "End [$fs_prefs{clr_hi}$fs_users{$nick}{dir}$fs_prefs{clr_txt}]");
+}
+
+###############################################################################
+# srv_queue_file($nick_id, $file, $qn): queues to queue $qn file for $nick_id,
+# server use only
+# (no max_queue and/or duplicate check)
+###############################################################################
+sub srv_queue_file
+{
+ my ($nick_id, $path, $qn) = @_;
+ my ($nick, $server_tag) = split('@', $nick_id);
+ $path =~ s/~/$ENV{"HOME"}/;
+
+ unless (-e $path || -f $path) {
+ print_msg("Invalid file: '$path'");
+ return;
+ }
+
+ my $size = (stat($path))[7];
+ $path =~ /(.*)\/(.*)/;
+ $path = $1;
+ my $file = $2;
+
+ push(@{$fs_queues[$qn]->{queue}}, { queue => $qn, nick => $nick,
+ file => $file, size => $size,
+ dir => $path, resends => 0, warns => 0, server_tag => $server_tag });
+
+ print_msg($fs_prefs{clr_hi}.'#'.@{$fs_queues[$qn]->{queue}}.
+ $fs_prefs{clr_txt}.": Queuing '$fs_prefs{clr_hi}$file".
+ "$fs_prefs{clr_txt}' for $fs_prefs{clr_hi}$nick".
+ "$fs_prefs{clr_txt} ($server_tag) in queue ".
+ "$fs_prefs{clr_hi}$qn$fs_prefs{clr_txt}!");
+}
+
+###############################################################################
+# srv_move_slot($slot, $dest, [ @queue ]): moves queue slots around
+###############################################################################
+sub srv_move_slot
+{
+ my ($slot, $dest, $fsq) = @_;
+
+ $slot--;
+ $dest--;
+
+ unless (defined ${$fsq}[$slot] || defined ${$fsq}[$dest]) {
+ print_msg("Error: Invalid slot numbers!");
+ return;
+ }
+ print_debug("srv_move_slot: Will move $slot to $dest");
+
+ my %rec = %{${$fsq}[$slot]};
+ splice(@{$fsq}, $slot, 1);
+ splice(@{$fsq}, $dest, 0, { %rec });
+
+ print_msg("Moved slot $fs_prefs{clr_hi}#".($slot+1).$fs_prefs{clr_txt}.
+ " to $fs_prefs{clr_hi}#".($dest+1));
+}
+
+###############################################################################
+# get_user_flag($server, $nick,$qn): returns highest user flag
+# (normal/voice/halfop/op) among all channels from fs_queues[$qn]->{channels}
+###############################################################################
+sub get_user_flag {
+ my ($server,$nick,$qn) = @_;
+
+ my $bestflag = "normal";
+ foreach my $channelName (split(' ', $fs_queues[$qn]->{channels})) {
+ my $channel = $server->channel_find($channelName);
+ next if !$channel;
+ my $n = $channel->nick_find($nick);
+ next if !$n;
+ if ($n->{op}) {
+ return "op";
+ } elsif ($n->{halfop}) {
+ $bestflag = "halfop";
+ } elsif ($n->{voice} and $bestflag ne "halfop") {
+ $bestflag = "voice";
+ }
+ # max 4 categories - see sort_queue() also
+ }
+ return $bestflag;
+}
+
+###############################################################################
+# sort_queue($qn): sorts queue according to queue_priority
+# returns where was moved last position
+###############################################################################
+ # queue_priority format:
+ # group1 group2 ... groupN
+ # where groupX is one of: others, normal, voice, halfop, op
+ # for example:
+ # normal voice others
+ # means that first in queue are "normal" people, then people who are +v,
+ # and then the rest - ops and halfops
+ #
+ # When some server is disconnected then all people on this server are
+ # sorted last in the queue.
+sub sort_queue {
+ my ($qn) = @_;
+
+ print_debug ("sort_queue: $qn");
+ return ($#{$fs_queues[$qn]->{queue}})
+ if (!$fs_queues[$qn]->{queue_priority});
+
+ my %prio;
+ my $n = 1; # highest priority is 0 - resended queue
+ foreach (split (/ +/, $fs_queues[$qn]->{queue_priority})) {
+ if (/others/) {
+ foreach my $type ("normal", "voice", "halfop", "op") {
+ if (not exists $prio{$type}) {
+ $prio{$type} = $n;
+ }
+ }
+ } else {
+ $prio{$_} = $n;
+ }
+ $n++;
+ }
+ # in case there is no 'others' in queue_priority we assume it's last
+ foreach my $type ("normal", "voice", "halfop", "op") {
+ if (not exists $prio{$type}) {
+ $prio{$type} = $n;
+ }
+ }
+ my $max_prio = $n;
+
+ my @uprio = (0, 0, 0, 0, 0); # assume max 4 categories + resends :)
+ my $fsq = $fs_queues[$qn]->{queue};
+ my $dmsg = 'Sorting...';
+ # now do sorting
+ foreach (0 .. $#{$fsq}) {
+ if (${$fsq}[$_]->{resends}) {
+ $n = 0;
+ } else {
+ my $server = Irssi::server_find_tag(${$fsq}[$_]->{server_tag});
+ if (!$server || !$server->{connected}) {
+ $n = $max_prio;
+ } else {
+ $n = $prio{get_user_flag($server, ${$fsq}[$_]->{nick}, $qn)};
+ }
+ }
+
+ # re-sort these positions 0 .. $_
+ splice(@{$fsq}, $uprio[$n], 0, splice(@{$fsq}, $_, 1))
+ if ($uprio[$n] != $_);
+
+ $dmsg .= " $_:$uprio[$n]";
+ # update @uprio
+ $uprio[$_]++ foreach ($n .. $#uprio);
+ }
+ print_debug($dmsg);
+
+ # $n now has prio for last moved position
+ return $uprio[$n]-1;
+}
+
+###############################################################################
+# queue_file($nick, $file): queues $file for $nick.
+###############################################################################
+sub queue_file
+{
+ my ($nick, $ufile) = @_;
+ $ufile =~ s/\s+$//;
+ my $qn = $fs_users{$nick}{queue};
+ my ($file, $size);
+ my ($irc_nick, $server_tag) = split('@', $nick);
+
+ print_debug("queue_file: '$ufile' for $nick in queue $qn");
+ # try to find the filename in cache
+ my $files = $fs_queues[$qn]->{cache}{$fs_users{$nick}{dir}}{files};
+ my $sizes = $fs_queues[$qn]->{cache}{$fs_users{$nick}{dir}}{sizes};
+
+ my $fsq = $fs_queues[$qn]->{queue};
+
+ foreach (0 .. $#{$files}) {
+ if (uc(${$files}[$_]) eq uc($ufile)) {
+ $file = ${$files}[$_];
+ $size = ${$sizes}[$_];
+ last;
+ }
+ }
+
+ unless (defined $file) {
+ send_user_msg($server_tag, $irc_nick,
+ "Invalid filename: '$fs_prefs{clr_hi}$ufile$fs_prefs{clr_txt}'!");
+ return;
+ }
+
+ my $server = Irssi::server_find_tag($server_tag);
+ if (!$server || !$server->{connected}) {
+ print_msg("Error: this should never happen!!! #002");
+ return;
+ }
+
+ if ($size <= $fs_queues[$qn]{instant_send}) {
+ my $sfile = $fs_queues[$qn]->{root_dir}.$fs_users{$nick}{dir}.'/'.$file;
+ $sfile =~ s/\/+/\//g;
+ if (-e $sfile && -f $sfile) {
+ send_user_msg($server_tag, $irc_nick,
+ "Sending '$fs_prefs{clr_hi}$file$fs_prefs{clr_txt}'");
+ $sfile =~ s/'/\\'/g;
+ $server->command("DCC SEND $irc_nick $FD$sfile$FD");
+ return;
+ }
+ }
+
+ my ($curr_queues, $free_queues, $max_queues) = get_max_queues($qn);
+ my ($curr_sends, $free_sends, $max_sends) = get_max_sends($qn);
+
+ if (count_user_files($server_tag, $irc_nick, $qn) >=
+ $fs_queues[$qn]->{user_slots}) {
+ send_user_msg($server_tag, $irc_nick,
+ "No sends are available and you have ".
+ "used all your queue slots ($fs_prefs{clr_hi}".
+ "$fs_queues[$qn]->{user_slots}$fs_prefs{clr_txt})");
+ return;
+ } elsif ($free_queues <= 0) {
+ send_user_msg($server_tag, $irc_nick,
+ "No send or queue slots are available!");
+ return;
+ } else {
+ foreach (0 .. $#{$fsq}) {
+ if (${$fsq}[$_]->{nick} eq $irc_nick &&
+ ${$fsq}[$_]->{file} eq $file &&
+ ${$fsq}[$_]->{server_tag} eq $server_tag) {
+ send_user_msg($server_tag, $irc_nick,
+ "You have already queued '".
+ "$fs_prefs{clr_hi}$file$fs_prefs{clr_txt}'".
+ " in slot #$fs_prefs{clr_hi}".($_+1).
+ "$fs_prefs{clr_txt}!");
+ return;
+ }
+ }
+ }
+
+ push(@{$fsq}, { queue => $qn, nick => $irc_nick, file => $file,
+ size => $size, dir => $fs_queues[$qn]->{root_dir}.$fs_users{$nick}{dir},
+ resends => 0, warns => 0, server_tag => $server_tag });
+
+ my $place = sort_queue($qn);
+ print_debug("queue_file: queued on place $place");
+
+ send_user_msg($server_tag, $irc_nick,
+ "Queued '$fs_prefs{clr_hi}$file$fs_prefs{clr_txt}".
+ "' (".$fs_prefs{clr_hi}.size_to_str($size).
+ $fs_prefs{clr_txt}.") in slot ".$fs_prefs{clr_hi}.'#'.
+ ($place+1) .$fs_prefs{clr_txt});
+}
+
+###############################################################################
+# dequeue_file($nick, $slot): dequeues file in slot $slot for $nick
+###############################################################################
+sub dequeue_file
+{
+ my ($nick, $slot) = @_;
+ my ($irc_nick, $server_tag) = split('@', $nick);
+ my $fsq = $fs_queues[$fs_users{$nick}{queue}]->{queue};
+
+ $slot -= 1;
+ if (defined ${$fsq}[$slot]) {
+ if (${$fsq}[$slot]->{nick} eq $irc_nick &&
+ ${$fsq}[$slot]->{server_tag} eq $server_tag) {
+ my $filename = ${$fsq}[$slot]{file};
+ splice(@{$fsq}, $slot, 1);
+ send_user_msg($server_tag, $irc_nick, "Removing '$fs_prefs{clr_hi}".
+ "$filename$fs_prefs{clr_txt}', you now have $fs_prefs{clr_hi}".
+ count_queued_files($server_tag, $irc_nick,$fs_users{$nick}{queue}).
+ "$fs_prefs{clr_txt} file(s) queued!");
+ } else {
+ send_user_msg($server_tag, $irc_nick,
+ "You can't dequeue other peoples files!!!");
+ }
+ } else {
+ send_user_msg($server_tag, $irc_nick,
+ "Queue slot $fs_prefs{clr_hi}#".($slot+1).
+ $fs_prefs{clr_txt}." doesn't exist!");
+ }
+}
+
+###############################################################################
+# clear_queue($nick, $is_server, $qn): clears all queued files for $nick
+###############################################################################
+sub clear_queue
+{
+ my ($nick, $is_server, $qn) = @_;
+ my ($irc_nick, $server_tag) = split('@', $nick);
+ my $fsq = $fs_queues[$qn]->{queue};
+ my $count = 0;
+
+ if (count_queued_files($server_tag, $irc_nick, $qn) == 0) {
+ if ($is_server) {
+ print_msg("$fs_prefs{clr_hi}$nick$fs_prefs{clr_txt} doesn't ".
+ "have any files queued!");
+ } else {
+ send_user_msg($server_tag, $irc_nick, "You don't have any queued files!");
+ }
+ } else {
+ for (my $i = $#{$fsq}; $i >= 0; $i--) {
+ if (${$fsq}[$i]->{nick} eq $irc_nick &&
+ ${$fsq}[$i]->{server_tag} eq $server_tag) {
+ splice(@{$fsq}, $i, 1);
+ $count++;
+ }
+ }
+
+ $irc_nick = '!fserve!' if ($is_server);
+ send_user_msg($server_tag, $irc_nick,
+ "Successfully dequeued $fs_prefs{clr_hi}".
+ "$count$fs_prefs{clr_txt} file(s)!");
+ }
+}
+
+###############################################################################
+# display_queue($nick, $qn): displays queue to $nick
+###############################################################################
+sub display_queue
+{
+ my ($nick, $qn) = @_;
+ my ($irc_nick, $server_tag) = split('@', $nick);
+ my $queue = $fs_queues[$qn];
+ my $fsq = $queue->{queue};
+ my $m_server = (split(' ', $queue->{servers}) > 1);
+
+ my ($curr_queues, $free_queues, $max_queues) = get_max_queues($qn);
+ if ($nick eq '!fserve!') {
+ send_user_msg($server_tag, $irc_nick,
+ "$curr_queues/$free_queues/$max_queues Current/Free/Max queues ".
+ "for trigger #".$qn.":");
+ } else {
+ send_user_msg($server_tag, $irc_nick,
+ $fs_prefs{clr_hi}.$curr_queues.$fs_prefs{clr_txt}."/".
+ $fs_prefs{clr_hi}.$max_queues.$fs_prefs{clr_txt}.
+ " file(s) queued for this trigger. ".$fs_prefs{clr_hi}.
+ $free_queues.$fs_prefs{clr_txt}." free slot(s) left.");
+ }
+
+ foreach (0 .. $#{$fsq}) {
+ my $msg = " $fs_prefs{clr_hi}#".($_+1)."$fs_prefs{clr_txt}".
+ ": $fs_prefs{clr_hi}${$fsq}[$_]->{nick}$fs_prefs{clr_txt}".
+ ($m_server?" (${$fsq}[$_]->{server_tag})":"").
+ " queued $fs_prefs{clr_hi}${$fsq}[$_]->{file}$fs_prefs{clr_txt}".
+ " (".$fs_prefs{clr_hi}.size_to_str(${$fsq}[$_]->{size}).
+ $fs_prefs{clr_txt}.")";
+ if (${$fsq}[$_]->{resends}) {
+ $msg .= " (Resend #".${$fsq}[$_]->{resends}.")";
+ }
+ send_user_msg($server_tag, $irc_nick, $msg);
+ }
+}
+
+###############################################################################
+# display_who($user_id): shows users connected to $user_id
+###############################################################################
+sub display_who
+{
+ my ($user_id) = @_;
+ my ($nick, $server_tag) = split('@', $user_id);
+
+ send_user_msg($server_tag, $nick, $fs_prefs{clr_hi}.keys(%fs_users).
+ $fs_prefs{clr_txt}.' user(s) online!');
+
+ foreach (keys(%fs_users)) {
+ my ($n, $s_tag) = split('@', $_);
+ if ($fs_users{$_}{status} == -1) {
+ send_user_msg($server_tag, $nick,
+ " $fs_prefs{clr_hi}$n$fs_prefs{clr_txt} ($s_tag):".
+ " connecting...");
+ } else {
+ send_user_msg($server_tag, $nick,
+ " $fs_prefs{clr_hi}$n$fs_prefs{clr_txt} ($s_tag):".
+ " online $fs_prefs{clr_hi}$fs_users{$_}{time}s".
+ "$fs_prefs{clr_txt} idle: $fs_prefs{clr_hi}".
+ "$fs_users{$_}{status}s");
+ }
+ }
+}
+
+###############################################################################
+# display_sends($nick): shows active sends to $nick
+###############################################################################
+sub display_sends
+{
+ my ($nick) = @_;
+ my ($irc_nick, $server_tag) = split('@', $nick);
+ my $guaranted_sends;
+ my $qtext = "";
+ my $qn = -1;
+
+ if (defined $fs_users{$nick}) {
+ $qn = $fs_users{$nick}{queue};
+ }
+
+
+ if ($qn != -1) { # user - show only this queue sends
+ my ($curr_sends, $free_sends, $max_sends) = get_max_sends($qn);
+ send_user_msg($server_tag, $irc_nick,
+ "Sending $fs_prefs{clr_hi}".$curr_sends.'/'.
+ $max_sends.$fs_prefs{clr_txt}." file(s) for this trigger. ".
+ $fs_prefs{clr_hi}.$free_sends.$fs_prefs{clr_txt}." free sends left.");
+ } else { # me - show all sends
+ send_user_msg($server_tag, $irc_nick,
+ "Sending $fs_prefs{clr_hi}".@fs_sends.'/'.
+ $fs_prefs{max_sends}.$fs_prefs{clr_txt}." file(s)!");
+ }
+
+ foreach my $dcc (Irssi::Irc::dccs()) {
+ next if ($dcc->{type} ne 'SEND');
+
+ foreach (0 .. $#fs_sends) {
+ next if ($dcc->{nick} ne $fs_sends[$_]{nick} ||
+ $dcc->{arg} ne $fs_sends[$_]{file} ||
+ $dcc->{servertag} ne $fs_sends[$_]{server_tag});
+
+ if ($qn < 0) {
+ $qtext = " for queue #".$fs_sends[$_]->{queue};
+ } else {
+ last if ($fs_sends[$_]->{queue} != $qn);
+ }
+
+ if ($dcc->{starttime} == 0 ||
+ ($dcc->{transfd}-$dcc->{skipped}) == 0) {
+ send_user_msg($server_tag, $irc_nick,
+ " $fs_prefs{clr_hi}#".($_+1).
+ "$fs_prefs{clr_txt}: Waiting for ".
+ $fs_prefs{clr_hi}.$dcc->{nick}.$fs_prefs{clr_txt}.
+ " ($dcc->{servertag}) to accept $fs_prefs{clr_hi}".
+ "$dcc->{arg}".
+ $fs_prefs{clr_txt}." (".$fs_prefs{clr_hi}.
+ size_to_str($fs_sends[$_]->{size}).
+ $fs_prefs{clr_txt}.")".$qtext);
+ last;
+ }
+
+ my $perc = sprintf("%.1f%%", ($dcc->{transfd}/$dcc->{size})*100);
+ my $speed = ($dcc->{transfd}-$dcc->{skipped})/(time() - $dcc->{starttime} + 1);
+ my $left = ($dcc->{size} - $dcc->{transfd}) / $speed;
+ send_user_msg($server_tag, $irc_nick,
+ " $fs_prefs{clr_hi}#".($_+1)."$fs_prefs{clr_txt}:".
+ " $fs_prefs{clr_hi}$dcc->{nick}$fs_prefs{clr_txt} ".
+ "($dcc->{servertag}) has ".
+ $fs_prefs{clr_hi}.$perc.$fs_prefs{clr_txt}.
+ " of '$fs_prefs{clr_hi}$dcc->{arg}$fs_prefs{clr_txt}'".
+ " at ".$fs_prefs{clr_hi}.size_to_str($speed)."/s".
+ $fs_prefs{clr_txt}." (".$fs_prefs{clr_hi}.
+ time_to_str($left).$fs_prefs{clr_txt}." left)".
+ $qtext);
+ last;
+ }
+ }
+
+}
+
+###############################################################################
+# display_stats($nick): displays server statistics to $nick
+###############################################################################
+sub display_stats
+{
+ my ($nick) = @_;
+ my ($irc_nick, $server_tag) = split('@', $nick);
+
+ send_user_msg($server_tag, $irc_nick, "-=[ Server Statistics ]=-");
+ send_user_msg($server_tag, $irc_nick, " Online for ".$fs_prefs{clr_hi}.time_to_str($online_time));
+ send_user_msg($server_tag, $irc_nick, " Access Count: ".$fs_prefs{clr_hi}.$fs_stats{login_count});
+ send_user_msg($server_tag, $irc_nick, " ");
+ send_user_msg($server_tag, $irc_nick, " Successful Sends: ".$fs_prefs{clr_hi}.$fs_stats{sends_ok});
+ send_user_msg($server_tag, $irc_nick, " Bytes Transferred: ".$fs_prefs{clr_hi}.size_to_str($fs_stats{transfd}));
+ send_user_msg($server_tag, $irc_nick, " Failed Sends: ".$fs_prefs{clr_hi}.$fs_stats{sends_fail});
+ send_user_msg($server_tag, $irc_nick, " Record CPS: ".$fs_prefs{clr_hi}.size_to_str($fs_stats{record_cps})."/s");
+}
+
+###############################################################################
+## Shows a small file to the user
+###############################################################################
+sub display_file ($$) {
+ my ($nick, $ufile) = @_;
+ my ($irc_nick, $server_tag) = split('@', $nick);
+ my $queue = $fs_queues[$fs_users{$nick}{queue}];
+ my ($file, $size, $dir, $filepath);
+
+ # try to find the filename in cache
+ my $files = $queue->{cache}{$fs_users{$nick}{dir}}{files};
+ my $sizes = $queue->{cache}{$fs_users{$nick}{dir}}{sizes};
+
+ foreach (0 .. $#{$files}) {
+ if (uc(${$files}[$_]) eq uc($ufile)) {
+ $file = ${$files}[$_];
+ $size = ${$sizes}[$_];
+ last;
+ }
+ }
+
+ $dir = $queue->{root_dir} . $fs_users{$nick}{dir};
+ $filepath = "$dir" . "/" . "$ufile";
+
+ unless (defined $file) {
+ send_user_msg($server_tag, $irc_nick, "Invalid filename: " .
+ "'$fs_prefs{clr_hi}$ufile$fs_prefs{clr_txt}'!");
+ return;
+ }
+
+ if ($size > 30000) {
+ send_user_msg($server_tag, $irc_nick, "File too large: " .
+ "'$fs_prefs{clr_hi}$ufile$fs_prefs{clr_txt}'!");
+ return;
+ }
+
+ unless (open (RFILE, "<", $filepath)) {
+ send_user_msg($server_tag, $irc_nick, "Couldn't open file: " .
+ "'$fs_prefs{clr_hi}$ufile$fs_prefs{clr_txt}'!");
+ print_msg("Could not open file $filepath");
+ return;
+ }
+
+ while (my $line = <RFILE>) {
+ chomp $line;
+ send_user_msg($server_tag, $irc_nick, $line);
+ }
+
+ unless (close (RFILE)) {
+ print_debug("Couldn't close file: $filepath");
+ return;
+ }
+
+ return 1;
+}
+
+###############################################################################
+# send_next_file(): send a file from not forced queues
+###############################################################################
+sub send_next_file
+{
+ my ($ignore_free_sends) = @_;
+
+ # first step: reorder queues
+ my @que_numb = (0 .. $#fs_queues);
+ splice (@que_numb, 0, 0, (splice(@que_numb, $next_queue)));
+
+ # First use queues with lowest 'nice', then queues with least sends.
+ my @min_queue = sort {
+ $fs_queues[$a]->{nice} <=> $fs_queues[$b]->{nice} or
+ $fs_queues[$a]->{sends} <=> $fs_queues[$b]->{sends}
+ } @que_numb;
+
+ # step 2b: select a queue
+ foreach my $i (@min_queue) {
+ my $free_sends = (get_max_sends($i))[1];
+ next if ($free_sends == 0 and !$ignore_free_sends);
+
+
+ if (!run_queue($fs_queues[$i])) {
+ $next_queue++;
+ $next_queue = 0 if ($next_queue >= scalar(@fs_queues));
+ print_debug("send_next_file(): next queue will be $next_queue");
+ return 0;
+ }
+ }
+ return 1;
+}
+
+###############################################################################
+# run_queue($queue): try to send the next file in $queue
+###############################################################################
+sub run_queue
+{
+ my ($queue) = @_;
+ my %entry = ();
+ my ($next, $nextcount, $nextfile) = (-1);
+
+ # step through the queue
+ for (my $i = 0; $i < @{$queue->{queue}}; ) {
+ %entry = %{ ${$queue->{queue}}[$i] };
+ my $server = Irssi::server_find_tag($entry{server_tag});
+ if (!$server || !$server->{connected}) {
+ $i++;
+ next;
+ }
+
+ my $in_channel = user_in_channel($server, $entry{nick}, $queue);
+ my $send_active = send_active_for($entry{server_tag}, $entry{nick});
+ my $file = $entry{dir}.'/'.$entry{file};
+ $file =~ s/\/+/\//g;
+
+ # rand() returns [0,1) so if distro is == 0 this is always false,
+ # and if distro == 1 this is allways true
+ my $use_distro = (rand() < $fs_prefs{distro}) ? 1 : 0;
+
+ # send file if user in channel and has no sends active
+ if (!$send_active && $in_channel && -e $file && -f $file) {
+ if (!$use_distro) {
+ $next = $i;
+ $nextfile = $file;
+ last;
+ }
+ my $count = $fs_distro{$entry{file}}{$entry{size}};
+ if ($next < 0 or $nextcount > $count) {
+ $next = $i;
+ $nextcount = $count;
+ $nextfile = $file;
+ }
+ $i++;
+ next;
+ }
+
+ # remove entry if user wasn't in channel of file didn't exist
+ if (!$send_active) {
+ Irssi::print("User $fs_prefs{clr_hi}$entry{nick} ".
+ "$fs_prefs{clr_txt} not in channel or file doesn't exists,".
+ " removing $entry{file}".
+ $fs_prefs{clr_txt}." from queue...");
+ splice(@{$queue->{queue}}, $i, 1);
+ # next slot will have same index
+ } else {
+ $i++;
+ }
+ }
+
+ return 1 if ($next == -1);
+
+ %entry = %{ ${$queue->{queue}}[$next] };
+ my $server = Irssi::server_find_tag($entry{server_tag});
+ $server->command("^NOTICE $entry{nick} ".$fs_prefs{clr_txt}.
+ "Sending you your queued file (".$fs_prefs{clr_hi}.
+ size_to_str($entry{size}).$fs_prefs{clr_txt}.")");
+ print_what_we_did("NOTICE $entry{nick} ".$fs_prefs{clr_txt}.
+ "Sending you your queued file (".$fs_prefs{clr_hi}.
+ size_to_str($entry{size}).$fs_prefs{clr_txt}.")");
+ $nextfile =~ s/'/\\'/g;
+ $server->command("DCC SEND $entry{nick} $FD$nextfile$FD");
+ push(@fs_sends, { %entry });
+ splice(@{$queue->{queue}}, $next, 1);
+ return 0;
+}
+
+###############################################################################
+# update_files(): update the cache from $fs_prefs{root_dir}
+###############################################################################
+sub update_files
+{
+ my $filecount;
+ my $bytecount;
+
+ print_msg("Caching files, please wait!");
+ # update the cache
+ foreach my $qn (0 .. $#fs_queues) {
+ delete $fs_queues[$qn]->{cache};
+ cache_dir($fs_queues[$qn]->{root_dir},$fs_queues[$qn]);
+
+ $filecount = 0;
+ $bytecount = 0;
+ foreach my $dir (keys %{$fs_queues[$qn]->{cache}}) {
+ $filecount += @{$fs_queues[$qn]->{cache}{$dir}{files}};
+ $bytecount += $_ foreach (@{$fs_queues[$qn]->{cache}{$dir}{sizes}});
+ }
+
+ $fs_queues[$qn]->{filecount} = $filecount;
+ $fs_queues[$qn]->{bytecount} = $bytecount;
+
+ print_msg("Queue $qn: cached $filecount file(s) (".size_to_str($bytecount).") in ".
+ (keys(%{$fs_queues[$qn]->{cache}}))." dir(s)!");
+ }
+}
+
+###############################################################################
+# cache_dir($dir): recursive filecaching subroutine
+###############################################################################
+sub cache_dir
+{
+ my ($dir, $queue) = @_;
+ my @dirs = ();
+ my @files = ();
+ my @sizes = ();
+
+ opendir($dir, "$dir");
+ while (my $entry = readdir($dir)) {
+ if (!($entry eq '.') && !($entry eq '..')) {
+ my $full_path = $dir.'/'.$entry;
+ if (-d $full_path) {
+ push(@dirs, $entry);
+ cache_dir($full_path, $queue);
+ } elsif (-f $full_path) {
+ push(@sizes, (stat($full_path))[7]);
+ push(@files, $entry);
+ }
+ }
+ }
+
+ closedir($dir);
+
+ $dir =~ s/$queue->{root_dir}//;
+ $dir = '/' if (length($dir) == 0);
+
+ $queue->{cache}{$dir} = { dirs => [ @dirs ], files => [ @files ],
+ sizes => [ @sizes ] };
+}
+
+###############################################################################
+# count_queued_files($server_tag, $nick,$qn): returns number of queued files
+# for $nick
+###############################################################################
+sub count_queued_files
+{
+ my ($server_tag, $nick, $qn) = @_;
+ my $count = 0;
+
+ foreach (0 .. $#{$fs_queues[$qn]->{queue}}) {
+ $count++
+ if (${$fs_queues[$qn]->{queue}}[$_]->{nick} eq $nick &&
+ ${$fs_queues[$qn]->{queue}}[$_]->{server_tag} eq $server_tag);
+ }
+
+ return $count;
+}
+
+###############################################################################
+# count_user_files($server_tag, $nick, $qn): returns number of queued and
+# sended files for $nick
+###############################################################################
+sub count_user_files {
+ my ($server_tag, $nick, $qn) = @_;
+
+ if (!$fs_prefs{count_send_as_queue}) {
+ return count_queued_files($server_tag, $nick, $qn);
+ }
+
+ my $count = count_queued_files($server_tag, $nick, $qn);
+ foreach (0 .. $#fs_sends) {
+ $count++
+ if ($fs_sends[$_]->{nick} eq $nick &&
+ $fs_sends[$_]->{server_tag} eq $server_tag);
+ }
+
+ return $count;
+}
+
+###############################################################################
+# send_active_for($server_tag, $nick): true if currently sending file to
+# $nick
+###############################################################################
+sub send_active_for
+{
+ my ($server_tag, $nick) = @_;
+
+ foreach (0 .. $#fs_sends) {
+ return 1 if ($fs_sends[$_]{nick} eq $nick &&
+ $fs_sends[$_]{server_tag} eq $server_tag);
+ }
+
+ return 0;
+}
+
+###############################################################################
+# user_in_channel($server,$nick,$queue): true if user is on any
+# $queue->{channels}
+###############################################################################
+sub user_in_channel
+{
+ my ($server, $nick, $queue) = @_;
+
+ foreach (split(' ', $queue->{channels})) {
+# print_debug("Checking channel $_");
+ my $channel = $server->channel_find($_);
+ if ($channel && $channel->{joined} && $channel->nick_find($nick)) {
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+###############################################################################
+# send_user_msg($servertag, $nick, $msg): sends a msg to $nick using dcc if
+# available
+###############################################################################
+sub send_user_msg
+{
+ my ($servertag, $nick, $msg) = @_;
+
+ if ($nick eq "!fserve!") {
+ print_msg($msg);
+ } else {
+ my $server = Irssi::server_find_tag($servertag);
+ if (!$server || !$server->{connected}) {
+ return;
+ }
+
+ my $cmd = ((defined $fs_users{$nick."@".$servertag})?"MSG =$nick":"MSG $nick");
+ $server->command("$cmd $fs_prefs{clr_txt}$msg");
+ }
+}
+
+###############################################################################
+# size_to_str($size): returns a formatted size string
+###############################################################################
+sub size_to_str
+{
+ my ($size) = @_;
+
+ if ($size < 1024) {
+ $size = int($size) . " B";
+ } elsif ($size < 1048576) {
+ $size = sprintf("%.1f kB", $size/1024);
+ } elsif ($size < 1073741824) {
+ $size = sprintf("%.2f MB", $size/1048576);
+ } elsif ($size < 1099511627776) {
+ $size = sprintf("%.2f GB", $size/1073741824);
+ } else {
+ $size = sprintf("%.3f TB", $size/1099511627776);
+ }
+
+ return $size;
+}
+
+###############################################################################
+# time_to_str($time): returns a formatted time string
+###############################################################################
+sub time_to_str
+{
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(shift(@_));
+
+ return sprintf("%dd %dh %dm %ds", $yday, $hour, $min, $sec) if ($yday);
+ return sprintf("%dh %dm %ds", $hour, $min, $sec) if ($hour);
+ return sprintf("%dm %ds", $min, $sec) if ($min);
+ return sprintf("%ds", $sec);
+}
+
+###############################################################################
+# save_config(): saves preferences & statistics to file
+###############################################################################
+sub save_config
+{
+ my $f = $conffile;
+ $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/;
+ if (!open(FILE, ">", $f)) {
+ print_msg("Unable to open $f for writing!");
+ return 1;
+ }
+
+ print (FILE "[ConfigFileVersion 1.0]\n");
+
+ # save preferences
+ print(FILE "[common]\n");
+ foreach (sort(keys %fs_prefs)) {
+ print(FILE "$_=$fs_prefs{$_}\n");
+ }
+
+ # save statistics
+ print(FILE "[stats]\n");
+ foreach (sort(keys %fs_stats)) {
+ print(FILE "$_=$fs_stats{$_}\n");
+ }
+
+ #save queues settings
+ foreach my $qn (0 .. $#fs_queues) {
+ print(FILE "[queue $qn]\n");
+ foreach (sort(keys %{$fs_queues[$qn]})) {
+ next if ($_ eq 'queue' || $_ eq 'cache' || $_ eq 'sends' ||
+ $_ eq 'filecount' || $_ eq 'bytecount');
+ print(FILE "$_=$fs_queues[$qn]->{$_}\n");
+ }
+ }
+
+ close(FILE);
+ return 0;
+}
+
+###############################################################################
+# load_distro($file)
+###############################################################################
+sub load_distro {
+ my $file = $_[0];
+ if (!open(FILE, "<", $file)) {
+ print_msg("Unable to open $file for reading!");
+ return 0;
+ }
+
+ # file format:
+ # sent_count file_size file_name
+
+ my ($count, $size, $name);
+ while (<FILE>) {
+ chomp;
+ ($count, $size, $name) = split(/ /, $_, 3);
+ if (($count !~ /\d+/) or ($size !~ /\d+/) or (!$name)) {
+ print_msg("Error in $file in line $.");
+ close(FILE);
+ return 0;
+ }
+ $fs_distro{$name}{$size} = $count;
+ }
+
+ close(FILE);
+ return 1; # ok
+}
+
+
+###############################################################################
+# save_distro()
+###############################################################################
+sub save_distro
+{
+ return 0 if (!$fs_prefs{distro_file});
+
+ my $f = $fs_prefs{distro_file};
+ $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/;
+
+ if (!open(FILE, ">", $f)) {
+ print_msg("Unable to open $f for writing!");
+ return 1;
+ }
+
+ foreach (sort keys %fs_distro) {
+ foreach my $size (sort keys %{$fs_distro{$_}}) {
+ print FILE "$fs_distro{$_}{$size} $size $_\n";
+ }
+ }
+
+ close(FILE);
+ return 0;
+}
+
+###############################################################################
+# load_config(): loads preferences & statistics from file
+###############################################################################
+sub load_config
+{
+
+ my $f = $conffile;
+ $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/;
+ if (!open(FILE, "<", $f)) {
+ print_msg("Unable to open $f for reading!");
+ return 1;
+ }
+
+ local $/ = "\n";
+
+ my $config_version = <FILE>;
+ chomp $config_version;
+ if ($config_version !~ /^\[ConfigFileVersion 1\.[0-9]+]$/) {
+ print_msg("Config file format not recognized!");
+ print_msg("FServe 2.0 and newer won't work with config file");
+ print_msg(" created by earlier versions on FServe.");
+ return 1;
+ }
+
+ my $hash = \%fs_prefs;
+ my %garbage = ();
+
+ while (<FILE>) {
+ chomp;
+ if (/^\[(.*)\]$/) { # next chapter
+ if ($1 eq "common") {
+ $hash = \%fs_prefs;
+ } elsif ($1 eq "stats") {
+ $hash = \%fs_stats;
+ } elsif ($1 =~ /queue (.*)$/) {
+ while (!defined $fs_queues[$1]) {
+ push (@fs_queues, { %fs_queue_defaults });
+ @{$fs_queues[$#fs_queues]->{queue}} = ();
+ }
+ $hash = $fs_queues[$1];
+ } else {
+ print_msg("Unknown config section: $_");
+ $hash = \%garbage;
+ }
+ next;
+ }
+ my ($entry, $value) = split('=', $_, 2);
+ if (defined $hash->{$entry}) {
+ $hash->{$entry} = $value;
+ } else {
+ print_msg("unknown entry: $_");
+ }
+ }
+
+ close(FILE);
+ return 0;
+}
+
+
+###############################################################################
+# save_queue(): saves the current sends & queue to file
+###############################################################################
+sub save_queue
+{
+ my $f = $fs_prefs{queuefile};
+ $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/;
+
+ if (!open(FILE, ">", $f)) {
+ print_msg("Unable to open $f for writing!");
+ return 1;
+ }
+
+ print (FILE "[QueueFileVersion 1.0]\n");
+
+ # save the sends (for resuming)
+ foreach my $slot (0 .. $#fs_sends) {
+ foreach (sort keys %{$fs_sends[$slot]}) {
+ next if ($_ eq "dontwarn");
+ next if ($_ eq "transfd");
+ if ($_ eq "warns") {
+ print(FILE "$_=>0\0");
+ } else {
+ print(FILE "$_=>$fs_sends[$slot]->{$_}\0");
+ }
+ }
+ print(FILE "\n");
+ }
+
+ # save the queues
+ foreach (0 .. $#fs_queues) {
+ my $fsq = $fs_queues[$_]->{queue};
+ foreach my $slot (0 .. $#{$fsq}) {
+ foreach (sort keys %{${$fsq}[$slot]}) {
+ next if ($_ eq "dontwarn");
+ next if ($_ eq "transfd");
+ if ($_ eq "warns") {
+ print(FILE "$_=>0\0");
+ } else {
+ print(FILE "$_=>${$fsq}[$slot]->{$_}\0");
+ }
+ }
+ print(FILE "\n");
+ }
+ }
+
+ close(FILE);
+ return 0;
+}
+
+###############################################################################
+# load_queue(): (re)loads the queue from file
+###############################################################################
+sub load_queue
+{
+ my $f = $fs_prefs{queuefile};
+ $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/;
+
+ if (!open(FILE, "<", $f)) {
+ print_msg("Unable to open $f for reading!");
+ return 1;
+ }
+
+ my $queue_version = <FILE>;
+ chomp $queue_version;
+ if ($queue_version !~ /^\[QueueFileVersion 1\.[0-9]+]$/) {
+ print_msg("Queue file format not recognized!");
+ print_msg("FServe 2.0 and newer won't work with queue file");
+ print_msg(" created by earlier versions on FServe.");
+ return 1;
+ }
+
+ if (!@fs_queues) {
+ # create a very first queue :)
+ push (@fs_queues, { %fs_queue_defaults });
+ @{$fs_queues[$#fs_queues]->{queue}} = ();
+ }
+
+ # empty all queues
+ foreach (0 .. $#fs_queues) {
+ @{$fs_queues[$_]->{queue}} = ();
+ }
+
+ while (<FILE>) {
+ s/\n//g;
+ my %rec = ();
+ my $ignore = 0;
+
+ foreach my $line (split("\0", $_)) {
+ my ($entry, $value) = split('=>', $line, 2);
+ $rec{$entry} = $value;
+ }
+# print_debug("Read: $rec{nick}|$rec{server_tag}|$rec{file}|$rec{queue}");
+
+ # don't put it in queue if it is sending
+ foreach (0 .. $#fs_sends) {
+# print_debug("Checking if it's not in fs_sends with: $fs_sends[$_]->{nick}|$fs_sends[$_]->{server_tag}|$fs_sends[$_]->{file}|$fs_sends[$_]->{queue}");
+ if ($rec{nick} eq $fs_sends[$_]->{nick} &&
+ $rec{file} eq $fs_sends[$_]->{file} &&
+ $rec{queue} eq $fs_sends[$_]->{queue} &&
+ $rec{server_tag} eq $fs_sends[$_]->{server_tag}) {
+ $ignore = 1;
+ }
+ }
+
+ if (!$ignore) {
+ # check if it's sending already but isn't in %fs_sends
+ foreach (Irssi::Irc::dccs()) {
+# print_debug("Checking if it's not sending with: $_->{nick}|$_->{servertag}|$_->{arg}");
+ if ($_->{type} eq 'SEND' && $_->{nick} eq $rec{nick} &&
+ $_->{arg} eq $rec{file} &&
+ $rec{server_tag} eq $_->{servertag}) {
+ print_debug("send of '$rec{file}' for $rec{nick}\@$rec{server_tag} was lost, adding to fs_sends");
+ push(@fs_sends, { %rec });
+ $ignore = 1;
+ last;
+ }
+ }
+ }
+ if (!$ignore) {
+ my $fsq;
+ if (defined $rec{queue}) {
+ if (!defined $fs_queues[$rec{queue}]) {
+ print_msg("unknown queue #$rec{queue}");
+ next;
+ }
+ $fsq = $fs_queues[$rec{queue}]->{queue};
+ } else {
+ $fsq = $fs_queues[0]->{queue};
+ }
+ # add to queue
+ if ($rec{resends}) {
+ # count resended files
+ my $place = 0;
+ foreach (0 .. $#{$fsq}) {
+ $place++ if (${$fsq}[$_]->{resends});
+ }
+ splice(@{$fsq}, $place, 0, { %rec });
+ } else {
+ push(@{$fsq}, { %rec });
+ }
+ }
+ }
+
+ close(FILE);
+ return 0;
+}
+
+###############################################################################
+# print_log(): write line to log file
+###############################################################################
+sub print_log
+{
+ my $f = $fs_prefs{log_name};
+ $f =~ s/\$IRSSI/Irssi::get_irssi_dir()/e or $f =~ s/~/$ENV{"HOME"}/;
+ if (!$logfp && $fs_prefs{log_name} && open(LOGFP, ">>", $f)) {
+ $logfp = \*LOGFP;
+ select((select($logfp), $|++)[0]);
+ }
+ return if !$logfp;
+ my ($msg) = @_;
+ $msg =~ s/^\s*|\s*$//gs;
+ print $logfp localtime()." $msg\n";
+}
+
+# vim:noexpandtab:ts=4
diff --git a/scripts/fuckem.pl b/scripts/fuckem.pl
new file mode 100644
index 0000000..2c18f3b
--- /dev/null
+++ b/scripts/fuckem.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/perl -w
+
+## Bugreports and Licence disclaimer.
+#
+# For bugreports and other improvements contact Geert Hauwaerts <geert@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+##
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.05";
+
+%IRSSI = (
+ authors => 'Geert Hauwaerts',
+ contact => 'geert@irssi.org',
+ name => 'fuckem.pl',
+ description => 'Simulates the BitchX /FUCKEM command. Deop/Dehalfop everyone on the channel including you.',
+ license => 'GNU General Public License',
+ url => 'http://irssi.hauwaerts.be/fuckem.pl',
+ changed => 'Wed Sep 17 23:00:11 CEST 2003',
+);
+
+Irssi::theme_register([
+ 'fuckem_loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.'
+]);
+
+sub fuckem {
+
+ my ($data, $server, $channel) = @_;
+ my ($hops, $ops, $hcount, $ocount, $mode, $users);
+
+ if (!$server) {
+ $channel->print("You are not connected to a server.");
+ return;
+ } elsif (!$channel || $channel->{type} ne "CHANNEL") {
+ $channel->print("No active channel in this window.");
+ return;
+ } elsif (!$channel->{ownnick}{op}) {
+ $channel->print("You're no channel operator.");
+ return;
+ }
+
+ foreach my $nick ($channel->nicks()) {
+ if ($nick->{halfop}) {
+ $hops .= "$nick->{nick} ";
+ $hcount++;
+ } elsif ($nick->{op}) {
+ $ops .= "$nick->{nick} ";
+ $ocount++;
+ }
+ }
+
+ if ($ops) {
+ $mode .= 'o' x $ocount;
+ $users .= "$ops ";
+ }
+
+ if ($hops) {
+ $mode .= 'h' x $hcount;
+ $users .= "$hops ";
+ }
+
+ $mode .= 'o';
+ $users .= "$server->{nick}";
+
+ $channel->command("mode -$mode $users");
+}
+
+Irssi::command_bind('fuckem', 'fuckem');
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fuckem_loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
diff --git a/scripts/getop.pl b/scripts/getop.pl
new file mode 100644
index 0000000..4b1914c
--- /dev/null
+++ b/scripts/getop.pl
@@ -0,0 +1,387 @@
+use Irssi 20020300;
+use strict;
+
+use vars qw($VERSION %IRSSI %HELP);
+$HELP{getop} = "
+GETOP [channel]
+
+Gets op on current channel or 'channel' from random opped bot added by ADDGETOP.
+";
+$HELP{addgetop} = "
+ADDGETOP [channel] <mask> <command>
+
+Adds entry to 'channel' or current channel getop list.
+The \$0 in command specifies nick of random found mask
+in channel.
+";
+$HELP{delgetop} = "
+DELGETOP [channel] <mask or index number from LISTGETOP>
+
+Deletes entry from getoplist on current channel or 'channel'.
+";
+$HELP{listgetop} = "
+LISTGETOP [channel]
+
+Lists all entries in getop list or just 'channel's getop list.
+";
+$VERSION = "0.9b";
+%IRSSI = (
+ authors => "Maciek \'fahren\' Freudenheim",
+ contact => "fahren\@bochnia.pl",
+ name => "GetOP",
+ description => "Automatically request op from random opped person with specifed command from list after joining channel",
+ license => "GNU GPLv2 or later",
+ changed => "Fri Jan 10 03:54:07 CET 2003"
+);
+
+Irssi::theme_register([
+ 'getop_listline', '[%W$[!-2]0%n]%| $[40]1%_: %_$2',
+ 'getop_add', 'Added \'%_$2%_\' to getop list on channel %_$1%_ /$0/',
+ 'getop_del', 'Deleted \'%_$2%_\' from getop list on channel %_$1%_ /$0/',
+ 'getop_changed', 'Changed command for mask \'%_$2%_\' on channel %_$1%_ /$0/',
+ 'getop_noone', '"%Y>>%n No one to get op from on $1 /$0/',
+ 'getop_get', '%Y>>%n Getting op from %_$2%_ on $1 /$0/'
+]);
+
+my %getop = ();
+my @userhosts;
+my $getopfile = Irssi::get_irssi_dir . "/getoplist";
+
+sub sub_getop {
+ my ($args, $server, $winit) = @_;
+
+ my $chan;
+ my ($channel) = $args =~ /^([^\s]+)/;
+
+ if ($server->ischannel($channel)) {
+ unless ($chan = $server->channel_find($channel)) {
+ Irssi::print("%R>>%n You are not on $channel.");
+ return;
+ }
+ $args =~ s/^[^\s]+\s?//;
+ } else {
+ unless ($winit && $winit->{type} eq "CHANNEL") {
+ Irssi::print("%R>>%n You don't have active channel in that window.");
+ return;
+ }
+ $channel = $winit->{name};
+ $chan = $winit;
+ }
+
+ if ($chan->{chanop}) {
+ Irssi::print("%R>>%n You are already opped on $channel.");
+ return;
+ }
+
+ $channel = lc($channel);
+ my $tag = lc($server->{tag});
+
+ unless ($getop{$tag}{$channel}) {
+ Irssi::print("%R>>%n Your getop list on channel $channel is empty. Use /ADDGETOP first.");
+ return;
+ };
+
+ unless ($getop{$tag}{$channel}) {
+ Irssi::print("%R>>%n Your getop list on channel $channel is empty.");
+ return;
+ }
+
+ getop_proc($tag, $chan);
+}
+
+sub sub_addgetop {
+ my ($args, $server, $winit) = @_;
+
+ my ($channel) = $args =~ /^([^\s]+)/;
+
+ if ($server->ischannel($channel)) {
+ $args =~ s/^[^\s]+\s?//;
+ } else {
+ unless ($winit && $winit->{type} eq "CHANNEL") {
+ Irssi::print("%R>>%n You don't have active channel in that window.");
+ return;
+ }
+ $channel = $winit->{name};
+ }
+
+ my ($mask, $command) = split(/ +/, $args, 2);
+
+ unless ($command) {
+ Irssi::print("Usage: /ADDGETOP [channel] <mask or nickname> <command>. If you type '\$0' in command then it will be changed automatically into mask's nick.");
+ return;
+ }
+
+ my $cmdchar = Irssi::settings_get_str('cmdchars');
+ $command =~ s/^($cmdchar*)\^?/\1^/g;
+
+ if (index($mask, "@") == -1) {
+ my ($c, $n);
+ if (($c = $server->channel_find($channel)) && ($n = $c->nick_find($mask))) {
+ $mask = $n->{host};
+ $mask =~ s/^[~+\-=^]/*/;
+ } else {
+ $server->redirect_event('userhost', 1, $mask, 0, undef, {
+ 'event 302' => 'redir getop userhost',
+ '' => 'event empty' } );
+ $server->send_raw("USERHOST $mask");
+ my $uh = lc($mask) . " " . lc($channel) . " $command";
+ push @userhosts, $uh;
+ return;
+ }
+ }
+
+ $mask = "*!" . $mask if (index($mask, "!") == -1);
+ my $tag = lc($server->{tag});
+ my $channel = lc($channel);
+
+ for my $entry (@{$getop{$tag}{$channel}}) {
+ if ($entry->{mask} eq $mask) {
+ $entry->{command} = $command;
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'getop_changed', $tag, $channel, $mask, $command);
+ &savegetop;
+ return;
+ }
+ }
+
+ my $gh = {
+ mask => $mask,
+ command => $command
+ };
+
+ push @{$getop{$tag}{$channel}}, $gh;
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'getop_add', $tag, $channel, $mask, $command);
+
+ &savegetop;
+}
+
+sub sub_delgetop {
+ my ($args, $server, $winit) = @_;
+
+ my ($channel) = $args =~ /^([^\s]+)/;
+
+ if ($server->ischannel($channel)) {
+ $args =~ s/^[^\s]+\s?//;
+ } else {
+ unless ($winit && $winit->{type} eq "CHANNEL") {
+ Irssi::print("%R>>%n You don't have active channel in that window.");
+ return;
+ }
+ $channel = $winit->{name};
+ }
+
+ my $tag = lc($server->{tag});
+ my $channel = lc($channel);
+
+ unless ($getop{$tag}{$channel}) {
+ Irssi::print("%R>>%n Your getop list on channel $channel is empty.");
+ return;
+ }
+
+ unless ($args) {
+ Irssi::print("%W>>%n Usage: /DELGETOP [channel] <mask | index from LISTGETOP>");
+ return;
+ }
+
+ my $num;
+ if ($args =~ /^[0-9]+$/) {
+ if ($args > scalar(@{$getop{$tag}{$channel}})) {
+ Irssi::print("%R>>%n No such entry in $channel getop list.");
+ return;
+ }
+ $num = $args - 1;
+ } else {
+ my $i = 0;
+ for my $entry (@{$getop{$tag}{$channel}}) {
+ $args eq $entry->{mask} and $num = $i, last;
+ $i++;
+ }
+ }
+
+ if (my($gh) = splice(@{$getop{$tag}{$channel}}, $num, 1)) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'getop_del', $tag, $channel, $gh->{mask}, $gh->{command});
+ unless (scalar(@{$getop{$tag}{$channel}})) {
+ Irssi::print("%R>>%n No more entries in $channel getop list left.");
+ delete $getop{$tag}{$channel};
+ }
+ unless (keys %{$getop{$tag}}) {
+ Irssi::print("%R>>%n No more entries in getop list on $tag left.");
+ delete $getop{$tag};
+ }
+ }
+
+ &savegetop;
+}
+
+sub sub_listgetop {
+ my ($args, $server, $winit) = @_;
+
+ my ($channel) = $args =~ /^([^\s]+)/;
+
+ if ($server->ischannel($channel)) {
+ my $tag = lc($server->{tag});
+ $channel = lc($channel);
+ unless ($getop{$tag}{$channel}) {
+ Irssi::print("%R>>%n Your getop list on channel $channel is empty.");
+ return;
+ }
+ my $i = 0;
+ Irssi::print("Getop list on $channel /$tag/:");
+ for my $entry (@{$getop{$tag}{$channel}}) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'getop_listline', $i++, $entry->{mask}, $entry->{command});
+ }
+ } else {
+ unless (keys %getop) {
+ Irssi::print("%R>>%n Your getop list is empty. /ADDGETOP first.");
+ return;
+ }
+ for my $ircnet (keys %getop) {
+ for my $chan (keys %{$getop{$ircnet}}) {
+ Irssi::print("Channel: $chan /$ircnet/");
+ my $i = 1;
+ for my $entry (@{$getop{$ircnet}{$chan}}) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'getop_listline', $i++, $entry->{mask}, $entry->{command});
+ }
+ }
+ }
+ }
+}
+
+sub userhost_red {
+ my ($server, $data) = @_;
+ $data =~ s/^[^ ]* :?//;
+
+ my $uh = shift @userhosts;
+ my ($nick, $chan, $command) = split(/ /, $uh, 3);
+
+ unless ($data && $data =~ /^([^=\*]*)\*?=.(.*)@(.*)/ && lc($1) eq $nick) {
+ Irssi::print("%R>>%n No such nickname: $nick");
+ return;
+ }
+
+ my ($user, $host) = ($2, $3);
+ $user =~ s/^[~+\-=^]/*/;
+ my $mask = "*!" . $user . "@" . $host;
+ my $tag = lc($server->{tag});
+
+ for my $entry (@{$getop{$tag}{$chan}}) {
+ if ($entry->{mask} eq $mask) {
+ $entry->{command} = $command;
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'getop_changed', $tag, $chan, $mask, $command);
+ &savegetop;
+ return;
+ }
+ }
+
+ my $gh = {
+ mask => $mask,
+ command => $command
+ };
+
+ push @{$getop{$tag}{$chan}}, $gh;
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'getop_add', $tag, $chan, $mask, $command);
+
+ &savegetop;
+}
+
+sub getop_proc ($$) {
+ my ($tag, $chan) = @_;
+
+ my $channel = lc($chan->{name});
+ return unless ($getop{$tag}{$channel});
+
+ my (@list, $mask);
+ for my $nick ($chan->nicks()) {
+ next unless ($nick->{op});
+ $mask = $nick->{nick} . "!" . $nick->{host};
+ for my $entry (@{$getop{$tag}{$channel}}) {
+ if (mask_match($mask, $entry->{mask})) {
+ my $lh = {
+ nick => $nick->{nick},
+ command => $entry->{command}
+ };
+ push @list, $lh;
+ }
+ }
+ }
+
+ unless (@list) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'getop_noone', $tag, $channel);
+ } else {
+ my $get = $list[int(rand(@list))];
+ $get->{command} =~ s/\$0/$get->{nick}/g;
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'getop_get', $tag, $channel, $get->{nick}, $get->{command});
+ $chan->command($get->{command});
+ }
+}
+
+sub mask_match ($$) {
+ my ($what, $match) = @_;
+
+ $match =~ s/\\/\\\\/g;
+ $match =~ s/\./\\\./g;
+ $match =~ s/\*/\.\*/g;
+ $match =~ s/\!/\\\!/g;
+ $match =~ s/\?/\./g;
+ $match =~ s/\+/\\\+/g;
+ $match =~ s/\^/\\\^/g;
+
+ return ($what =~ /^$match$/i);
+}
+
+sub got_notopped {
+ my ($server, $data) = @_;
+ my ($chan) = $data =~ /^[^\s]+\s([^\s]+)\s:/;
+ getop_proc(lc($server->{tag}), $server->channel_find($chan));
+}
+
+sub channel_sync {
+ my $chan = shift;
+ getop_proc(lc($chan->{server}->{tag}), $chan) unless ($chan->{chanop});
+}
+
+sub savegetop {
+ local *fp;
+ open (fp, ">", $getopfile) or die "Couldn't open $getopfile for writing";
+
+ for my $ircnet (keys %getop) {
+ for my $chan (keys %{$getop{$ircnet}}) {
+ for my $entry (@{$getop{$ircnet}{$chan}}) {
+ print(fp "$ircnet $chan $entry->{mask} $entry->{command}\n");
+ }
+ }
+ }
+
+ close fp;
+}
+
+sub loadgetop {
+ %getop = ();
+ return unless (-e $getopfile);
+ local *fp;
+
+ open (fp, "<", $getopfile) or die "Couldn't open $getopfile for reading";
+ local $/ = "\n";
+
+ while (<fp>) {
+ chop;
+ my $gh = {};
+ my ($tag, $chan);
+ ($tag, $chan, $gh->{mask}, $gh->{command}) = split(/ /, $_, 4);
+ push @{$getop{$tag}{$chan}}, $gh;
+ }
+
+ close fp;
+}
+
+&loadgetop;
+
+Irssi::command_bind( {
+ 'getop' => \&sub_getop,
+ 'addgetop' => \&sub_addgetop,
+ 'delgetop' => \&sub_delgetop,
+ 'listgetop' => \&sub_listgetop } );
+Irssi::signal_add({ 'redir getop userhost' => \&userhost_red,
+ 'event 482' => \&got_notopped,
+ 'channel sync' => \&channel_sync});
diff --git a/scripts/gimmie.pl b/scripts/gimmie.pl
new file mode 100644
index 0000000..df0102d
--- /dev/null
+++ b/scripts/gimmie.pl
@@ -0,0 +1,39 @@
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.0";
+%IRSSI = (
+ authors => 'PrincessLeia2',
+ contact => 'lyz\@princessleia.com ',
+ name => 'gimmie',
+ description => 'a bot script, using ! followed by anything the script will say (as an action): gets nickname anything',
+ license => 'GNU GPL v2 or later',
+ url => 'http://www.princessleia.com/'
+);
+
+sub event_privmsg {
+my ($server, $data, $nick, $mask, $target) =@_;
+my ($target, $text) = $data =~ /^(\S*)\s:(.*)/;
+ return if ( $text !~ /^!/i );
+ if ( $text =~ /^!coffee$/i ) {
+ $server->command ( "action $target hands $nick a steaming cup of coffee" );
+ }
+ elsif ($text =~ /^!chimay$/i ) {
+ $server->command ( "action $target hands $nick a glass of Chimay" );
+ }
+ elsif ($text =~ /^!pepsi$/i ) {
+ $server->command ( "action $target gives $nick a can of Star Wars Pepsi" );
+ }
+ elsif ($text =~ /^!ice cream$/i ) {
+ $server->command ( "action $target gives $nick a chocolate ice cream with lots of cherries" );
+ }
+ elsif ($text =~ /^!$nick$/i ) {
+ $server->command ( "msg $target get yourself?" );
+ }
+ else {
+ my ($gimmie) = $text =~ /!(.*)/;
+ $server->command ( "action $target Gets $nick $gimmie \0032<\%)");
+ }
+}
+Irssi::signal_add('event privmsg', 'event_privmsg');
diff --git a/scripts/gitscriptassist.pl b/scripts/gitscriptassist.pl
new file mode 100644
index 0000000..dd285d6
--- /dev/null
+++ b/scripts/gitscriptassist.pl
@@ -0,0 +1,631 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+use IPC::Open3;
+use CPAN::Meta::YAML;
+use Text::ParseWords;
+use Text::Wrap;
+use Time::HiRes;
+use File::Glob qw/:bsd_glob/;
+
+$VERSION = '0.2';
+%IRSSI = (
+ authors => 'bw1',
+ contact => 'bw1@aol.at',
+ name => 'gitscriptassist',
+ description => 'script management with git',
+ license => 'Public Domain',
+ url => 'https://scripts.irssi.org/',
+ changed => '2020-02-02',
+ modules => 'IPC::Open3 CPAN::Meta::YAML Text::ParseWords '.
+ 'Text::Wrap Time::HiRes',
+ commands=> "gitscriptassist"
+);
+
+my $help= << "END";
+%9Name%9
+ /gitscriptassist - $IRSSI{description}
+
+%9Version%9
+ $VERSION
+
+%9Description%9
+ \$ mkdir ~/foo
+ \$ cd ~/foo
+ \$ git clone https://github.com/irssi/scripts.irssi.org.git
+ \$ irssi
+ [(status)] /script load ~/foo/scripts.irssi.org/scripts/gitscriptassist.pl
+ [(status)] /set gitscriptassist_repo ~/foo/scripts.irssi.org
+ [(status)] /gitscriptassist search script
+ [(status)] /quit
+ \$ echo "/script load ~/foo/scripts.irssi.org/scripts/gitscriptassist.pl" >> \\
+ > ~/.irssi/startup
+ \$ irssi
+
+%9Settings%9
+ %Ugitscriptassist_repo%U
+ path to the git workingdir
+ %Ugitscriptassist_path%U
+ path for the tempory files of /gitscriptassist
+ %Ugitscriptassist_startup%U
+ load the scripts on startup
+ %Ugitscriptassist_integrate%U
+ integrate in the script command
+
+%9Commands%9
+END
+
+my %scmds=(
+ 'fetch'=>{
+ 'short'=>"git fetch -all",
+ },
+ 'gitload'=>{
+ 'short'=>"load a script from the repository",
+ 'usage'=>"/gitscriptassist gitload {filename[.pl]|hash:filename[.pl]}",
+ 'file'=>1,
+ },
+ 'info'=>{
+ 'short'=>"view script info",
+ 'usage'=>"/gitscriptassist info <filename[.pl]>",
+ 'file'=>1,
+ },
+ 'log'=>{
+ 'short'=>"git log",
+ 'usage'=>"/gitscriptassist log [filename[.pl]]",
+ 'file'=>1,
+ },
+ 'pull'=>{
+ 'short'=>"git pull",
+ },
+ 'search'=>{
+ 'short'=>"search for word in scripts.yaml",
+ 'usage'=>"/gitscriptassist search <word>",
+ },
+ 'status'=>{
+ 'short'=>"git status",
+ },
+ 'help'=>{
+ 'short'=>"show help",
+ },
+ 'autoload'=>{
+ 'short'=>"manage autoload",
+ 'usage'=>"/gitscriptassist autoload <command>",
+ 'sub' => {
+ 'list' => {
+ 'short'=>"show the list for startup",
+ },
+ 'add' => {
+ 'short'=>"add a list entry for /script load",
+ 'file'=>1,
+ },
+ 'gitadd' => {
+ 'short'=>"add a list entry for /script load via git",
+ 'file'=>1,
+ },
+ 'write' => {
+ 'short'=>"write list to file",
+ },
+ 'load' => {
+ 'short'=>"load the list from file",
+ },
+ 'startup' => {
+ 'short'=>"trigger the startup",
+ },
+ 'remove' => {
+ 'short'=>"remove a list entry",
+ },
+ 'move' => {
+ 'short'=>"move a list entry",
+ },
+ },
+ },
+ 'new'=>{
+ 'short'=>"show last modified scripts",
+ 'usage'=>"/gitscriptassist new [max]",
+ },
+);
+
+my ($repo, $path, $startup, $integrate);
+
+my $subproc;
+my @nproc;
+
+my %scripts;
+my %time_scr;
+my @comp_start;
+my @autoload;
+
+my ($fh_in, $fh_out, $fh_err);
+
+sub load_autoload {
+ my $fh;
+ my $fn = $path.'/autoload.yaml';
+ if (-e $fn) {
+ open $fh, "<:utf8", $fn;
+ my $yt = do { local $/; <$fh> };
+ my $yml= CPAN::Meta::YAML->read_string($yt);
+ if (defined $yml->[0]) {
+ @autoload =@{$yml->[0]};
+ }
+ close $fh;
+ if ($startup) {
+ ascmd_startup();
+ }
+ }
+}
+
+sub write_autoload {
+ my $fh;
+ my $fn = $path.'/autoload.yaml';
+ if (scalar(@autoload) >0) {
+ open $fh, ">:utf8", $fn;
+ my $yml =CPAN::Meta::YAML->new(\@autoload);
+ print $fh $yml->write_string;
+ close $fh;
+ }
+}
+
+sub load_scripts {
+ my $fh;
+ my $f =$repo.'/_data/scripts.yaml';
+ my $fn = bsd_glob $f, GLOB_TILDE;
+ if (-e $fn) {
+ %time_scr= ();
+ %scripts= ();
+ open $fh, "<:utf8", $fn;
+ my $yt = do { local $/; <$fh> };
+ my $yml= CPAN::Meta::YAML->read_string($yt);
+ my @l =@{$yml->[0]};
+ foreach my $s (@l) {
+ $scripts{$s->{filename}}=$s;
+ }
+ foreach my $s (@l) {
+ if (!exists $time_scr{$s->{modified}}) {
+ $time_scr{$s->{modified}} =[];
+ }
+ push @{$time_scr{$s->{modified}}}, $s;
+ }
+ close $fh;
+ }
+}
+
+sub run {
+ my (%arg) =@_;
+ if (!defined $subproc) {
+ $subproc={%arg};
+ use Symbol 'gensym'; $fh_err = gensym;
+ my $pid = open3 ($fh_in, $fh_out, $fh_err, $subproc->{cmd});
+ if (defined $pid) {
+ $subproc->{pid}=$pid;
+ Irssi::pidwait_add($pid);
+ }
+ } else {
+ push @nproc, {%arg}
+ }
+}
+
+sub sig_run_end {
+ my ($pid, $status) = @_;
+
+ if (defined $subproc) {
+ my $old = select $fh_out;
+ {
+ local $/;
+ $subproc->{out} = <$fh_out>;
+ $subproc->{out} =~ s/\n$//;
+ select $old;
+ }
+
+ {
+ select $fh_err;
+ local $/;
+ $subproc->{err} = <$fh_err>;
+ $subproc->{err} =~ s/\n$//;
+ select $old;
+ }
+
+ if (exists $subproc->{next}) {
+ if (ref ($subproc->{next}) eq 'CODE') {
+ &{$subproc->{next}}();
+ } elsif (ref ($subproc->{next}) eq 'ARRAY') {
+ foreach my $p (@{$subproc->{next}}) {
+ if (ref ($p) eq 'CODE') {
+ &{$p}();
+ }
+ }
+ }
+ }
+ $subproc = undef;
+ if (scalar(@nproc) >0 ){
+ my %arg = %{shift @nproc};
+ run(%arg);
+ }
+ }
+}
+
+sub draw_box {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub print_msg {
+ my ( @te );
+ if ($subproc->{out} ne '') {
+ push @te, $subproc->{out};
+ }
+ if ($subproc->{err} ne '') {
+ push @te,'E:'.$subproc->{cmd};
+ push @te,'E:'.$subproc->{err};
+ }
+ if (defined $subproc->{label} &&
+ ($subproc->{out} ne '' ||
+ $subproc->{err} ne '' )) {
+ Irssi::print(
+ draw_box($IRSSI{name}, join( "\n",@te) ,$subproc->{label}, 1),
+ , MSGLEVEL_CLIENTCRAP);
+ }
+}
+
+sub next_gitload {
+ if ($subproc->{err} eq '') {
+ Irssi::command("script load $path/$subproc->{filename}");
+ }
+}
+
+sub scmd_script_info {
+ my ($server, $witem, @args) =@_;
+ my @te;
+ my $s = $scripts{$args[0]};
+ if (!defined $s) {
+ $s = $scripts{$args[0].'.pl'};
+ }
+ if (defined $s) {
+ push @te, "name: $s->{name}";
+ push @te, "authors: $s->{authors}";
+ push @te, "description:";
+ my $d;
+ {
+ local $Text::Wrap::columns = 60;
+ local $Text::Wrap::unexpand= 0;
+ $d =wrap(' ',' ',$s->{description});
+ }
+ push @te, $d;
+ push @te, "filename: $s->{filename}";
+ push @te, "version: $s->{version}";
+ push @te, "modified: $s->{modified}";
+ Irssi::print(
+ draw_box($IRSSI{name}, join( "\n",@te) ,'info' , 1),
+ , MSGLEVEL_CLIENTCRAP);
+ }
+}
+
+sub scmd_script_search {
+ my ($server, $witem, @args) =@_;
+ my @te;
+ my @scrs;
+ my $ml=0;
+ my $w=$args[0];
+ foreach my $fn (sort keys %scripts) {
+ my $s=$scripts{$fn};
+ if (
+ $s->{name} =~ m/$w/i ||
+ $s->{authors} =~ m/$w/i ||
+ $s->{description} =~ m/$w/i ||
+ $s->{filename} =~ m/$w/i ) {
+ push @scrs, $s;
+ my $l=length($s->{filename});
+ $ml=$l if ( $ml < $l);
+ }
+ }
+
+ foreach my $s (@scrs) {
+ my $i = sprintf "%-*s ", $ml, $s->{filename};
+ my $dt=$s->{description};
+ $dt=~ s/\n/ /g;
+ $dt=~ s/\s+/ /g;
+ my $d;
+ {
+ local $Text::Wrap::columns = 60;
+ local $Text::Wrap::unexpand= 0;
+ $d =wrap($i, ' 'x($ml+1), $dt);
+ }
+ push @te, $d;
+ }
+ Irssi::print(
+ draw_box($IRSSI{name}, join( "\n",@te) ,'search' , 1),
+ , MSGLEVEL_CLIENTCRAP);
+}
+
+sub scmd_gitload {
+ my ($server, $witem, @args) =@_;
+ my ($po, $fn);
+ if ($args[0] =~ m/^(.*):(.*)$/) {
+ $po=$1;
+ $fn=$2;
+ } else {
+ $po='master';
+ $fn=$args[0];
+ }
+ $fn .= '.pl' if ($fn !~ m/\.pl$/);
+ run(
+ 'cmd' => "git -C $repo show $po:scripts/$fn >$path/$fn",
+ 'label'=> 'gitload',
+ 'filename'=>$fn,
+ 'point'=>$po,
+ 'next' => [\&next_gitload,\&print_msg]);
+}
+
+sub scmd_help {
+ my ($server, $witem, @args) =@_;
+ my @te;
+ if (scalar(@args) ==0 ) {
+ chomp $help;
+ push @te, $help;
+ foreach my $c (sort keys %scmds) {
+ if (exists $scmds{$c}->{short}) {
+ push @te, sprintf(" %%9%-10s%%9 %s", $c, $scmds{$c}->{short});
+ }
+ if (scalar(keys %{$scmds{$c}->{sub}}) ) {
+ push @te, ' '.join ' ',sort keys %{$scmds{$c}->{sub}};
+ }
+ }
+ Irssi::print(
+ draw_box($IRSSI{name}, join( "\n",@te) ,'help' , 1),
+ , MSGLEVEL_CLIENTCRAP);
+ } elsif ( exists $scmds{$args[0]} ) {
+ my $sa = $args[0];
+ push @te, "%9/$IRSSI{name} $sa%9";
+ if (exists $scmds{$sa}->{short}) {
+ push @te, " $scmds{$sa}->{short}";
+ }
+ if (exists $scmds{$sa}->{usage}) {
+ push @te, "%9Usage:%9";
+ push @te, " $scmds{$sa}->{usage}";
+ }
+ if (scalar(keys %{$scmds{$sa}->{sub}}) >0) {
+ push @te, "%9Commands:%9";
+ foreach my $su (sort keys %{$scmds{$sa}->{sub}}) {
+ if (exists $scmds{$sa}->{sub}->{$su}->{short}) {
+ push @te, sprintf(" %-10s %s", $su, $scmds{$sa}->{sub}->{$su}->{short});
+ }
+ }
+ }
+ Irssi::print(
+ draw_box($IRSSI{name}, join( "\n",@te) ,'help' , 1),
+ , MSGLEVEL_CLIENTCRAP);
+ }
+}
+
+sub ascmd_startup {
+ my ($server, $witem, @args) =@_;
+ foreach my $s (@autoload) {
+ if (exists $s->{load}) {
+ Irssi::command("script load $s->{load}");
+ } elsif (exists $s->{gitload}) {
+ scmd_gitload($server, $witem, $s->{gitload});
+ }
+ }
+}
+
+sub ascmd_list {
+ my ($server, $witem, @args) =@_;
+ my @te;
+ my $co=0;
+ foreach (@autoload){
+ my ($k, $f);
+ ($k) = keys %$_;
+ $f = $_->{$k};
+ push @te,sprintf("%4d %-10s %s", $co, $k, $f);
+ $co++;
+ }
+ Irssi::print(
+ draw_box($IRSSI{name}, join( "\n",@te) ,'autoload list' , 1),
+ , MSGLEVEL_CLIENTCRAP);
+}
+
+sub scmd_autoload {
+ my ($server, $witem, @args) =@_;
+ my $c = shift @args;
+ if ($c eq 'list') {
+ ascmd_list($server, $witem, @args);
+ } elsif ( $c eq 'add') {
+ push @autoload, { load=>$args[0]};
+ } elsif ( $c eq 'gitadd') {
+ push @autoload, { gitload=>$args[0]};
+ } elsif ( $c eq 'remove') {
+ splice @autoload,$args[0],1;
+ } elsif ( $c eq 'move') {
+ my $b =splice @autoload,$args[0],1;
+ my @ab =splice @autoload,$args[1];
+ push @autoload, $b;
+ push @autoload, @ab;
+ } elsif ( $c eq 'write') {
+ write_autoload();
+ } elsif ( $c eq 'load') {
+ load_autoload();
+ } elsif ( $c eq 'startup') {
+ ascmd_startup($server, $witem, @args);
+ }
+}
+
+sub scmd_new {
+ my ($server, $witem, @args) =@_;
+ my @te;
+ my $co=1;
+ my $max=5;
+ if (defined $args[0]) {
+ $max= $args[0];
+ }
+ foreach my $t (sort { $b cmp $a } keys %time_scr) {
+ foreach my $s ( @{$time_scr{$t}}) {
+ push @te,"$t $s->{filename}";
+ $co++;
+ }
+ last if ($co > $max);
+ }
+ Irssi::print(
+ draw_box($IRSSI{name}, join( "\n",@te) ,'new' , 1),
+ , MSGLEVEL_CLIENTCRAP);
+}
+
+sub cmd {
+ my ($args, $server, $witem)=@_;
+ my @args = grep { $_ ne ''} quotewords('\s+', 0, $args);
+ my $c =shift @args;
+
+ if ($c eq 'gitload') {
+ scmd_gitload($server, $witem, @args);
+
+ } elsif ($c eq 'status') {
+ run(
+ 'cmd' => "git -C $repo status -sbuno",
+ 'label'=> 'status',
+ 'next' => [\&print_msg, \&load_scripts]);
+
+ } elsif ($c eq 'pull') {
+ run(
+ 'cmd' => "git -C $repo pull",
+ 'label'=> 'pull',
+ 'next' => [\&print_msg, \&load_scripts]);
+
+ } elsif ($c eq 'fetch') {
+ run(
+ 'cmd' => "git -C $repo fetch --all",
+ 'label'=> 'fetch',
+ 'next' => \&print_msg);
+
+ } elsif ($c eq 'log') {
+ my $s;
+ if (defined $args[0]) {
+ $s = "scripts/$args[0]";
+ if ($s !~ m/\.pl$/) {
+ $s .=".pl";
+ }
+ }
+ run(
+ 'cmd' => "git -C $repo log master -n 10 ".
+ "--invert-grep --grep='automatic scripts database update' ".
+ "--no-decorate --no-merges ".
+ "--date=short ".
+ "--pretty='format:%cd %h %s' ".
+ "$s",
+ 'label'=> 'log',
+ 'next' => \&print_msg);
+
+ } elsif ($c eq 'info') {
+ scmd_script_info($server, $witem, @args);
+
+ } elsif ($c eq 'search') {
+ scmd_script_search($server, $witem, @args);
+
+ } elsif ($c eq 'help') {
+ scmd_help($server, $witem, @args);
+
+ } elsif ($c eq 'new') {
+ scmd_new($server, $witem, @args);
+
+ } elsif ($c eq 'autoload') {
+ scmd_autoload($server, $witem, @args);
+ }
+}
+
+sub sig_setup_changed {
+ my $r = Irssi::settings_get_str('gitscriptassist_repo');
+ if ($r ne $repo ) {
+ $r =~ s#/$##;
+ $repo= $r;
+ %scripts=();
+ load_scripts();
+ }
+ my $p = Irssi::settings_get_str('gitscriptassist_path');
+ $p =~ s#/$##;
+ if ($p !~ m#^[~/]#) {
+ $path = Irssi::get_irssi_dir().'/'.$p;
+ }
+ if (! -e $path ) {
+ Irssi::print('gitscriptassist: make working dir "'.$path.'"', MSGLEVEL_CLIENTCRAP);
+ mkdir $path;
+ }
+ $startup = Irssi::settings_get_bool('gitscriptassist_startup');
+ my $bi= Irssi::settings_get_bool('gitscriptassist_integrate');
+ if ($bi==1 && $integrate != $bi) {
+ $integrate=$bi;
+ bind_cmd('script');
+ }
+}
+
+sub do_complete {
+ my ($strings, $window, $word, $linestart, $want_space) = @_;
+ my $ok;
+ foreach (@comp_start) {
+ $ok=1 if ($linestart =~ m/^$_/);
+ }
+ return unless $ok;
+
+ if ($word =~ m/^(.*:)/) {
+ @$strings = grep { m/^$word/} map {$1.$_} keys %scripts;
+ } else {
+ @$strings = grep { m/^$word/} keys %scripts;
+ }
+ $$want_space = 1;
+ Irssi::signal_stop;
+}
+
+sub bind_cmd {
+ my ($cm)=@_;
+ Irssi::command_bind($cm ,\&cmd);
+ foreach my $c (keys %scmds) {
+ Irssi::command_bind($cm .' '.$c,\&cmd);
+ foreach my $s (keys %{$scmds{$c}->{sub}}) {
+ Irssi::command_bind($cm .' '.$c.' '.$s,\&cmd);
+ }
+ }
+ foreach my $sc (keys %scmds) {
+ if (exists $scmds{$sc}->{file}) {
+ push @comp_start, "/$cm $sc";
+ }
+ foreach my $s (keys %{$scmds{$sc}->{sub}}) {
+ if (exists $scmds{$sc}->{sub}->{$s}->{file}) {
+ push @comp_start, "/$cm $sc $s";
+ }
+ }
+ }
+}
+
+sub UNLOAD {
+ write_autoload();
+}
+
+Irssi::command_bind('help', sub {
+ my @args = grep { $_ ne '' } quotewords('\s+', 0, $_[0]);
+ my $s = shift @args;
+ if ($s eq $IRSSI{name} ) {
+ scmd_help(undef, undef, @args);
+ Irssi::signal_stop;
+ }
+ }
+);
+
+
+Irssi::signal_add_first('complete word', \&do_complete);
+Irssi::signal_add('pidwait', 'sig_run_end');
+Irssi::signal_add('setup changed', 'sig_setup_changed');
+
+Irssi::settings_add_str($IRSSI{name}, 'gitscriptassist_repo', '~/foo/script-irssi');
+Irssi::settings_add_str($IRSSI{name}, 'gitscriptassist_path', 'gitscriptassist');
+Irssi::settings_add_bool($IRSSI{name}, 'gitscriptassist_startup', 0);
+Irssi::settings_add_bool($IRSSI{name}, 'gitscriptassist_integrate', 0);
+
+bind_cmd($IRSSI{name});
+
+sig_setup_changed();
+load_autoload();
+
diff --git a/scripts/go.pl b/scripts/go.pl
new file mode 100644
index 0000000..cdb5692
--- /dev/null
+++ b/scripts/go.pl
@@ -0,0 +1,115 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi;
+use Irssi::Irc;
+
+# Usage:
+# /script load go.pl
+# If you are in #irssi you can type /go #irssi or /go irssi or even /go ir ...
+# also try /go ir<tab> and /go <tab> (that's two spaces)
+#
+# The following settings exist:
+#
+# /SET go_match_case_sensitive [ON|OFF]
+# Match window/item names sensitively (the default). Turning this off
+# means e.g. "/go foo" would jump to a window named "Foobar", too.
+#
+# /SET go_match_anchored [ON|OFF]
+# Match window/names only at the start of the word (the default). Turning
+# this off will mean that strings can match anywhere in the window/names.
+# The leading '#' of channel names is optional either way.
+#
+# /SET go_complete_case_sensitive [ON|OFF]
+# When using tab-completion, match case-insensitively (the default).
+# Turning this on means that "/go foo<tab>" will *not* suggest "Foobar".
+#
+# /SET go_complete_anchored [ON|OFF]
+# Match window/names only at the start of the word. The default is 'off',
+# which causes completion to match anywhere in the window/names during
+# completion. The leading '#' of channel names is optional either way.
+#
+
+$VERSION = '1.1.1';
+
+%IRSSI = (
+ authors => 'nohar',
+ contact => 'nohar@freenode',
+ name => 'go to window',
+ description => 'Implements /go command that activates a window given a name/partial name. It features a nice completion.',
+ license => 'GPLv2 or later',
+ changed => '2019-02-25'
+);
+
+sub _make_regexp {
+ my ($name, $ci, $aw) = @_;
+ my $re = "\Q${name}\E";
+ $re = "(?i:$re)" unless $ci;
+ $re = "^#?$re" if $aw;
+ return $re;
+}
+
+sub signal_complete_go {
+ my ($complist, $window, $word, $linestart, $want_space) = @_;
+ my $channel = $window->get_active_name();
+ my $k = Irssi::parse_special('$k');
+
+ return unless ($linestart =~ /^\Q${k}\Ego\b/i);
+
+ my $re = _make_regexp($word,
+ Irssi::settings_get_bool('go_complete_case_sensitive'),
+ Irssi::settings_get_bool('go_complete_anchored'));
+ @$complist = ();
+ foreach my $w (Irssi::windows) {
+ my $name = $w->get_active_name();
+ if ($word ne "") {
+ if ($name =~ $re) {
+ push(@$complist, $name)
+ }
+ } else {
+ push(@$complist, $name);
+ }
+ }
+ Irssi::signal_stop();
+};
+
+sub cmd_go
+{
+ my($chan,$server,$witem) = @_;
+
+ my $case_sensitive = Irssi::settings_get_bool('go_match_case_sensitive');
+ my $match_anchored = Irssi::settings_get_bool('go_match_anchored');
+
+ $chan =~ s/ *//g;
+ my $re = _make_regexp($chan, $case_sensitive, $match_anchored);
+
+ my @matches;
+ foreach my $w (Irssi::windows) {
+ my $name = $w->get_active_name();
+ if (($case_sensitive && $name eq $chan) ||
+ (!$case_sensitive && CORE::fc $name eq CORE::fc $chan)) {
+ $w->set_active();
+ return;
+ } elsif ($name =~ /$re/) {
+ push(@matches, $w);
+ }
+ }
+ if (@matches) {
+ $matches[0]->set_active();
+ }
+}
+
+Irssi::command_bind("go", "cmd_go");
+Irssi::signal_add_first('complete word', 'signal_complete_go');
+Irssi::settings_add_bool('go', 'go_match_case_sensitive', 1);
+Irssi::settings_add_bool('go', 'go_complete_case_sensitive', 0);
+Irssi::settings_add_bool('go', 'go_match_anchored', 1);
+Irssi::settings_add_bool('go', 'go_complete_anchored', 0);
+
+# Changelog
+#
+# 2017-02-02 1.1 martin f. krafft <madduck@madduck.net>
+# - made case-sensitivity of match configurable
+# - made anchoring of search strings configurable
+#
+# 2019-02-025 1.1.1 dylan lloyd <dylan@disinclined.org>
+# - prefer exact channel matches
diff --git a/scripts/go2.pl b/scripts/go2.pl
new file mode 100644
index 0000000..bdae0e7
--- /dev/null
+++ b/scripts/go2.pl
@@ -0,0 +1,495 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi;
+use Irssi::TextUI;
+
+$VERSION = '1.1';
+%IRSSI = (
+ authors => 'cxreg',
+ contact => 'cxreg@pobox.com',
+ name => 'go2',
+ description => 'Switch to the window with the given name or item',
+ license => 'Public Domain',
+ url => 'http://genericorp.net/~count/irssi/go',
+ changed => '2017-05-02',
+);
+
+# Tab complete (0.8.12+)
+sub signal_complete_go {
+ my ( $complist, $window, $word, $linestart, $want_space ) = @_;
+
+ # This is cargo culted but I think it's right
+ my $k = Irssi::parse_special('$k');
+ return unless ( $linestart =~ /^\Q${k}\Ego/i );
+
+ # before we call the go command, remove the input, or else scripts like
+ # per_window_prompt.pl will save the /go call, which we don't want.
+ Irssi::gui_input_set('');
+
+ # call the go command
+ $window->command("go $word");
+
+ # we've come back from the go command and cleaned up the command line,
+ # now finish up
+ @$complist = ();
+ Irssi::signal_stop();
+}
+
+# Only do this in irssi 0.8.12 or better since input mangling didn't exist until then
+if ( Irssi::version >= 20070804 ) {
+ Irssi::signal_add_first( 'complete word', 'signal_complete_go' );
+}
+
+sub cmd_go2 {
+ my ($window, $suggestion, @matches);
+ my $buf = '';
+
+ # get a complete list of current windows
+ my @all_windows = Irssi::windows();
+
+ # Parse passed in argument
+ if ( length $_[0] ) {
+ $buf = shift;
+
+ # this messes up a quick jump to any channel or window named "help",
+ # so maybe this should be an option
+ if ( $buf eq 'help' ) {
+ _help();
+ return;
+ }
+
+ @matches = _match( $buf, @all_windows );
+
+ my @non_cur = grep { !$_->{active_win} } @matches;
+ if ( @matches and !@non_cur ) {
+ # The only match is the current window, bail out
+ return;
+ }
+
+ # First look for an (non-current) exact match
+ my @exact_matches = grep { $_->{exact} } @non_cur;
+ if ( @exact_matches == 1 ) {
+ $exact_matches[0]->{window}->set_active;
+ return;
+ }
+
+ # Then look for any single (non-current) match
+ if ( @non_cur == 1 ) {
+ $non_cur[0]->{window}->set_active;
+ return;
+ }
+
+ # If there's only 2 matches, we now know neither is current
+ # so just pick one. This is ok because the next call would
+ # "toggle" to the other. More than 2, though, and we'd end up
+ # ignoring windows
+ if ( @matches == 2 ) {
+ $matches[0]->{window}->set_active;
+ return;
+ }
+
+ # Otherwise, fall through to normal prompt
+ $suggestion = $matches[0];
+ }
+
+ while (1) {
+ # display the current input and suggestion
+ _draw_suggestion( $buf, $suggestion );
+
+ # read input one character at a time
+ my $chr = getc;
+
+ # break out on Enter
+ if ( $chr =~ /[\r\n]/ ) {
+ $window = $suggestion;
+ last;
+ }
+
+ # Esc means "stop trying"
+ elsif ( ord($chr) == 27 ) {
+ last;
+ }
+
+ # Tab to cycle through suggestions
+ elsif ( ord($chr) == 9 ) {
+ if(@matches) {
+ # get matches if we don't have any yet
+ push @matches, grep { $_ } shift @matches;
+ } else {
+ # otherwise switch to the next one
+ @matches = _match( $buf, @all_windows );
+ }
+
+ $suggestion = $matches[0];
+ }
+
+ # ^U means wipe out the input. we might want to actually read this
+ # from the user's keybinding (for erase_line or maybe erase_to_beg_of_line)
+ # instead of assuming ^U
+ elsif ( ord($chr) == 21 ) {
+ $buf = '';
+ @matches = _match( $buf, @all_windows );
+ $suggestion = undef;
+ }
+
+ # handle backspace and delete
+ elsif ( ord($chr) == 127 or ord($chr) == 8 ) {
+ # remove the last char
+ $buf = substr( $buf, 0, length($buf) - 1 );
+
+ # get suggestions again
+ if ( @matches = _match( $buf, @all_windows ) ) {
+ $suggestion = $buf ? $matches[0] : undef;
+ } else {
+ $suggestion = undef;
+ }
+ }
+
+ # regular input
+ else {
+ # create a temporary new buffer
+ my $tmp = $buf . $chr;
+
+ if ( @matches = _match($tmp, @all_windows) ) {
+ # if the new character results in a match, keep it
+ $buf = $tmp;
+ $suggestion = $buf ? $matches[0] : undef;
+ } else {
+ # vbell on mistype
+ print STDOUT "\a";
+ }
+ }
+ }
+
+ # go to the selected window if there is one
+ if ($window) {
+ $window->{window}->set_active;
+ }
+
+ # refresh the screen to get the regular prompt back if needed
+ Irssi::command('redraw')
+}
+
+Irssi::command_bind('go', 'cmd_go2', 'go2.pl');
+
+sub _draw_suggestion {
+ my ( $b, $s ) = @_;
+
+ # $b might have a space and a second token which is a tag, remove it
+ # since that's getting displayed separately anyway
+ my $tag;
+ if ( $b =~ s/ (.*)// ) {
+ $tag = $1;
+ }
+
+ my $pre = '';
+ my $post = '';
+ if ($s) {
+ # No input, entire thing is a suggestion
+ if ( !$b ) {
+ $pre = '#' . $s->{window}->{refnum} . ' ';
+ $post = $s->{string};
+ }
+ # Matched window number
+ elsif ( $s->{match_obj} eq 'number' and $s->{string} =~ /\Q$b\E/i ) {
+ $pre = '#' . $`;
+ $post = $' . ' ' . ( $s->{window}->{active}->{name} || $s->{window}->{name} );
+ }
+ # Matched 'tag' (network or server)
+ elsif ( $s->{match_obj} eq 'tag' and $s->{string} =~ /\Q$b\E/i ) {
+ $pre = '#' . $s->{window}->{refnum} . ' ' .
+ ( $s->{window}->{active}->{name} || $s->{window}->{name} ) . " ($`";
+ $post = "$')";
+ }
+ # Matched window or item name
+ elsif ( $s->{string} =~ /\Q$b\E/i ) {
+ $pre = '#' . $s->{window}->{refnum} . ' ' . $`;
+ $post = $';
+ }
+
+ # special case 'tag'. maybe this should be moved up into the case blocks
+ unless ( $s->{match_obj} eq 'tag' ) {
+ my $window_tag = $s->{window}->{active_server}->{tag};
+ if ( $window_tag ) {
+ if ( $tag ) {
+ if ( $window_tag =~ /^\Q$tag\E/i ) {
+ $post .= " ([/i]${tag}[i]$')"
+ } else {
+ print "BUG! Window had tag '$window_tag' and should have matched '$tag' but didn't!";
+ }
+ } else {
+ $post .= " ($window_tag)";
+ }
+ }
+ }
+ }
+
+ # ANSI escapes
+ my $inv = "\x{1b}[7m";
+ my $no_inv = "\x{1b}[0m";
+
+ # Fix up inverse for pre and post text
+ if($pre) {
+ $pre = "[i]${pre}[/i]";
+ $pre =~ s/\[i\]/$inv/ig;
+ $pre =~ s/\[\/i\]/$no_inv/ig;
+ }
+ if($post) {
+ $post = "[i]${post}[/i]";
+ $post =~ s/\[i\]/$inv/ig;
+ $post =~ s/\[\/i\]/$no_inv/ig;
+ }
+
+ # FIXME - there has to be a "right way" to do this.
+ # it looks like the fe-text/gui-readline.c and gui-entry.c
+ # (and other gui-*) are not XS wrapped for whatever reason.
+ print STDOUT "\r" . ' 'x40 . "\rGoto: ";
+
+ print STDOUT $pre if $pre; # before
+ print STDOUT $b; # the matched string
+ print STDOUT $post if $post; # after
+}
+
+sub _match {
+ my ( $name, @wins ) = @_;
+ my @matches;
+
+ # $name might have a space and a second token which is a tag, remove it
+ # and try to match the window tag
+ my $tag;
+ if ( $name =~ s/ (.*)// ) {
+ $tag = $1;
+ }
+
+ my $awr = Irssi::active_win()->{refnum};
+ for (@wins) {
+ # Only add each window once, and prefer item, name, number, then tag
+ my @c;
+
+ # items
+ if (
+ length $_->{active}->{name}
+ and (
+ (
+ @c = $_->{active}->{name} =~ /(^(#)?)?\Q$name\E($)?/i
+ and (
+ # Match the network token if one was entered
+ !$tag
+ or (
+ defined $_->{active_server}->{tag}
+ and $_->{active_server}->{tag} =~ /^\Q$tag\E/i
+ )
+ )
+ )
+ # If we have an item name but no input, use the item name as the match string
+ or !length($name)
+ )
+ ) {
+ push @matches, {
+ string => $_->{active}->{name},
+ window => $_,
+ match_obj => 'item',
+ anchored => ( defined $c[0] and !defined $c[1] ),
+ near_anchored => ( defined $c[0] and defined $c[1] ),
+ exact => ( defined $c[0] and !defined $c[1] and defined $c[2] ),
+ active_win => ( $awr == $_->{refnum} ),
+ # ignore non-chat activity
+ activity => ( $_->{data_level} > 1 ? $_->{data_level} : 0 ),
+ };
+ next;
+ }
+
+ # window names
+ if (
+ length $_->{name}
+ and (
+ (
+ @c = $_->{name} =~ /(^(#)?)?\Q$name\E($)?/i
+ and (
+ # Match the network token if one was entered
+ !$tag
+ or (
+ defined $_->{active_server}->{tag}
+ and $_->{active_server}->{tag} =~ /^\Q$tag\E/i
+ )
+ )
+ )
+ # If we have an window name but no input, use the window name as the match string
+ or !length($name)
+ )
+ ) {
+ push @matches, {
+ string => $_->{name},
+ window => $_,
+ match_obj => 'name',
+ anchored => ( defined $c[0] and !defined $c[1] ),
+ # this is not really so useful for names, but it doesn't really hurt either
+ near_anchored => ( defined $c[0] and defined $c[1] ),
+ exact => ( defined $c[0] and !defined $c[1] and defined $c[2] ),
+ active_win => ( $awr == $_->{refnum} ),
+ # ignore non-chat activity
+ activity => ( $_->{data_level} > 1 ? $_->{data_level} : 0 ),
+ };
+ next;
+ }
+
+ # window numbers
+ if (
+ defined $_->{refnum}
+ and @c = $_->{refnum} =~ /(^)?\Q$name\E($)?/i
+ and (
+ # Match the network token if one was entered
+ !$tag
+ or (
+ defined $_->{active_server}->{tag}
+ and $_->{active_server}->{tag} =~ /^\Q$tag\E/i
+ )
+ )
+ ) {
+ push @matches, {
+ string => $_->{refnum},
+ window => $_,
+ match_obj => 'number',
+ anchored => defined $c[0],
+ exact => ( defined $c[0] and defined $c[1] ),
+ active_win => ( $awr == $_->{refnum} ),
+ # ignore non-chat activity
+ activity => ( $_->{data_level} > 1 ? $_->{data_level} : 0 ),
+ };
+ next;
+ }
+
+ # network names
+ if (
+ defined $_->{active_server}->{tag}
+ and @c = $_->{active_server}->{tag} =~ /(^)?\Q$name\E($)?/i
+
+ # This doesn't seem to make a lot of sense but it makes for a
+ # weird user experience without it, particularly on tab
+ # cycling
+ and (
+ !$tag
+ or $_->{active_server}->{tag} =~ /^\Q$tag\E/i
+ )
+ ) {
+ # don't add by tag if we've already got
+ push @matches, {
+ string => $_->{active_server}->{tag},
+ window => $_,
+ match_obj => 'tag',
+ anchored => defined $c[0],
+ exact => ( defined $c[0] and defined $c[1] ),
+ active_win => ( $awr == $_->{refnum} ),
+ # ignore non-chat activity
+ activity => ( $_->{data_level} > 1 ? $_->{data_level} : 0 ),
+ };
+ next;
+ }
+ }
+
+ # Try to sort intelligently. Without input, order by window number. Otherwise,
+ # put exact matches in front, then anchored matches, then alpha sort. However,
+ # try not to suggest the currently selected window as the first choice. In addition,
+ # we'll give preference to active windows.
+ #
+ # Here is a chart of the currently implemented sorting behavior:
+ #
+ # * exact match (items, names, and numbers)
+ # - activity level
+ # - items, then names, then numbers
+ #
+ # * anchored (items, names, and numbers)
+ # - activity level
+ # - items, then names, then numbers
+ #
+ # * near-anchored (without leading #) (items and names)
+ # - activity level
+ # - items, then names
+ #
+ # * exact for networks
+ # - activity level
+ #
+ # * anchored for networks
+ # - activity level
+ #
+ # * activity level
+ #
+ # * alphabetical
+ #
+ @matches = sort {
+ my $which;
+ if ( !length($name) ) {
+ # no input, sort by number with preference to active windows
+ $which =
+ $b->{activity} <=> $a->{activity} ||
+ $a->{window}->{refnum} <=> $b->{window}->{refnum};
+ } else {
+ COMPARE: for my $objects ( [ 'item', 'name', 'number' ], [ 'tag' ] ) {
+ my $i;
+ my %object_rank = map { $_ => ++$i } @$objects;
+ for my $match ( 'exact', 'anchored', 'near_anchored' ) {
+
+ # Make sure at least one is one of the desired match objects
+ my $a_mo = grep { $_ eq $a->{match_obj} } @$objects;
+ my $b_mo = grep { $_ eq $b->{match_obj} } @$objects;
+ next unless $a_mo || $b_mo;
+
+ # Make sure at least one is the current match type
+ next unless $a->{$match} || $b->{$match};
+
+ last COMPARE if $which =
+ # if only one is a preferred match object
+ $b_mo <=> $a_mo ||
+
+ # if only one is the current match type
+ $b->{$match} <=> $a->{$match} ||
+
+ # Since both are the same level of match, bump up more active windows
+ $b->{activity} <=> $a->{activity} ||
+
+ # Same activity, order by object ranking (lower is better)
+ $object_rank{$a->{match_obj}} <=> $object_rank{$b->{match_obj}};
+ }
+ }
+ # If we couldn't differentiate by now, bump current window to the bottom,
+ # sort by activity, and then alphabetically
+ $which =
+ $a->{active_win} <=> $b->{active_win} ||
+ $b->{activity} <=> $a->{activity} ||
+ $a->{string} cmp $b->{string}
+ unless $which;
+
+ }
+ $which;
+ } @matches;
+
+ return @matches;
+}
+
+sub _help {
+ print<<HELP;
+Go - jump directly to the correct destination
+
+Usage:
+ /go [destination]
+
+ The argument is optional, and if it is not provided or is ambiguous, you will be
+ sent to a prompt where you type in a few numbers or letters of the window name,
+ item (channel, nickname), window number, or connected network. Once you have input
+ that matches one or more possible destinations, Go will print in inverse text what
+ it thinks you are looking for. If there are multiple, the tab key will cycle through
+ them. Press enter when you see the correct window to switch to it.
+
+ If you are using irssi 0.8.12 or better, you can tab complete from the input line
+ without having to press enter first.
+
+ If your destination has a second word (/go foo bar), then the second word (eg 'bar')
+ is assumed to be the network name, which is useful for disambiguation. This works
+ both with input to /go and for text typed at the Goto: prompt.
+
+ You may find it useful to bind this action to a keystroke to expedite movement, which
+ will forego any argument and take you directly to the prompt:
+
+ /bind meta-w /go
+HELP
+}
diff --git a/scripts/google.pl b/scripts/google.pl
new file mode 100644
index 0000000..84de848
--- /dev/null
+++ b/scripts/google.pl
@@ -0,0 +1,224 @@
+# - Google.pl
+use Irssi;
+use Getopt::Long qw/GetOptionsFromString/;
+use IPC::Open3;
+use JSON::PP;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '2.01';
+%IRSSI = (
+ authors => 'bw1',
+ contact => 'bw1@aol.at',
+ name => 'google',
+ description => 'This script queries google.com with googler and returns the results.',
+ license => 'Public Domain',
+ url => 'https://scripts.irssi.org/',
+ modules => '',
+ commands=> 'google',
+ selfcheckcmd=> 'google -check',
+);
+
+my $help = << "END";
+%9Name%9
+ $IRSSI{name}
+%9Version%9
+ $VERSION
+%9Usage%9
+ /google [-N|-news] [-x|-exact] [-c|-tld TLD] [-l|-lang LANG]
+ [-n|-count N] [-s|-start] <KEYWORD>
+ /google {-h|-help}
+ /google {-p|-say N}
+ /google -check
+%9Description%9
+ $IRSSI{description}
+ first author: Oddbjørn Kvalsund
+%9Arguments%9
+ -N|-news show results from news section
+ -x|-exact disable automatic spelling correction
+ -c|-tld country-specific search with top-level domain
+ -l|-lang display in language LANG
+ -n|-count show N results (default 10)
+ -s|-start start at the Nth result
+ -h|-help show this help message
+ -p|-say say the N url in channel
+ -check self check
+%9See also%9
+ https://github.com/jarun/googler
+END
+
+my ($copt, $tld, $lang, $count, $start, $chelp, $say, $check);
+my %options = (
+ 'N'=> sub {$copt .= '--news '},
+ 'news'=> sub {$copt .= '--news '},
+ 'x'=> sub {$copt .= '--exact '},
+ 'exact'=> sub {$copt .= '--exact '},
+ 'c=s'=> \$tld,
+ 'tld=s'=> \$tld,
+ 'l=s'=> \$lang,
+ 'lang=s'=> \$lang,
+ 'n=o' => \$count,
+ 'count=o' => \$count,
+ 's=o' => \$start,
+ 'start=o' => \$start,
+ 'h' => \$chelp,
+ 'help' => \$chelp,
+ 'p=o' => \$say,
+ 'say=o' => \$say,
+ 'check' => \$check,
+);
+
+## Usage:
+## /google [-p, prints to current window] [-<number>, number of searchresults returned] search-criteria1 search-criteria2 ...
+##
+## History:
+## - Sun May 19 2002
+## Version 0.1 - Initial release
+## - 2019-08-04
+## Version 2.0 - Change to googler
+## - 2021-01-26
+## Version 2.01 - self check
+## -------------------------------
+
+my (%readex, $instr, $errstr, @res);
+
+sub read_exec {
+ my ($cmd, $rfunc) = @_;
+
+ my ($in, $out, $err);
+ use Symbol 'gensym'; $err = gensym;
+ my $pid = open3($in, $out, $err, $cmd);
+ $readex{$pid}->{pid}=$pid;
+ $readex{$pid}->{cmd}=$cmd;
+ $readex{$pid}->{in}=$in;
+ $readex{$pid}->{out}=$out;
+ $readex{$pid}->{err}=$err;
+ $readex{$pid}->{rfunc}=$rfunc;
+
+ Irssi::pidwait_add($pid);
+}
+
+sub sig_read_exec {
+ my ($pid, $status) = @_;
+
+ if (defined $readex{$pid} ) {
+ my $out =$readex{$pid}->{out};
+ my $err =$readex{$pid}->{err};
+ my $rfunc =$readex{$pid}->{rfunc};
+
+ delete $readex{$pid};
+
+ my $old = select $out;
+ local $/;
+ $instr = <$out>;
+ select $old;
+
+ my $old = select $err;
+ local $/;
+ $errstr = <$err>;
+ $errstr =~ s/[\n\r]//g;
+ select $old;
+
+ &$rfunc() if (defined $rfunc);
+ if ( scalar(keys(%readex)) == 1 &&
+ exists $readex{job}) {
+ foreach my $j ( @{$readex{job}} ) {
+ if ( ref( $j) eq 'CODE' ) {
+ &$j();
+ } else {
+ eval( $j );
+ }
+ }
+ delete $readex{job};
+ }
+ Irssi::signal_stop();
+ }
+}
+
+sub cmd {
+ my ($args, $server, $witem)=@_;
+ Getopt::Long::Configure('no_ignore_case');
+ my ($ret, $arg) = GetOptionsFromString($args, %options);
+ if ($ret) {
+ if (defined $chelp) {
+ cmd_help($IRSSI{name}, $server, $witem);
+ } elsif (defined $say) {
+ if ($say >0 && $say <= scalar(@res)) {
+ Irssi::active_win()->command("say $res[$say-1]->{url}");
+ }
+ } else {
+ my $cmd="googler --json ";
+ $cmd .="--tld $tld " if (defined $tld);
+ $cmd .="--lang $lang " if (defined $lang);
+ $cmd .="--count $count " if (defined $count);
+ $cmd .="--start $start " if (defined $start);
+ $cmd .="irssi " if (defined $check);
+ $cmd .="$copt " if (defined $copt);
+ $cmd .=join(" ",@{$arg});
+ Irssi::print(">$cmd<", MSGLEVEL_CLIENTCRAP);
+ read_exec($cmd ,\&print_all);
+ }
+ }
+ $copt=undef;
+ $tld=undef;
+ $lang=undef;
+ $count=undef;
+ $start=undef;
+ $chelp=undef;
+ $say=undef;
+}
+
+sub self_check {
+ my @r =@_;
+ my $s="ok";
+ $check=undef;
+ Irssi::print("Selfcheck: results: ".scalar @r);
+ Irssi::print("Selfcheck: url: ".$r[0]->{url});
+ Irssi::print("Selfcheck: title: ".$r[0]->{title});
+ if ( scalar(@r) < 6 ) {
+ $s="Error: results (".scalar @r.")";
+ } elsif ( $r[0]->{url} !~ m/^http/ ) {
+ $s="Error: url (".$r[0]->{url}.")";
+ } elsif ( length($r[0]->{title}) < 4) {
+ $s="Error: title (".$r[0]->{title}.")";
+ }
+ Irssi::print("Selfcheck: $s");
+ my $schs_version = $Irssi::Script::selfcheckhelperscript::VERSION;
+ Irssi::command("selfcheckhelperscript $s") if ( defined $schs_version );
+}
+
+sub print_all {
+ if( length($errstr) <1 ) {
+ @res= @{decode_json($instr)};
+ self_check(@res) if (defined $check);
+ Irssi::print("/---- google ----", MSGLEVEL_CLIENTCRAP);
+ my $c=1;
+ foreach my $r (@res) {
+ my $s= sprintf("| %3d ",$c) . $r->{title};
+ Irssi::print($s, MSGLEVEL_CLIENTCRAP);
+ $s="| ". $r->{url};
+ Irssi::print($s, MSGLEVEL_CLIENTCRAP);
+ $c++;
+ }
+ Irssi::print('\---- google ----', MSGLEVEL_CLIENTCRAP);
+ } else {
+ Irssi::print($errstr, MSGLEVEL_CLIENTCRAP);
+ }
+}
+
+sub cmd_help {
+ my ($args, $server, $witem)=@_;
+ $args=~ s/\s+//g;
+ if ($IRSSI{name} eq $args) {
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop();
+ }
+}
+
+$ENV{PYTHONIOENCODING}='utf8';
+Irssi::signal_add('pidwait', 'sig_read_exec');
+
+Irssi::command_bind('google', 'cmd');
+my @opt=map {$_ =~ s/=.*$//, $_ } keys %options;
+Irssi::command_set_options($IRSSI{name}, join(" ", @opt));
+Irssi::command_bind('help', \&cmd_help);
diff --git a/scripts/gpgvalidator.pl b/scripts/gpgvalidator.pl
new file mode 100644
index 0000000..cce231d
--- /dev/null
+++ b/scripts/gpgvalidator.pl
@@ -0,0 +1,224 @@
+# _ _ _ _
+# __ _ _ __ __ ___ ____ _| (_) __| | __ _| |_ ___ _ __
+# / _` | '_ \ / _` \ \ / / _` | | |/ _` |/ _` | __/ _ \| '__|
+# | (_| | |_) | (_| |\ V / (_| | | | (_| | (_| | || (_) | |
+# \__, | .__/ \__, | \_/ \__,_|_|_|\__,_|\__,_|\__\___/|_|
+# |___/|_| |___/
+#
+# for irssi - VERSION 0.1.3
+#
+# this is a nice irssi's script coded by pallotron
+# based on a lovely implementation writed by valvoline for xchat client
+#
+# valv`0 (valvoline@vrlteam.org / valvoline@freaknet.org)
+# pallotron (pallotron@freaknet.org)
+#
+# original idea & implementation by: valv'0
+#
+# valv`0 thanx goes to:
+# asbesto, pallotron, quest, iron - for the development support
+# hellbreak, cmcsynth, hio, mircalla - for the moral support
+#
+# it allows you to do gpg trusting of your friends using gnupg and irc
+# capabilities. in order to use it, you have to load the script into irssi
+# (read man pages or go to irssi.org do know how do this). others users must
+# have loaded this script or another compatible script.
+#
+# FAKE--
+# PARANOIA!++ o/
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# USAGE:
+# If you want to trust a your friend you must do this:
+# 1) simply type /validate <your_friend_nick>
+# 2) accept DCC Send (a chunck file containing gpg sign)
+# 3) type /verify <your_friend_nick>:)
+#
+# To permit your trusting by other users you must do:
+# 1) type /setpass <your_gpg_passphrase>
+# 2) enjoy!
+# Now your irssi is listening for ctcp messages
+#
+# WARING!!!!!!!
+# this isn't a *FULL SECURE* script, better improvements must follow *SOON*!
+#
+# pallotron 23/09/2002 - pallotron@freaknet.org - www.freaknet.org
+
+use Irssi;
+use Irssi qw(command_bind active_server);
+
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+my $PASS = "NULL";
+my $VALIDATEDIR = "~/";
+
+$VERSION = "0.1.3";
+%IRSSI = (
+ authors=> 'original idea by valvoline, irssi porting by pallotron',
+ contact=> 'pallotron@freaknet.org',
+ name=> 'gpgvalidator v. 0.1.3',
+ description=> 'Have gpg-based trusting features in your irssi client!',
+ license=> 'GPL v2',
+ url=> 'http://www.freaknet.org/~pallotron',
+);
+
+Irssi::print("Loading irssi pallotron's porting of valvoline gpgvalidator 0.1.3");
+
+# create a new irssi command called /PASSPHRASE
+# USAGE:
+# /PASSPHRASE <your_GPG_pass>
+Irssi::command_bind('setpass','setpass');
+
+# create a new irssi command called /VERIFY
+# no particolare USAGE FORMAT
+# just call it with /VERIFY
+# it will verify the last <NICK>.asc file
+# download by the latest ctcp VALIDATE request
+Irssi::command_bind('verify','sub_verify');
+
+# send a ctcp VALIDATE request to a friend we want to trust
+#
+# USAGE: /validate <nick>
+Irssi::command_bind('validate','send_ctcp_request');
+
+# hook sub_validate function to signal 'ctcp msg'.
+# when your client receives /ctcp msg <your_nick> VALIDATE
+# it will performs some controls and then send, via DCC, a randomic
+# generated chunck file (yournick.asc) containing your gpg signature
+# to $nick (the user who had request validating)
+Irssi::signal_add('ctcp msg','ctcp_send_chunck_file');
+
+Irssi::command_bind('about','about');
+Irssi::command_bind('greets','greets');
+Irssi::command_bind('manual','manual');
+Irssi::command_bind('erasepass','erasepass');
+
+sub send_ctcp_request {
+ my $line = shift;
+ if(!($line)) {
+ Irssi::print("validate - wrong parameters:\nusage: validate <nick>");
+ return 0;
+ }
+ active_server->command("/ctcp $line VALIDATE");
+ return 0;
+}
+
+sub erasepass {
+ $PASS="";
+ Irssi::print("gpgvalidator - pass forgotten");
+ return 0;
+}
+
+sub ctcp_send_chunck_file {
+ my ( $infos, $cmd, $nick, $host, $target) = @_;
+
+ my $test = $target;
+
+ $test =~ tr/\W/_/;
+ $test =~ tr/`/_/;
+ $test =~ tr/{/_/;
+ $test =~ tr/}/_/;
+ $test =~ tr/|/_/;
+ $test =~ tr/\\/_/;
+
+ if ( $cmd =~ /^VALIDATE/) {
+ if ( $PASS =~ /NULL/i ) {
+ Irssi::print("requested GPG-VALIDATE from $nick, but no passphrase in cache!\nplz, set a passphrase with /setpass <your_gpg_pass>");
+ return 1;
+ } else {
+ Irssi::print("requested GPG-VALIDATE from $nick\n");
+ my $result = `openssl rand -out $VALIDATEDIR/$test 1024`;
+ $result = `echo "$PASS" | gpg --batch --yes --status-fd 1 --passphrase-fd 0 --output $VALIDATEDIR/$test.asc --clearsign $VALIDATEDIR/$test | grep "[GNUPG:]"`;
+ if (( my $i = index($result,"GOOD_PASSPHRASE")) > -1) {
+ active_server->command("/DCC send $nick $VALIDATEDIR/$test.asc");
+ $result = `echo "$result" | grep "SIG_CREATED"`;
+ Irssi::print("\n$result\n");
+ }
+ if (( my $i = index($result,"BAD_PASSPHRASE")) > -1) {
+ $result = `echo "$result" | grep "BAS_PASSPHRASE"`;
+ Irssi::print("$result\nBAD passphrase - cannot unlock your secret keyring - please set a passprase with /setpass <yourpass>\n");
+ }
+ }
+ return 0;
+ }
+}
+
+# this take the passphrase
+# OH MY GOD! THESE ARE VERY STUPID ROWS...
+# expecially from security side... :)
+sub setpass {
+ my $line = shift;
+ if(!($line)) {
+ Irssi::print("setpass - wrong paramaters:\nusage: setpass <yourpass>");
+ return 0;
+ }
+ $PASS = $line;
+ # can i do better of this? ;p
+ Irssi::print("gpgvalidator - pass set correctly");
+ return 0;
+}
+
+# this verify che <nick>.asc signed file trusting if the user
+# is in your keyring
+#
+# usage /verify <nick>
+#
+sub sub_verify {
+
+ my $result = "";
+ my $test = shift;
+
+ if(!($test)) {
+ Irssi::print("verify wrong parameters:\nusage: verifi <nick>");
+ return 0;
+ }
+
+ $test =~ tr/\W/_/;
+ $test =~ tr/`/_/;
+ $test =~ tr/{/_/;
+ $test =~ tr/}/_/;
+ $test =~ tr/|/_/;
+ $test =~ tr/\\/_/;
+
+ $result = `gpg --batch --status-fd 1 --verify $VALIDATEDIR/$test.asc 2>/dev/null | grep "[GNUPG:]"`;
+ if (( my $i = index($result,"GOODSIG")) > -1) {
+ $result = `echo "$result" | grep "GOODSIG"`;
+ Irssi::print("good signature! - user trusted - $result\n");
+ }
+ else {
+ Irssi::print("bad signature! - user UNtrusted\n$result\n");
+ }
+ return 0;
+}
+
+sub about {
+ Irssi::print("\n-------------------------------------------------------\nGPG validator v0.1.3 for irssi coded in perl by pallotron\n-------------------------------------------------------\n(c) 2002 - valvoline / VRL Team - valvoline\@vrlteam.org\nported to irssi by pallotron\@freaknet.org\n-------------------------------------------------------\nthis's a simple script to validate users under irc, \nusing gpg. there're NO optimization, and the code was\nwritten in 10mins!. i'm not a perl-programmer, so...\n...fill free to make mods to the code, but, leave the\noriginal credits at the same place (=\n\ntype /greets to see greets!\n\ntype /manual to see user-manual\n");
+ return 1;
+}
+
+sub greets {
+ Irssi::print("\n-------------------------------------------------------\ngreets fly out to the following:\nasbesto, pallotron, iron, quest - for beta testing support.\nhellbreak, cmcsynth, hio, mirc4ll4 - for moral and economic support (ehehe).\ns0ftpj staff - for the besta coding support ever made.\n\nall the other, that i've forgotten...sorry! :(\n\n-------------------------------------------------------\n");
+ return 1;
+}
+
+sub manual {
+ Irssi::print("\n-------------------------------------------------------\n\nmanual\n\nsetpass <pass> - to cache your password for the current session.\nerasepass - to forgot current password.\nvalidate <nick> - to request a validator-chunck to nick.\nverify <nick> - to verify the received validator-chunck of nick.\n\nbe sure, to have the DCC workin' correctly\n\n-------------------------------------------------------\n");
+ return 1;
+}
+
+
diff --git a/scripts/grep.pl b/scripts/grep.pl
new file mode 100644
index 0000000..35ce15c
--- /dev/null
+++ b/scripts/grep.pl
@@ -0,0 +1,82 @@
+# /GREP [-i] [-w] [-v] [-F] <perl-regexp> <command to run>
+#
+# -i: match case insensitive
+# -w: only print matches that form whole words
+# -v: Invert the sense of matching, to print non-matching lines.
+# -F: match as a fixed string, not a regexp
+#
+# if you want /FGREP, do: /alias FGREP GREP -F
+
+use Irssi;
+use strict;
+use Text::ParseWords;
+use vars qw($VERSION %IRSSI);
+$VERSION = "2.1";
+%IRSSI = (
+ authors => "Timo \'cras\' Sirainen, Wouter Coekaerts",
+ contact => "tss\@iki.fi, wouter\@coekaerts.be",
+ name => "grep",
+ description => "/GREP [-i] [-w] [-v] [-F] <perl-regexp> <command to run>",
+ license => "Public Domain",
+ url => "http://wouter.coekaerts.be/irssi/",
+ changed => "2008-01-13"
+);
+
+my ($match, $v);
+
+sub sig_text {
+ my ($dest, $text, $stripped_text) = @_;
+ Irssi::signal_stop() if (($stripped_text =~ /$match/) == $v);
+}
+
+sub cmd_grep {
+ my ($data,$server,$item) = @_;
+ my ($option,$cmd,$i,$w,$F);
+ $v = 0;
+ $F = 0;
+
+ # split the arguments, keep quotes
+ my (@args) = &quotewords(' ', 1, $data);
+
+ # search for options
+ while ($args[0] =~ /^-/) {
+ $option = shift(@args);
+ if ($option eq '-i') {$i = 1;}
+ elsif ($option eq '-v') {$v = 1;}
+ elsif ($option eq '-w') {$w = 1;}
+ elsif ($option eq '-F') {$F = 1;}
+ else {
+ Irssi::print("Unknown option: $option",MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ }
+
+ # match = first argument, but remove quotes
+ ($match) = &quotewords(' ', 0, shift(@args));
+ # cmd = the rest (with quotes)
+ $cmd = join(' ',@args);
+
+ # check if the regexp is valid
+ eval { qr/$match/ };
+ if($@) { # there was an error
+ chomp $@;
+ Irssi::print($@,MSGLEVEL_CLIENTERROR);
+ return;
+ }
+
+ if ($F) {
+ $match =~ s/(\(|\)|\[|\]|\{|\}|\\|\*|\.|\?|\|)/\\$1/g;
+ }
+ if ($w) {
+ $match = '\b' . $match . '\b';
+ }
+ if ($i) {
+ $match = '(?i)' . $match;
+ }
+
+ Irssi::signal_add_first('print text', 'sig_text');
+ Irssi::signal_emit('send command', $cmd, $server, $item);
+ Irssi::signal_remove('print text', 'sig_text');
+}
+
+Irssi::command_bind('grep', 'cmd_grep');
diff --git a/scripts/guts.pl b/scripts/guts.pl
new file mode 100644
index 0000000..a1288c0
--- /dev/null
+++ b/scripts/guts.pl
@@ -0,0 +1,21 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi qw(signal_add_last settings_add_bool settings_add_str
+ settings_get_bool settings_get_str);
+$VERSION = '1.00';
+%IRSSI = (
+ authors => 'Juerd',
+ contact => 'juerd@juerd.nl',
+ name => 'German Uppercased Tab Stuff',
+ description => 'Adds the uppercased version of the tab completes',
+ license => 'Public Domain',
+ url => 'http://juerd.nl/irssi/',
+ changed => 'Sat May 18 21:40 CET 2002',
+);
+
+signal_add_last 'complete word' => sub {
+ my ($complist, $window, $word, $linestart, $want_space) = @_;
+ push @$complist, ucfirst $word;
+}
+
diff --git a/scripts/hddtemp.pl b/scripts/hddtemp.pl
new file mode 100644
index 0000000..8563e97
--- /dev/null
+++ b/scripts/hddtemp.pl
@@ -0,0 +1,183 @@
+########
+# INFO
+#
+# Type this to add the item:
+#
+# /statusbar window add hddtemp
+#
+# See
+#
+# /help statusbar
+#
+#
+# If you want to use this script install the hddtemp daemon on the host
+# you like to monitor and set it up, You can use multiple hosts aswell.
+#
+# Example:
+# /set hddtemp_hosts host1 host2 host3
+# /set hddtemp_ports 7634 7635 7553
+#
+# If all the daemons run all on the same port you can set a single port,
+# It will be used for all hosts.
+#
+# Example:
+# /set hddtemp_ports 7634
+#
+# There are 2 coloring threshold settings hddtemp_threshold_green
+# and hddtemp_threshold_red. If the temperature is higher than
+# green and lower then red the color will be yellow.
+#
+# Example:
+# /set hddtemp_threshold_green 35
+# /set hddtemp_threshold_red 45
+#
+# (I don't know if the unit retured by the daemon depends on the
+# locale. I've Celsius values here.)
+#
+#
+# There is a setting for the degree sign.
+# Since there is a difference between 8bit and utf-8
+# you can set it to what you prefer
+#
+########
+# CHANGES:
+# 0.13 - added forking (not blocking irrsi while fetching the temperatures)
+#######
+# TODO: themeing support
+#
+
+use strict;
+use Irssi;
+use Irssi::TextUI;
+use IO::Socket::INET;
+use POSIX;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.15";
+%IRSSI = (
+ authors => "Valentin Batz",
+ contact => "vb\@g-23.org",
+ name => "hddtemp",
+ description => "adds a statusbar item which shows temperatures of harddisks (with multiple hddtemp-hosts support)",
+ license => "GPLv2",
+ changed => "2017-03-16",
+ url => "http://hurzelgnom.bei.t-online.de/irssi/scripts/hddtemp.pl",
+ sbitems => "hddtemp"
+);
+
+my $forked;
+my $pipe_tag;
+my $outstring = 'hddtemp...';
+
+sub get_data {
+ my $lines;
+ my @hosts = split(/ /, Irssi::settings_get_str("hddtemp_hosts"));
+ my @ports = split(/ /, Irssi::settings_get_str("hddtemp_ports"));
+ print "hi";
+ while(scalar(@hosts) > scalar(@ports)){
+ push @ports, @ports[0];
+ }
+ my $i=0;
+ for ($i;$i<scalar(@hosts);$i++) {
+ my $sock = IO::Socket::INET->new(PeerAddr => @hosts[$i],
+ PeerPort => @ports[$i],
+ Proto => 'tcp',
+ Timeout => 10);
+ #skip dead hosts
+ next unless $sock;
+ while( $_ = $sock->getline()) {
+ $lines .= $_.';';
+ }
+ }
+ return $lines;
+}
+
+sub get_temp {
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ return if $forked;
+ my $pid = fork();
+ if (!defined($pid)) {
+ Irssi::print("Can't fork() - aborting");
+ close($rh); close($wh);
+ return;
+ }
+ $forked = 1;
+ if ($pid > 0) {
+ #parent
+ close($wh);
+ Irssi::pidwait_add($pid);
+ $pipe_tag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, $rh);
+ return;
+ }
+
+ my $lines;
+ eval {
+ #child
+ $lines = get_data();
+ #write the reply
+ print ($wh $lines);
+ close($wh);
+ };
+ POSIX::_exit(1);
+}
+
+sub pipe_input {
+ my $rh=shift;
+ my $linesx=<$rh>;
+ close($rh);
+ Irssi::input_remove($pipe_tag);
+ $forked = 0;
+ my %temps;
+ my $green = Irssi::settings_get_int("hddtemp_threshold_green");
+ my $red = Irssi::settings_get_int("hddtemp_threshold_red");
+ my $degree = Irssi::settings_get_str("hddtemp_degree_sign");
+ unless ($linesx) {
+ return(0);
+ }
+ my ($hdd, $model, $temp, $unit);
+ my $i=0;
+ foreach my $lines (split(';', $linesx)) {
+ foreach my $line (split(/\|\|/, $lines)) {
+ #remove heading/traling |
+ $line =~ s/^\|//;
+ $line =~ s/\|$//;
+
+ ($hdd, $model, $temp, $unit) = split(/\|/,$line,4);
+
+ $hdd =~ s/(.*)\/(.*)$/$2/;
+ #different colors for different termperatures
+ if ($temp <= $green) {
+ $temps{$i.':'.$hdd} = '%g'.$temp.'%n'.$degree.$unit;
+ } elsif ($temp > $green && $temp < $red) {
+ $temps{$i.':'.$hdd} = '%y'.$temp.'%n'.$degree.$unit;
+ } elsif ($temp >= $red) {
+ $temps{$i.':'.$hdd} = '%r'.$temp.'%n'.$degree.$unit;
+ }
+ }
+ $i++;
+ }
+ my $out='';
+ foreach (sort keys %temps) {
+ $out .= "$_: $temps{$_} ";
+ }
+ $out=~s/\s+$//;
+ # temporal use of $out to prevent statusbar drawing errors
+ $outstring=$out;
+ Irssi::statusbar_items_redraw('hddtemp');
+}
+
+sub sb_hddtemp() {
+ my ($item, $get_size_only) = @_;
+ $item->default_handler($get_size_only, "{sb $outstring}", undef, 1);
+}
+
+Irssi::timeout_add(15000, \&get_temp, undef);
+Irssi::statusbar_item_register('hddtemp', undef, 'sb_hddtemp');
+Irssi::settings_add_str("hddtemp", "hddtemp_hosts","localhost");
+Irssi::settings_add_str("hddtemp", "hddtemp_ports","7634");
+Irssi::settings_add_int("hddtemp", "hddtemp_threshold_green", 35);
+Irssi::settings_add_int("hddtemp", "hddtemp_threshold_red", 45);
+Irssi::settings_add_str("hddtemp", "hddtemp_degree_sign","°");
+Irssi::signal_add("setup changed", \&get_temp);
+get_temp();
diff --git a/scripts/hello.pl b/scripts/hello.pl
new file mode 100644
index 0000000..e1dcd19
--- /dev/null
+++ b/scripts/hello.pl
@@ -0,0 +1,55 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+
+$VERSION = '1.00';
+%IRSSI = (
+ authors => 'Cybertinus',
+ contact => 'cybertinus@cybertinus.nl',
+ name => 'Greeter',
+ description => 'This script allows ' .
+ 'you to greet the channel ' .
+ 'You\'re joining with the ' .
+ 'command /hello. The text ' .
+ 'it shows depends on the time ' .
+ 'you\'re living.',
+ license => 'GPL2',
+ changed => "2005-05-25 13:42:00 GMT+1+DST"
+);
+
+sub hello
+{
+ my($data, $server, $witem, $time, $text) = @_;
+ return unless $witem;
+ # $witem (window item) may be undef.
+
+ # getting the current hour off the day
+ $time = (localtime(time))[2];
+
+ if($time >= 18)
+ {
+ $text = Irssi::settings_get_str("evening_message");
+ }
+ elsif($time >= 12)
+ {
+ $text = Irssi::settings_get_str("afternoon_message");
+ }
+ elsif($time >= 6)
+ {
+ $text = Irssi::settings_get_str("morning_message");
+ }
+ elsif($time >= 0)
+ {
+ $text = Irssi::settings_get_str("night_message")
+ }
+ $server->command("MSG $witem->{name} $text $data");
+
+}
+
+Irssi::command_bind hello => \&hello;
+
+Irssi::settings_add_str("greeter", "evening_message", "good evenening");
+Irssi::settings_add_str("greeter", "afternoon_message", "good afternoon");
+Irssi::settings_add_str("greeter", "morning_message", "good morning");
+Irssi::settings_add_str("greeter", "night_message", "good night");
diff --git a/scripts/hide.pl b/scripts/hide.pl
new file mode 100644
index 0000000..9697df1
--- /dev/null
+++ b/scripts/hide.pl
@@ -0,0 +1,177 @@
+use strict;
+use vars qw ($VERSION %IRSSI);
+use Irssi qw (settings_add_str settings_get_str settings_set_str command_bind command_runsub signal_emit );
+
+$VERSION = '0.0.7';
+%IRSSI = (
+ authors => 'Marcus Rueckert',
+ contact => 'darix@irssi.de',
+ name => 'hide tools',
+ description => 'a little interface to irssi\'s activity_hide_* settings',
+ license => 'Public Domain',
+ url => 'http://scripts.irssi.de/',
+ changed => '2002-07-21 06:53:21+0200'
+);
+
+
+#
+# functions
+#
+
+sub add_item {
+ my ($target_type, $data) = @_;
+ my $target = target_check ($target_type);
+ return 0 unless $target;
+ if ($data =~ /^\s*$/ ) {
+ print (CRAP "\cBNo target specified!\cB");
+ print (CRAP "\cBUsage:\cB hide $target_type add [$target_type]+");
+ }
+ else {
+ my $set = settings_get_str($target);
+ for my $item ( split (/\s+/, $data) ) {
+ if ($set =~ m/^\Q$item\E$/i) {
+ print (CRAP "\cBWarning:\cB $item is already in in $target_type hide list.")
+ }
+ else {
+ print (CRAP "$item added to $target_type hide list.");
+ $set = join (' ', $set, $item);
+ }
+ };
+ settings_set_str ($target, $set);
+ signal_emit('setup changed');
+ }
+ return 1;
+}
+
+sub remove_item {
+ my ($target_type, $data) = @_;
+ my $target = target_check ($target_type);
+ if ( not ( $target )) { return 0 };
+ if ($data =~ /^\s*$/ ) {
+ print (CRAP "\cBNo target specified!\cB");
+ print (CRAP "\cBUsage:\cB hide $target_type remove [$target_type]+");
+ }
+ else {
+ my $set = settings_get_str($target);
+ for my $item ( split (/\s+/, $data) ) {
+ if ($set =~ s/$item//i) {
+ print (CRAP "$item removed from $target_type hide list.")
+ }
+ else {
+ print (CRAP "\cBWarning:\cB $item was not in $target_type hide list.")
+ }
+ };
+ settings_set_str ($target, $set);
+ signal_emit('setup changed');
+ }
+ return 1;
+}
+
+sub target_check {
+ my ($target_type) = @_;
+ my $target = '';
+ if ($target_type eq 'level') {
+ $target = 'activity_hide_level';
+ }
+ elsif ($target_type eq 'target') {
+ $target = 'activity_hide_targets';
+ }
+ else {
+ print (CLIENTERROR "\cBadd_item: no such target_type $target_type\cB");
+ }
+ return $target;
+}
+
+sub print_usage {
+ print (CRAP "\cBUsage:\cB");
+ print (CRAP " hide target [add|remove] [targets]+");
+ print (CRAP " hide level [add|remove] [levels]+");
+ print (CRAP " hide usage");
+ print (CRAP " hide print");
+ print (CRAP "See also: levels");
+};
+
+sub print_items {
+ my ($target_type) = @_;
+ my $delimiter = settings_get_str('hide_print_delimiter');
+ my $target = target_check ($target_type);
+ if ( not ( $target )) { return 0 };
+ print ( CRAP "\cB$target_type hide list:\cB$delimiter", join ( $delimiter, sort ( split ( " ", settings_get_str($target) ) ) ) );
+ return 1;
+}
+
+#
+# targets
+#
+
+command_bind 'hide target' => sub {
+ my ($data, $server, $item) = @_;
+ if ($data =~ m/^[(add)|(remove)]/i ) {
+ command_runsub ('hide target', $data, $server, $item);
+ }
+ else {
+ print (CRAP "\cBUsage:\cB hide target [add|remove] [targets]+");
+ }
+};
+
+command_bind 'hide target add' => sub {
+ my ($data, $server, $item) = @_;
+ add_item ('target', $data);
+};
+
+command_bind 'hide target remove' => sub {
+ my ($data, $server, $item) = @_;
+ remove_item ('target', $data);
+};
+
+#
+# levels
+#
+command_bind 'hide level' => sub {
+ my ($data, $server, $item) = @_;
+ if ($data =~ m/^[(add)|(remove)]/i ) {
+ command_runsub ('hide level', $data, $server, $item);
+ }
+ else {
+ print (CRAP "\cBUsage:\cB hide level [add|remove] [levels]+");
+ print (CRAP "See also: levels");
+ }
+};
+
+command_bind 'hide level add' => sub {
+ my ($data, $server, $item) = @_;
+ add_item ('level', $data);
+};
+
+command_bind 'hide level remove' => sub {
+ my ($data, $server, $item) = @_;
+ remove_item ('level', $data);
+};
+
+#
+# general
+#
+
+command_bind 'hide' => sub {
+ my ($data, $server, $item) = @_;
+ if ($data =~ m/^[(target)|(level)|(help)|(usage)|(print)]/i ) {
+ command_runsub ('hide', $data, $server, $item);
+ }
+ else {
+ print_usage();
+ }
+};
+
+command_bind 'hide print' => sub {
+ print_items ('level');
+ print_items ('target');
+};
+
+command_bind 'hide usage' => sub { print_usage (); };
+command_bind 'hide help' => sub { print_usage (); };
+
+#
+# settings
+#
+
+settings_add_str ( 'script', 'hide_print_delimiter', "\n - ");
diff --git a/scripts/hideauth.pl b/scripts/hideauth.pl
new file mode 100644
index 0000000..8e8a60f
--- /dev/null
+++ b/scripts/hideauth.pl
@@ -0,0 +1,63 @@
+# hideauth.pl
+#
+# Stops eggdrop passwords from showing up in e.g. /msg botnick op password [#channel]
+#
+# Settings:
+# hideauth_commands: space-delimited case-insensitive list of eggdrop commands to filter (e.g. "op voice ident") (can be regexps)
+# hideauth_botsonly: if 1/ON, only hideauth for nicks in the bots list (because "op" is common Dutch word :)
+# hideauth_bots: space-delimited case-insensitive list of botnicks (can be regexps) (e.g. "notopic monicaoff")
+#
+# You can also change the "bot_command" format item:
+# $0 = command (op, ident, etc)
+# $1 = (optional) channel (from "op password #channel")
+# $2 = nick command is sent to
+# My default format is (in case you break it): 'eggdrop command {reason $0 %K****%n$1} sent to {channick_hilight $2}'
+#
+# Thanks to Joost "Garion" Vunderink for advice and testing ^_^
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi qw(signal_add_first settings_get_str settings_get_bool settings_add_str settings_add_bool signal_stop theme_register);
+
+$VERSION = '1.01';
+%IRSSI = (
+ authors => 'JamesOff',
+ contact => 'james@jamesoff.net',
+ name => 'hideauth',
+ description => 'Stops eggdrop passwords showing up',
+ license => 'Public Domain',
+ url => 'http://www.jamesoff.net',
+ changed => '04 June 2002 20:56:00',
+);
+
+theme_register([
+ 'bot_command', 'eggdrop command {reason $0 %K****%n$1} sent to {channick_hilight $2}'
+]);
+
+
+sub intercept_message {
+ my ($server, $message, $target, $orig_target) = @_;
+ my $commands = settings_get_str('hideauth_commands');
+ my $botsOnly = settings_get_bool('hideauth_botsonly');
+ my $bots = settings_get_str('hideauth_bots');
+ $bots =~ tr/ /|/;
+
+ #check for bots only and compare target nick
+ return if (($botsOnly == 1) && ($target !~ /($bots)/i));
+
+ #check the first word to see if it's a command
+ $commands =~ tr/ /|/;
+ if ($message =~ /^($commands) \w+( .+)?/i) {
+ #it's a match, it's handle it :)
+ my ($command, $dest) = ($1, $2);
+ $server->printformat($target, MSGLEVEL_CRAP, 'bot_command', $command, $dest, $target);
+ signal_stop();
+ }
+}
+
+signal_add_first('message own_private', 'intercept_message');
+settings_add_str('misc','hideauth_commands','op voice auth ident pass newpass rehash');
+settings_add_bool('misc','hideauth_botsonly',0);
+settings_add_str('misc','hideauth_bots','');
diff --git a/scripts/hideshow.pl b/scripts/hideshow.pl
new file mode 100644
index 0000000..fac376d
--- /dev/null
+++ b/scripts/hideshow.pl
@@ -0,0 +1,319 @@
+use strict;
+use warnings;
+
+our $VERSION = '0.4.6'; # 4cc7adcb14932da
+our %IRSSI = (
+ authors => 'Nei',
+ contact => 'Nei @ anti@conference.jabber.teamidiot.de',
+ url => "http://anti.teamidiot.de/",
+ name => 'hideshow',
+ description => 'Removes and re-adds lines to the Irssi buffer view.',
+ license => 'GNU GPLv2 or later',
+ );
+
+# Usage
+# =====
+# Use this script to hide and re-add lines into your Irssi view. You
+# can grab a custom-modified recentdepart.pl to hide smart-filtered
+# messages instead of ignore, if you do
+#
+# /set recdep_use_hideshow ON
+#
+# You can use trigger.pl with:
+#
+# /trigger add ... -command 'script exec $$Irssi::scripts::hideshow::hide_next = 1'
+#
+# instead of -stop
+
+# Options
+# =======
+# /set hideshow_level <levels>
+# * list of levels that should be hidden from view
+#
+# /set hideshow_hide <ON|OFF>
+# * if hiding is currently enabled or not. make a key binding to
+# conveniently toggle this setting (see below)
+
+# Commands
+# ========
+# you can use this key binding:
+#
+# /bind meta-= command ^toggle hideshow_hide
+#
+# /scrollback status hidden
+# * like /scrollback status, but for the hidden part (some statistics)
+
+no warnings 'redefine';
+use constant IN_IRSSI => __PACKAGE__ ne 'main' || $ENV{IRSSI_MOCK};
+use Irssi;
+use Irssi::TextUI;
+use Encode;
+use version;
+
+my $irssi_version = qv('v'.Irssi::parse_special('$J') =~ s/[^.\d].*//r);
+
+sub setc () {
+ $IRSSI{name}
+}
+
+sub set ($) {
+ setc . '_' . $_[0]
+}
+
+my (%hidden);
+
+my $DEST;
+
+my $HIDE;
+my $hide_level;
+my $ext_hidden_level = MSGLEVEL_LASTLOG << 1;
+
+
+sub show_win_lines {
+ my $win = shift;
+ my $view = $win->view;
+ my $vid = $view->{_irssi};
+ my $hl = delete $hidden{$vid};
+ return unless $hl && %$hl;
+ my $redraw;
+ my $bottom = $view->{bottom};
+ for (my $lp = $view->{buffer}{cur_line}; $lp; $lp = $lp->prev) {
+ my $nl = delete $hl->{ $lp->{_irssi} };
+ next unless $nl;
+ my $ll = $lp;
+ for my $i (@$nl) {
+ $win->gui_printtext_after($ll, $i->[1] | MSGLEVEL_NEVER, "${$i}[0]\n", $i->[2]);
+ $ll = $win->last_line_insert;
+ $redraw = 1;
+ }
+ }
+ if ($redraw) {
+ $win->command('^scrollback end') if $bottom && !$win->view->{bottom};
+ $view->redraw;
+ }
+ delete $hidden{$vid};
+}
+sub show_lines {
+ for my $win (Irssi::windows) {
+ show_win_lines($win);
+ }
+ %hidden=();
+}
+
+sub hide_win_lines {
+ my $win = shift;
+ my $view = $win->view;
+ my $vid = $view->{_irssi};
+ my $bottom = $view->{bottom};
+ my $redraw;
+ my $prev;
+ my $lid;
+ for (my $lp = $view->{buffer}{cur_line}; $lp; $lp = $prev) {
+ $prev = $lp->prev;
+ if ($prev && $lp->{info}{level} & ($hide_level | $ext_hidden_level)) {
+ push @{ $hidden{ $vid }
+ { $prev->{_irssi} }
+ }, [ $lp->get_text(1), $lp->{info}{level}, $lp->{info}{time} ],
+ $hidden{$vid}{ $lp->{_irssi } } ? @{ (delete $hidden{$vid}{ $lp->{_irssi } }) } : ();
+ $view->remove_line($lp);
+ $redraw = 1;
+ }
+ }
+ if ($redraw) {
+ $win->command('^scrollback end') if $bottom && !$win->view->{bottom};
+ $view->redraw;
+ }
+}
+
+my %hideshow_timed;
+sub show_one_timed {
+ my $hide = shift;
+ for my $win (Irssi::windows) {
+ next if $hideshow_timed{ $win->{_irssi} };
+ if ($hide) {
+ Irssi::signal_remove('gui textbuffer line removed' => 'fix_lines');
+ hide_win_lines($win);
+ Irssi::signal_add_last('gui textbuffer line removed' => 'fix_lines');
+ }
+ else {
+ show_win_lines($win);
+ }
+ $hideshow_timed{$win->{_irssi}} = 1;
+ $hideshow_timed{_timer} = Irssi::timeout_add_once(10 + int rand 10, 'show_one_timed', $hide);
+ return;
+ }
+ unless ($hide) {
+ show_lines();
+ }
+ %hideshow_timed = ();
+ hideshow() if !!$hide != !!$HIDE;
+ return 1;
+}
+sub hideshow {
+ if ($irssi_version >= v1.1.0) {
+ if ($HIDE) {
+ my $level = Irssi::bits2level($hide_level | $ext_hidden_level);
+ Irssi::command("^foreach window ^window hidelevel $level");
+ } else {
+ Irssi::command('^foreach window ^window hidelevel -all -hidden');
+ }
+ return;
+ }
+
+ # Horrible Pre Irssi 1.1 Code follows
+ if (exists $hideshow_timed{_timer}) {
+ Irssi::timeout_remove(delete $hideshow_timed{_timer});
+ }
+ %hideshow_timed = ();
+ $hideshow_timed{_timer} = Irssi::timeout_add_once(10 + int rand 10, 'show_one_timed', !!$HIDE);
+}
+
+sub setup_changed {
+ my $old_level = $hide_level;
+ $hide_level = Irssi::settings_get_level( set 'level' );
+ my $old_hidden = $HIDE;
+ $HIDE = Irssi::settings_get_bool( set 'hide' );
+ if (!defined $old_hidden || $HIDE != $old_hidden || $old_level != $hide_level) {
+ hideshow();
+ }
+}
+
+sub init_hideshow {
+ setup_changed();
+ $Irssi::scripts::hideshow::hide_next = undef;
+}
+
+sub UNLOAD {
+ if ($irssi_version >= v1.1.0) {
+ if ($irssi_version >= v1.2.0) {
+ $hide_level = Irssi::settings_get_level('window_default_hidelevel');
+ my $level = Irssi::bits2level($hide_level);
+ Irssi::command('^foreach window ^window hidelevel -all -hidden');
+ Irssi::command("^foreach window ^window hidelevel $level");
+ } else {
+ Irssi::command('^foreach window ^window hidelevel -all hidden');
+ }
+ return;
+ }
+
+ show_lines();
+}
+
+my $multi_msgs_last;
+
+sub prt_text_issue {
+ $DEST = $_[0];
+ my $stripd = $_[2];
+ if (ref $DEST && $Irssi::scripts::hideshow::hide_next) {
+ $multi_msgs_last = undef;
+ $DEST->{hide} = 1;
+ if ($DEST->{level} & (MSGLEVEL_QUITS|MSGLEVEL_NICKS)) {
+ $multi_msgs_last = $stripd;
+ }
+ }
+ elsif (ref $DEST && $DEST->{level} & (MSGLEVEL_QUITS|MSGLEVEL_NICKS)
+ && defined $multi_msgs_last && $multi_msgs_last eq $stripd) {
+ $DEST->{hide} = 1;
+ }
+ else {
+ $multi_msgs_last = undef;
+ }
+ $Irssi::scripts::hideshow::hide_next = undef;
+
+ if ($irssi_version >= v1.1.0 && ref $DEST && $DEST->{hide}) {
+ $_[0] = Irssi::Server::format_create_dest($DEST->{server}, $DEST->{target}, $DEST->{level} | $ext_hidden_level, $DEST->{window});
+ &Irssi::signal_continue;
+ }
+}
+
+sub prt_text_ref {
+ return unless ref $DEST;
+ my ($win) = @_;
+ if ($HIDE) {
+ my $view = $win->view;
+ my $vid = $view->{_irssi};
+ my $lp = $view->{buffer}{cur_line};
+ my $prev = $lp->prev;
+ if ($prev && ($DEST->{hide} || $lp->{info}{level} & $hide_level)) {
+ my $level = $lp->{info}{level};
+ $level |= $ext_hidden_level if $DEST->{hide};
+ push @{ $hidden{ $vid }
+ { $prev->{_irssi} }
+ }, [ $lp->get_text(1), $level, $lp->{info}{time} ];
+ $view->remove_line($lp);
+ delete @{ $hidden{ $vid } }
+ { (grep {
+ $view->{buffer}{first_line}{info}{time} > $hidden{$vid}{$_}[-1][2]
+ } keys %{$hidden{$vid}}) };
+ $view->redraw;
+ }
+ }
+ $DEST = undef;
+}
+
+sub fix_lines {
+ my ($view, $rem_line, $prev_line) = @_;
+ my $vid = $view->{_irssi};
+ my $nl = delete $hidden{$vid}{ $rem_line->{_irssi} };
+ if ($nl && $prev_line) {
+ push @{ $hidden{$vid} { $prev_line->{_irssi} } }, @$nl
+ }
+}
+
+sub win_del {
+ my ($win) = @_;
+ delete $hidden{ $win->view->{_irssi} };
+}
+Irssi::signal_register({
+ 'gui textbuffer line removed' => [ qw/Irssi::TextUI::TextBufferView Irssi::TextUI::Line Irssi::TextUI::Line/ ]
+});
+
+Irssi::signal_add_last({
+ 'setup changed' => 'setup_changed',
+});
+Irssi::signal_add({
+ 'print text' => 'prt_text_issue',
+});
+
+Irssi::settings_add_level( setc, set 'level', '' );
+Irssi::settings_add_bool( setc, set 'hide', 1 );
+
+
+unless ($irssi_version >= v1.1.0) {
+ Irssi::signal_add_last({
+ 'gui print text finished' => 'prt_text_ref',
+ 'gui textbuffer line removed' => 'fix_lines',
+ });
+ Irssi::signal_add({
+ 'window destroyed' => 'win_del',
+ });
+
+ Irssi::command_bind({
+ 'scrollback status' => sub {
+ if ($_[0] =~ /\S/) {
+ &Irssi::command_runsub('scrollback status', @_);
+ Irssi::signal_stop;
+ }
+ },
+ 'scrollback status hidden' => sub {
+ my %vw = map { ($_->view->{_irssi}, $_->{refnum}) } Irssi::windows;
+ my ($tl, $ta, $td) = (0, 0, 0);
+ for my $v (keys %hidden) {
+ my $hl = $hidden{$v};
+ my ($lc, $dc, $ac) = (0, 0, scalar keys %$hl);
+ for my $k (keys %$hl) {
+ my $ls = $hl->{$k};
+ $lc += @$ls;
+ $dc += 16 + length $_->[0] for @$ls;
+ }
+ $tl += $lc; $ta += $ac; $td += $dc;
+ print CLIENTCRAP sprintf "Window %d: %d lines hidden, %d anchors, %dkB of data", ($vw{$v}//"??"), $lc, $ac, int($dc/1024);
+ }
+ print CLIENTCRAP sprintf "Total: %d lines hidden, %d anchors, %dkB of data", $tl, $ta, int($td/1024);
+ }
+ });
+}
+
+init_hideshow();
+
+{ package Irssi::Nick }
diff --git a/scripts/highlite.pl b/scripts/highlite.pl
new file mode 100644
index 0000000..515d0dd
--- /dev/null
+++ b/scripts/highlite.pl
@@ -0,0 +1,113 @@
+use strict;
+use Irssi;
+use Irssi::Irc;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.0";
+%IRSSI = (
+ "authors" => "Mantis",
+ "contact" => "mantis\@inta-link.com",
+ "name" => "highlite",
+ "description" => "shows events happening in all channels you are in that may concern you",
+ "url" => "http://www.inta-link.com/",
+ "license" => "GNU GPL v2",
+ "changed" => "2003-01-03"
+);
+
+sub msg_join
+{
+ my ($server, $channame, $nick, $host) = @_;
+ $channame =~ s/^://;
+
+ my $windowname = Irssi::window_find_name('highlite');
+ $windowname->print("%B%0JOIN : " . $nick . " : " . $channame . " : " . $host, MSGLEVEL_CLIENTCRAP) if ($windowname);
+}
+
+sub msg_part
+{
+ my ($server, $channame, $nick, $host) = @_;
+ $channame =~ s/^://;
+
+ my $windowname = Irssi::window_find_name('highlite');
+ $windowname->print("%b%0PART : " . $nick . " : " . $channame . " : " . $host, MSGLEVEL_CLIENTCRAP) if ($windowname);
+}
+
+sub msg_quit
+{
+ my ($server, $nick, $host, $quitmsg) = @_;
+
+ if (substr($quitmsg, 0, 14) eq "Read error to ")
+ {
+ $quitmsg = "[ General Read Error ]";
+ }
+ if (substr($quitmsg, 0, 17) eq "Ping timeout for ")
+ {
+ $quitmsg = "[ General Ping Timeout Error ]";
+ }
+
+ my $windowname = Irssi::window_find_name('highlite');
+ $windowname->print("%R%0QUIT : " . $nick . " : " . $host . " : " . $quitmsg, MSGLEVEL_CLIENTCRAP) if ($windowname);
+
+ $quitmsg = "";
+}
+
+sub msg_topic
+{
+ my ($server, $channame, $topicmsg, $nick, $host) = @_;
+ $channame =~ s/^://;
+
+ my $windowname = Irssi::window_find_name('highlite');
+ $windowname->print("%G%0TOPIC : " . $nick . " : " . $channame . " : " . $topicmsg, MSGLEVEL_CLIENTCRAP) if ($windowname);
+}
+
+sub msg_nick
+{
+ my ($server, $nick, $old_nick, $host) = @_;
+
+ my $windowname = Irssi::window_find_name('highlite');
+ $windowname->print("%m%0NICK : " . $old_nick . " : " . $nick . " : " . $host, MSGLEVEL_CLIENTCRAP) if ($windowname);
+}
+
+sub msg_kick
+{
+ my ($server, $channame, $kicked, $nick, $host, $reason) = @_;
+ $channame =~ s/^://;
+
+ my $windowname = Irssi::window_find_name('highlite');
+ $windowname->print("%Y%0KICK : " . $kicked . " : " . $channame . " : " . $nick . " : " . $reason, MSGLEVEL_CLIENTCRAP) if ($windowname);
+}
+
+sub sig_printtext {
+ my ($dest, $text, $stripped) = @_;
+
+ if (($dest->{level} & (MSGLEVEL_HILIGHT|MSGLEVEL_MSGS)) && ($dest->{level} & MSGLEVEL_NOHILIGHT) == 0)
+ {
+ if ($dest->{level} & MSGLEVEL_PUBLIC)
+ {
+ my $windowname = Irssi::window_find_name('highlite');
+
+ $windowname->print("%W%0HIGHLITE : " . $dest->{target} . " : " . $text, MSGLEVEL_CLIENTCRAP) if ($windowname);
+ }
+ }
+}
+
+my $windowname = Irssi::window_find_name('highlite');
+if (!$windowname)
+{
+ Irssi::command("window new hidden");
+ Irssi::command("window name highlite");
+}
+
+Irssi::signal_add(
+{
+ 'message join' => \&msg_join,
+ 'message part' => \&msg_part,
+ 'message quit' => \&msg_quit,
+ 'message topic' => \&msg_topic,
+ 'print text', 'sig_printtext',
+ 'message nick' => \&msg_nick,
+ 'message kick' => \&msg_kick
+}
+);
+
diff --git a/scripts/hignore.pl b/scripts/hignore.pl
new file mode 100644
index 0000000..ffa375c
--- /dev/null
+++ b/scripts/hignore.pl
@@ -0,0 +1,78 @@
+#!/usr/bin/perl -w
+
+## Bugreports and Licence disclaimer.
+#
+# For bugreports and other improvements contact Geert Hauwaerts <geert@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+##
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.02";
+
+%IRSSI = (
+ authors => 'Geert Hauwaerts',
+ contact => 'geert@irssi.org',
+ name => 'hignore.pl',
+ description => 'This script will add the HIGNORE command, if you use this command in a query it will ignore the host.',
+ license => 'Public Domain',
+ url => 'http://irssi.hauwaerts.be/hignore.pl',
+ changed => 'Wed Sep 17 23:51:38 CEST 2003',
+);
+
+## Comments and remarks.
+#
+# A little tip for this script.
+#
+# Tip: This script if verry usefull if you bind this to an F-key. For example if you get flooded
+# (by the little bastard dj_poison on Undernet) you'll just need to press F1 and it will
+# ignore the hostmask and close the query.
+# Command: /BIND meta2-P key F1
+# /BIND F1 command eval hignore ; unquery
+#
+##
+
+Irssi::theme_register([
+ 'loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.',
+ 'no_query', '%R>>%n %_HIGNORE:%_ The specified window isn\'t a query.',
+ 'no_host', '%R>>%n %_HIGNORE:%_ The specified query doesn\'t contain host information.'
+]);
+
+sub hignore {
+
+ my $wintype = Irssi::active_win->{active}->{type};
+ my $winaddr = Irssi::active_win->{active}->{address};
+
+ if ($wintype ne "QUERY") {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'no_query');
+ } else {
+ if ($winaddr =~ /\b~?(.{1,10})@([a-zA-Z0-9_.-]+)\b/) {
+ my ($user, $host) = ($1, $2);
+
+ Irssi::command("IGNORE *!*\@$host");
+
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'no_host');
+ }
+ }
+}
+
+Irssi::command_bind('hignore', 'hignore');
+
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
diff --git a/scripts/hilightwin.pl b/scripts/hilightwin.pl
new file mode 100644
index 0000000..5f49f81
--- /dev/null
+++ b/scripts/hilightwin.pl
@@ -0,0 +1,85 @@
+#
+# Print hilighted messages & private messages to window named "hilight" for
+# irssi 0.7.99 by Timo Sirainen
+#
+# Modded a tiny bit by znx to stop private messages entering the hilighted
+# window (can be toggled) and to put up a timestamp.
+#
+# Changed a little by rummik to optionally show network name. Enable with
+# `/set hilightwin_show_network on`
+#
+
+use strict;
+use Irssi;
+use POSIX;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.00";
+%IRSSI = (
+ authors => "Timo \'cras\' Sirainen, Mark \'znx\' Sangster, Kimberly \'rummik\' Zick",
+ contact => "tss\@iki.fi, znxster\@gmail.com, git\@zick.kim",
+ name => "hilightwin",
+ description => "Print hilighted messages to window named \"hilight\"",
+ license => "Public Domain",
+ url => "http://irssi.org/",
+ changed => "Thu Apr 6 15:30:25 EDT 2017"
+);
+
+sub is_ignored {
+ my ($dest) = @_;
+
+ my @ignore = split(' ', Irssi::settings_get_str('hilightwin_ignore_targets'));
+ return 0 if (!@ignore);
+
+ my %targets = map { $_ => 1 } @ignore;
+
+ return 1 if exists($targets{"*"});
+ return 1 if exists($targets{$dest->{target}});
+
+ if ($dest->{server}) {
+ my $tag = $dest->{server}->{tag};
+ return 1 if exists($targets{$tag . "/*"});
+ return 1 if exists($targets{$tag . "/" . $dest->{target}});
+ }
+
+ return 0;
+}
+
+sub sig_printtext {
+ my ($dest, $text, $stripped) = @_;
+
+ my $opt = MSGLEVEL_HILIGHT;
+ my $shownetwork = Irssi::settings_get_bool('hilightwin_show_network');
+
+ if(Irssi::settings_get_bool('hilightwin_showprivmsg')) {
+ $opt = MSGLEVEL_HILIGHT|MSGLEVEL_MSGS;
+ }
+
+ if(
+ ($dest->{level} & ($opt)) &&
+ ($dest->{level} & MSGLEVEL_NOHILIGHT) == 0 &&
+ (!is_ignored($dest))
+ ) {
+ my $window = Irssi::window_find_name('hilight');
+
+ if ($dest->{level} & MSGLEVEL_PUBLIC) {
+ $text = $dest->{target}.": ".$text;
+ $text = $dest->{server}->{tag} . "/" . $text if ($shownetwork);
+ } elsif ($shownetwork) {
+ $text = $dest->{server}->{tag} . ": " . $text;
+ }
+ $text =~ s/%/%%/g;
+ $window->print($text, MSGLEVEL_CLIENTCRAP) if ($window);
+ }
+}
+
+my $window = Irssi::window_find_name('hilight');
+Irssi::print("Create a window named 'hilight'") if (!$window);
+
+Irssi::settings_add_bool('hilightwin','hilightwin_showprivmsg',1);
+Irssi::settings_add_str('hilightwin', 'hilightwin_ignore_targets', '');
+Irssi::settings_add_bool('hilightwin','hilightwin_show_network', 0);
+
+Irssi::signal_add('print text', 'sig_printtext');
+
+# vim:set ts=4 sw=4 et:
diff --git a/scripts/history_search.pl b/scripts/history_search.pl
new file mode 100644
index 0000000..48cbe63
--- /dev/null
+++ b/scripts/history_search.pl
@@ -0,0 +1,146 @@
+# Search within your typed history as you type (like ctrl-R in bash)
+# Usage:
+# * First do: /bind ^R /history_search
+# * Then type ctrl-R and type what you're searching for
+# * Optionally, you can bind something to "/history_search -forward" to go forward in the results
+
+# Copyright 2007-2009 Wouter Coekaerts <coekie@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+use strict;
+use Irssi 20070804;
+use Irssi::TextUI;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '2.1';
+%IRSSI = (
+ authors => 'Wouter Coekaerts',
+ contact => 'coekie@irssi.org',
+ name => 'history_search',
+ description => 'Search within your typed history as you type (like ctrl-R in bash)',
+ license => 'GPLv2 or later',
+ url => 'http://wouter.coekaerts.be/irssi/',
+);
+
+# is the searching enabled?
+my $enabled = 0;
+# the typed text (the query) last time a key was pressed
+my $prev_typed;
+# the position in the input of where the typed text started.
+# everything before it is not typed by the user but added by this script as part of the result
+my $prev_startpos;
+# the current list of matches
+my @matches;
+# at what place are we in @matches?
+my $current_match_index;
+
+Irssi::command_bind('history_search', sub {
+ my ($data, $server, $item) = @_;
+ if ($data !~ /^ *(-forward)? *$/) {
+ Irssi::print("history_search: Unknown arguments: $data");
+ return;
+ }
+ my $forward = $1 eq '-forward';
+
+ if (! $enabled) {
+ $enabled = 1;
+ $prev_typed = '';
+ $prev_startpos = 0;
+ @matches = ();
+ $current_match_index = -1;
+ } else {
+ if ($forward) {
+ if ($current_match_index + 1 < scalar(@matches)) {
+ $current_match_index++;
+ }
+ } else { # backwards
+ if ($current_match_index > 0) {
+ $current_match_index--;
+ }
+ }
+ }
+});
+
+Irssi::signal_add_last 'gui key pressed' => sub {
+ my ($key) = @_;
+
+ if ($key == 10 || $key == 13 || $key == 27) { # enter or escape
+ $enabled = 0;
+ }
+
+ return unless $enabled;
+
+ # get the content of the input line
+ my $prompt = Irssi::parse_special('$L');
+ my $pos = Irssi::gui_input_get_pos();
+
+ # stop if the cursor is before the position where the typing started (e.g. if user pressed backspace more than he typed characters)
+ if ($pos < $prev_startpos) {
+ $enabled = 0;
+ return;
+ }
+
+ # get the part of the input line that the user typed (strip the part before and after which this script added)
+ my $typed = substr($prompt, $prev_startpos, ($pos-$prev_startpos));
+
+ if ($typed ne $prev_typed) { # something changed
+ # find matches
+ find_matches($typed);
+
+ # start searching from the end again
+ $current_match_index = scalar(@matches) - 1;
+ }
+
+ # if nothing was found, just show what the user typed
+ # else, show the current match
+ my $result = ($current_match_index == -1) ? $typed : $matches[$current_match_index];
+
+ # update the input line
+ my $startpos = index(lc($result), lc($typed));
+ Irssi::gui_input_set($result);
+ Irssi::gui_input_set_pos($startpos + length($typed));
+
+ # remember for next time
+ $prev_typed = $typed;
+ $prev_startpos = $startpos;
+};
+
+# find matches for the given user-typed text, and put it in @matches
+sub find_matches($) {
+ my ($typed) = @_;
+ if (Irssi::version() > 20090117) {
+ $typed = lc($typed);
+ my @history;
+ if ($prev_typed ne '' && index($typed, lc($prev_typed)) != -1) { # previous typed plus more
+ @history = @matches; # only search in previous results
+ } else {
+ @history = Irssi::active_win->get_history_lines();
+ }
+ @matches = ();
+ for my $history_line (@history) {
+ my $startpos = index(lc($history_line), $typed);
+ if ($startpos != -1) {
+ push @matches, $history_line;
+ }
+ }
+ } else { # older irssi version, can only get the last match
+ @matches = ();
+ my $last_match = Irssi::parse_special('$!' . $typed . '!');
+ if ($last_match ne '') {
+ push @matches, $last_match;
+ }
+ }
+}
diff --git a/scripts/hl.pl b/scripts/hl.pl
new file mode 100644
index 0000000..7fd898d
--- /dev/null
+++ b/scripts/hl.pl
@@ -0,0 +1,53 @@
+# CopyLeft Riku Voipio 2001
+# half-life bot script
+use strict;
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+
+# header begins here
+
+$VERSION = "1.2";
+%IRSSI = (
+ authors => "Riku Voipio",
+ contact => "riku.voipio\@iki.fi",
+ name => "half-life",
+ description => "responds to \"!hl counterstrike.server \" command on channels/msg's to query counter-strike servers",
+ license => "GPLv2",
+ url => "http://nchip.ukkosenjyly.mine.nu/irssiscripts/",
+ );
+
+
+my $qdir="/home/nchip/qstat/";
+
+sub cmd_hl {
+ my ($server, $data, $nick, $mask, $target) =@_;
+ if ($data=~/^!hl/){
+ my @foo=split(/\s+/,$data);
+ my $len=@foo;
+ if ($len==1){
+ $foo[1]="turpasauna.taikatech.com";
+ }
+ #fixme, haxxor protection
+ my $word=$foo[1];
+ $_=$word;
+ $word=~s/[^a-zA-ZäöÄÖ0-9\.]/ /g;
+ open(DAT, "-|", $qdir."qstat -hls $word");
+ my $count=0;
+ foreach my $line (<DAT>)
+ {
+ if ($count==1)
+ {
+ $_=$line;
+ $line=~s/\s+/ /g;
+ #print($line);
+ $server->command("/notice ".$target." ".$line);
+ }
+ $count++;
+ }
+ close(DAT);
+ }
+}
+
+Irssi::signal_add_last('message public', 'cmd_hl');
+Irssi::print("Half-life info bot by nchip loaded.");
diff --git a/scripts/hlbot.pl b/scripts/hlbot.pl
new file mode 100644
index 0000000..1d8cfd6
--- /dev/null
+++ b/scripts/hlbot.pl
@@ -0,0 +1,217 @@
+###########################################################################
+#
+# CopyLeft Veli Mankinen 2002
+# HL-log/rcon bot irssi script.
+#
+#####################
+#
+# USAGE:
+#
+# 1. copy the script to ~/.irssi/scripts/
+# 2. Edit the variables below.
+# 3. load the script: /script load hlbot
+# 4. Join to the channel you want this script to work on.
+# 5. Make sure all the users have ops in the channel (security reasons)
+# 6. say in channel: .rcon logadress <ip> <port>
+# Where ip is the ip of the machine where this script is running and
+# the port is the $listen_port you have set below
+# 7. say in channel: .rcon log on
+#
+# The script should now start flooding the channel about things hapening in
+# the channel. Ofcourse you can and I think you should add those
+# log -commands to your hl server.cfg.
+#
+# You can turn the flooding of by saying: ".log off" and turn it back on
+# with: ".log off". ".status" tells you whether the log is on or off.
+# Please note that the logfile is allways on. If you don't want to gather
+# the log in a file then you should put "/dev/null" to the $logfile below.
+#
+#
+# NOTE: There probably are few stupid things in this script and that is
+# just because I don't have a clue about making irssi script.
+#
+##
+
+use strict;
+use Socket;
+use Sys::Hostname;
+use IO::Handle;
+
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+
+##########################[ USER VARIABLES ]###########################
+
+my $listen_port = 10001; # Port to listen to
+my $logfile = "logi"; # Logfile
+
+my $hlserver = "123.123.123.123"; # Ip of your half life server
+my $hlport = "28000"; # Port of your half life server
+my $rcon_pass = "password"; # Rcon password of your half life server
+
+my $channel = "#mychan"; # Channel where you want this to work
+
+#######################################################################
+##############[ YOU DON'T NEED TO TOUCH BELOW THIS LINE ]##############
+#######################################################################
+
+$VERSION = "1.0";
+%IRSSI = (
+ authors => "Veli Mankinen",
+ contact => "veli\@piipiip.net",
+ name => "HL-log/rcon -bot",
+ description => "Floods the channel about things that are hapening in your hl -server. Also enables you to send rcon commands to the server from channel.",
+ license => "GPLv2",
+ url => "http://piipiip.net/",
+);
+
+#####################
+
+my $serv_iaddr = inet_aton($hlserver) || die "unknown host: $hlserver\n";
+my $serv_paddr = sockaddr_in($hlport, $serv_iaddr);
+my $challenge = "";
+my $rcon_msg = "";
+my $log_on = 1;
+
+#####################
+
+sub run_bot {
+ my $server = Irssi::active_server();
+ my $msg;
+
+ (my $hispaddr = recv(S, $msg, 1000, 0)) or print "$!\n";
+ my ($port, $hisiaddr) = sockaddr_in($hispaddr);
+ my $host = inet_ntoa($hisiaddr);
+
+ $msg =~ s/\n.$//s;
+ $msg =~ s/\n..$//s;
+
+ print LOG "$host : $msg\n";
+
+ # Received logline
+ if ($msg =~ s/^ÿÿÿÿlog L \d\d\/\d\d\/\d{4} - \d\d:\d\d:\d\d: //) {
+ # We don't want to see these
+ if ($log_on eq 0 ||
+ $msg =~ /^Server cvar/ ||
+ $msg =~ /^\[META\]/ ||
+ $msg =~ /^Log file/ ||
+ $msg =~ /^\[ADMIN\]/)
+ { return; }
+
+ # FORMAT THE LINE
+ # Don't show the rcon password.
+ $msg =~ s/^(Rcon: "rcon \d* )[^ ]*( .*)/$1*****$2/;
+
+ # Print the logline
+ if ($msg =~ /^"/) {
+ $server->command("/action $channel $msg");
+ } else {
+ $server->send_raw("PRIVMSG $channel :*log* $msg");
+ }
+ }
+
+ # Received challenge rcon reply..
+ elsif ($msg =~ /^ÿÿÿÿchallenge rcon (\d+)$/ && $rcon_msg) {
+ $challenge = $1;
+ my $data = "ÿÿÿÿrcon $challenge $rcon_pass $rcon_msg";
+ defined(send(S, $data, 0, $serv_paddr)) or
+ $server->command("/notice $channel Error sending rcon: $!");
+ }
+
+ # Received rcon reply
+ elsif ($msg =~ s/ÿÿÿÿl//) {
+ # Some rcon replies have this annoying log entry in the beginning.
+ $msg =~ s/L \d\d\/\d\d\/\d{4} - \d\d:\d\d:\d\d: //g;
+
+ # FORMAT THE LINE
+
+ # Multiline rcon responses
+ if ($msg =~ /\n/s) {
+ my @rows = split /\n/, $msg;
+ foreach my $row (@rows) {
+ # We don't want to see these
+ if ($row =~ /^[\t \n]*$/ ||
+ $row =~ /^[ADMIN] Load/ ||
+ $row =~ /^[ADMIN] WARNING/ ||
+ $row =~ /^[ADMIN] Plugins loaded/)
+ { next; }
+
+ $server->command("/notice $channel $row");
+ }
+
+ # Single line rcon responses
+ } else {
+ $server->command("/notice $channel $msg");
+ }
+ }
+
+}
+
+############################
+
+sub msg_command {
+ my ($server, $data, $nick, $mask, $target) = @_;
+
+ # Is this the right channel?
+ unless ($target =~ /$channel/i) { return; }
+
+ # Does the user have ops?
+ my $CHAN = $server->channel_find($channel);
+ my $NICK = $CHAN->nick_find($nick);
+ if (! $NICK->{op}) { return; }
+
+ # Rcon command.
+ if ($data =~ /^\.rcon (.+)/) {
+ $rcon_msg = $1;
+
+ defined(send(S, "ÿÿÿÿchallenge rcon", 0, $serv_paddr)) or
+ $server->command("/notice $channel Error asking challenge: $!");
+ }
+
+ # log on
+ elsif ($data =~ /^\.log on$/) {
+ $log_on = 1;
+ $server->command("/notice $channel Logging now ON");
+ }
+
+ # log off
+ elsif ($data =~ /^\.log off$/) {
+ $log_on = 0;
+ $server->command("/notice $channel Logging now OFF");
+ }
+
+ # help
+ elsif ($data =~ /^\.help$/) {
+ $server->command("/notice $channel Commands: .rcon <rcon command>, " .
+ ".log <on/off>, .status");
+ }
+
+ # status
+ elsif ($data =~ /^\.status$/) {
+ my $log_status = "";
+ if ($log_on eq 1) { $log_status = "on"; }
+ else { $log_status = "off"; }
+ $server->command("/notice $channel Log: $log_status");
+ }
+
+}
+
+#########[ MAIN ]###########
+
+# Open the logfile.
+open LOG, ">>", $logfile or die "Cannot open logfile!\n";
+LOG->autoflush(1);
+
+# Start listening the socket for udp messages.
+my $iaddr = gethostbyname(hostname());
+my $proto = getprotobyname('udp');
+my $paddr = sockaddr_in($listen_port, $iaddr);
+socket(S, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!\n";
+bind(S, $paddr) || die "bind: $!\n";
+
+# Set input and signals etc. irssi related stuff.
+Irssi::input_add(fileno(S), INPUT_READ, "run_bot", "");
+Irssi::signal_add_last('message public', 'msg_command');
+
+
diff --git a/scripts/hostname.pl b/scripts/hostname.pl
new file mode 100644
index 0000000..2dc23bf
--- /dev/null
+++ b/scripts/hostname.pl
@@ -0,0 +1,157 @@
+# $Id: hostname.pl,v 1.8 2002/07/04 13:18:02 jylefort Exp $
+
+use strict;
+use Irssi 20020121.2020 ();
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.01";
+%IRSSI = (
+ authors => 'Jean-Yves Lefort',
+ contact => 'jylefort\@brutele.be, decadix on IRCNet',
+ name => 'hostname',
+ description => 'Adds a /HOSTNAME command; it will list all IP addresses on all interfaces found on your machine, resolve them, and allow you to choose one easily',
+ license => 'BSD',
+ url => 'http://void.adminz.be/irssi.shtml',
+ changed => '$Date: 2002/07/04 13:18:02 $ ',
+);
+
+# description:
+#
+# hostname.pl will add a /HOSTNAME command similar to the one that can
+# be found in BitchX.
+#
+# /HOSTNAME will list all IP addresses of your system, and resolve them.
+# /HOSTNAME <index> will switch to the selected IP address.
+#
+# The IP addresses are collected by running ifconfig and parsing
+# the output. It has been tested on the following systems:
+#
+# FreeBSD 4.4-RELEASE
+# FreeBSD 4.5-RELEASE
+# NetBSD 1.5.2
+# Linux 2.4.16
+# IRIX 6.5
+# OSF/1 4.0
+# SunOS 5.8
+#
+# It will probably work on any recent version of the following systems:
+#
+# FreeBSD
+# NetBSD
+# OpenBSD
+# Linux
+# IRIX
+# OSF/1 / Tru64
+# SunOS / Solaris
+#
+# It may or may not work on other systems / versions, but it will not
+# work on the following pieces of crap:
+#
+# M$-DO$ all versions
+# Windoze all versions
+#
+# You'll also need to have the module Socket6.pm installed, the address
+# resolution needs it; on FreeBSD it can be installed easily by typing
+# cd /usr/ports/net/p5-Socket6 && make install
+#
+# /format's:
+#
+# hostname
+#
+# $0 index number
+# $1 IP address
+# $2 hostname
+#
+# new theme abstracts:
+#
+# Insert the following in the abstracts section of your theme file:
+#
+# index = "[$*]";
+# ip = "%g$*%n";
+# hostname = "{comment $*}";
+#
+# usage:
+#
+# /HOSTNAME [<index>]
+#
+# Without arguments, display the list of IP addresses and resolve them.
+#
+# With a numerical argument, set the hostname setting to the IP
+# address matching that index in the list.
+#
+# acknowledgements:
+#
+# The following people have sent the ifconfig output of their system:
+# darix, plett, zur
+#
+# changes:
+#
+# 2002-07-04 release 1.01
+# * command_bind uses a reference instead of a string
+#
+# 2002-04-25 release 1.00
+# * increased version number
+#
+# 2002-02-02 release 0.02
+# * reads ifconfig output one line at a time
+# * excluded too many IP addresses in result: fixed
+# * much '2' today ;)
+#
+# 2002-02-01 initial release
+
+use Socket;
+use Socket6;
+
+my %addresses;
+
+sub hostname {
+ my ($args, $server, $item) = @_;
+
+ get_addresses();
+ if ($args) {
+ set_address($args);
+ } else {
+ print_addresses();
+ }
+}
+
+sub get_addresses {
+ Irssi::print("Resolving IP addresses...");
+ %addresses = ();
+ open(IFCONFIG, "-|", "ifconfig");
+ while (<IFCONFIG>) {
+ $addresses{$2} = resolve($2)
+ if (/(inet addr:|inet6 addr: |inet |inet6 )([0-9a-f.:]*)/
+ && ! ($2 =~ /^(127\.0\.0\.1|::1|fe80:.*)$/));
+ }
+ close(IFCONFIG);
+}
+
+sub print_addresses {
+ my $i = 0;
+ Irssi::printformat(MSGLEVEL_CRAP, "hostname", ++$i, $_, $addresses{$_})
+ foreach (keys %addresses);
+}
+
+sub set_address {
+ my ($index, $i) = (shift, 0);
+ foreach (keys %addresses) {
+ if (++$i == $index) {
+ Irssi::print("Hostname set to $_");
+ Irssi::command("^SET HOSTNAME $_");
+ return;
+ }
+ }
+ Irssi::print("Hostname #$index not found", MSGLEVEL_CLIENTERROR);
+}
+
+sub resolve {
+ my $ip = shift;
+ my @res = getaddrinfo($ip, 0, AF_UNSPEC, SOCK_STREAM);
+ my ($name, $port) = getnameinfo($res[3]);
+ return $name;
+}
+
+Irssi::theme_register(['hostname',
+ '{index $0} {ip $[20]1} {hostname $[39]2}']);
+
+Irssi::command_bind("hostname", \&hostname);
diff --git a/scripts/iMPD.pl b/scripts/iMPD.pl
new file mode 100644
index 0000000..687b2bb
--- /dev/null
+++ b/scripts/iMPD.pl
@@ -0,0 +1,1179 @@
+#/usr/bin/perl -w
+########################################################################
+#
+# iMPD - irssi MPD controller
+# Copyright (C) 2004 Shawn Fogle (starz@antisocial.com)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+########################################################################
+#
+# iMPD - irssi MPD
+#
+# Requirements: mpc, mpd (http://musicpd.org)
+#
+# Please report b00gs to http://www.musicpd.org/forum/viewtopic.php?t=19
+# Get the latest and greatest from pulling the module at musicpd's
+# SVN (module iMPD).
+#
+# OK, This is the a script for irssi/mpc/mpd for people who want to
+# control mpd from irssi. It's very bloated, and featureful, but this
+# is a good thing because it's just a perl script and you really don't
+# ever need to use anything that's in here that doesn't pertain to you.
+# If you need it (or want it) it's most likely in here.
+#
+# I am up for suggestions, alot of this may not work for you, and
+# I will not fix it unless you tell me about it.
+#
+# I do not believe in backwards compatibility if that means it gets in
+# the way of development, so this is probably needs the latest and
+# greatest due to changes in mpc/mpd.
+#
+########################################################################
+# Changes
+########################################################################
+#
+# 0.0.0m->0.0.0n
+#
+# - Added Move / Crossfade
+#
+# - Fixed problems with finding mpc if it's in your path.
+#
+# - Began work on AddNext (Adding next in the queue, unless it's on
+# random or shuffle, don't know if it will ever be added but this
+# release needs to make it out soon to fix path b00g.
+#
+# - Finally attached the GPL to make this fully GPLv2 compatible
+#
+########################################################################
+# Buglist / Wishlist / Todo (In no particular order)
+########################################################################
+#
+# - Have to be able to tell if MPD goes down, so it can gracefully
+# shutdown the statusbar, so it doesn't try and access mpc every
+# 5 seconds (gets even worse if mpdbar_refresh is faster than
+# default). This will more than likely be fixed by the MPD module.
+# Note to self: Script unloading self leads to _bad_problems ;p
+#
+# - Update issues will go away in 0.11.0 (see musicpd.org) due to
+# update being non-blocking from there on out (hopefully ;p)
+#
+########################################################################
+# You don't need to edit below this unless you know what you're doing :)
+########################################################################
+
+use File::Basename;
+use Irssi;
+use Irssi::TextUI;
+use strict;
+use vars qw($VERSION %ENABLED %SAVE_VARS %IRSSI %COUNT %SET);
+
+$VERSION = '0.0.0o';
+%IRSSI = (
+ authors => 'Santabutthead',
+ contact => 'starz@antisocial.com',
+ name => 'iMPD',
+ description => 'This controls Music Player Daemon from the familiar irssi interface',
+ sbitems => 'mpdbar',
+ license => 'GPL v2',
+ url => 'http://www.musicpd.org'
+ );
+
+# Create $SET{'mpc_override'}="/outside/path" if mpc's not in your path
+
+### DO NOT EDIT THESE! Use /set mpd_host /set mpd_port ###
+
+$SET{'port'} = "2100";
+$SET{'host'} = "127.0.0.1";
+
+### Let's go ahead and set this up, so irssi doesn't have a tantrum ###
+
+Irssi::signal_add('setup changed' => \&read_settings);
+Irssi::settings_add_bool('misc', 'mpdbar_bottom', 0);
+Irssi::settings_add_bool('misc', 'mpdbar_top', 0);
+Irssi::settings_add_bool('misc', 'mpdbar_window', 0);
+Irssi::settings_add_bool('misc', 'current_window', '0');
+Irssi::settings_add_int('misc', 'output_window', '1');
+Irssi::settings_add_int('misc', 'mpd_port', '2100');
+Irssi::settings_add_str('misc', 'mpd_host', '127.0.0.1');
+Irssi::signal_add_first('command script unload', \&cleanup);
+Irssi::signal_add_first('command script load', \&cleanup);
+Irssi::signal_add('setup changed' => \&mpdbar_refresh);
+# Keep the $2- to treat spaces right
+Irssi::statusbar_item_register('mpdbar', '{sb $0 $1 $2-}', 'mpdbar_setup');
+Irssi::statusbars_recreate_items();
+
+#######################################################################
+
+print "For usage information on iMPD type /mhelp";
+
+sub add {
+ if ($_[0]) {
+ &read_settings;
+ my $j;
+ &current_window;
+ if ($_[0] =~ /^album\s/ or $_[0]=~ /^filename\s/ or $_[0]=~ /^title\s/ or $_[0]=~ /^artist\s/ ) {
+ my @i = split / /, $_[0];
+ $j = $i[0];
+ $_[0] =~ s/^(\w+)\s//;
+ } else {
+ $j = "filename";
+ }
+ Irssi::command( "$SET{'intrairssi'} search $j \Q$_[0]\E | $SET{'intrashell'} add" );
+ &set_active;
+ } else {
+ print "%W/madd (album|artist|filename|title) {search term} {search term}..%w";
+ print " - Search for {search term} and automagically add it to the end of the queue";
+ print " - This command does not support play number. (it doesn't make sense)";
+ print " - If not specified it will use filename by default";
+ }
+}
+
+sub addall {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} add \"\"" );
+ &set_active;
+}
+
+sub addallPlay {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} add \"\" && $SET{'intrashell'} play" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+}
+
+sub addallShufflePlay {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} add \"\" && $SET{'intrashell'} shuffle && $SET{'intrashell'} play" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+}
+
+sub addNext { # This does not work yet, but doesn't hurt being here until it does :)
+ if ($_[0]) {
+ &read_settings;
+ my $j;
+ &current_window;
+ &song_count;
+ if ($_[0] =~ /^album\s/ or $_[0]=~ /^filename\s/ or $_[0]=~ /^title\s/ or $_[0]=~ /^artist\s/ ) {
+ my @i = split / /, $_[0];
+ $j = $i[0];
+ $_[0] =~ s/^(\w+)\s//;
+ } else {
+ $j = "filename";
+ }
+ Irssi::command( "$SET{'intrairssi'} search $j \Q$_[0]\E | $SET{'intrashell'} add" );
+ my $new_pos =~ $COUNT{'song'}++;
+ my $playcount =~ $COUNT{'playlist'}++;
+ Irssi::command( "$SET{'intrairssi'} mpc $playcount $new_pos");
+ #random detect stuff here;
+ &set_active;
+ } else {
+ print "%W/maddnext (album|artist|filename|title) {search term} {search term}..%w";
+ print " - Search for {search term} and automagically add it to the next position in";
+ print " - the queue. This command does not support play number. (it doesn't make sense)";
+ print " - If not specified it will use filename by default";
+ }
+}
+
+sub addPlay {
+ if ($_[0]) {
+ &read_settings;
+ my $j;
+ &current_window;
+ if ($_[0]=~ /^album\s/ or $_[0]=~ /^filename\s/ or $_[0]=~ /^title\s/ or $_[0]=~ /^artist\s/ ) {
+ my @i = split / /, $_[0];
+ $j = $i[0];
+ $_[0] =~ s/^(\w+)\s//;
+ } else {
+ $j = "filename";
+ }
+ Irssi::command( "$SET{'intrairssi'} search $j \Q$_[0]\E | $SET{'intrashell'} add && $SET{'intrashell'} play" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+ } else {
+ print "%W/map (add play) (album|artist|filename|title) {search term} {search term}..%w";
+ print " - Search for {search term} and automagically add it to the end of the queue";
+ print " - This command does not support play number. (it doesn't make sense)";
+ print " - If not specified it will use filename by default";
+ }
+}
+
+sub addShuffle {
+ if ($_[0]) {
+ &read_settings;
+ my $j;
+ &current_window;
+ if ($_[0] =~ /^album\s/ or $_[0]=~ /^filename\s/ or $_[0]=~ /^title\s/ or $_[0]=~ /^artist\s/ ) {
+ my @i = split / /, $_[0];
+ $j = $i[0];
+ $_[0] =~ s/^(\w+)\s//;
+ } else {
+ $j = "filename";
+ }
+ Irssi::command( "$SET{'intrairssi'} search $j \Q$_[0]\E | $SET{'intrashell'} add && $SET{'intrashell'} shuffle" );
+ &set_active;
+ } else {
+ print "%W/mas (add shuffle) (album|artist|filename|title) {search term} {search term}..%w";
+ print " - Search for {search term} and automagically add it to the end of the queue";
+ print " - This command does not support play number. (it doesn't make sense)";
+ print " - If not specified it will use filename by default";
+ }
+}
+
+sub addShufflePlay {
+ if ($_[0]) {
+ &read_settings;
+ my $j;
+ &current_window;
+ if ($_[0] =~ /^album\s/ or $_[0]=~ /^filename\s/ or $_[0]=~ /^title\s/ or $_[0]=~ /^artist\s/ ) {
+ my @i = split / /, $_[0];
+ $j = $i[0];
+ $_[0] =~ s/^(\w+)\s//;
+ } else {
+ $j = "filename";
+ }
+ Irssi::command( "$SET{'intrairssi'} search $j \Q$_[0]\E | $SET{'intrashell'} add && $SET{'intrashell'} shuffle && $SET{'intrashell'} play" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+ } else {
+ print "%W/masp (add shuffle play) (album|artist|filename|title) {search term} {search term}..%w";
+ print " - Search for {search term} and automagically add it to the end of the queue";
+ print " - This command does not support play number. (it doesn't make sense)";
+ print " - If not specified it will use filename by default";
+ }
+}
+
+
+sub cleanup {
+ my ($file) = Irssi::get_irssi_dir."/iMPD.conf";
+
+ open CONF, ">", $file;
+ for my $net (sort keys %SAVE_VARS) {
+ print CONF "$net\t$SAVE_VARS{$net}\n";
+ close CONF;
+ }
+ Irssi::command( "statusbar mpdbar disable" );
+ }
+
+sub clear {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} clear" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+}
+
+sub clearAddAllPlay {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} clear && $SET{'intrashell'} add \"\" && $SET{'intrashell'} play" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+}
+
+sub clearAddAllShufflePlay {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} clear && $SET{'intrashell'} add \"\" && $SET{'intrashell'} shuffle && $SET{'intrashell'} play" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+}
+
+sub clearAddPlay {
+ if ($_[0]) {
+ &read_settings;
+ my $j;
+ &current_window;
+ if ($_[0] =~ /^album\s/ or $_[0]=~ /^filename\s/ or $_[0]=~ /^title\s/ or $_[0]=~ /^artist\s/ ) {
+ my @i = split / /, $_[0];
+ $j = $i[0];
+ $_[0] =~ s/^(\w+)\s//;
+ } else {
+ $j = "filename";
+ }
+ Irssi::command( "$SET{'intrairssi'} clear && $SET{'intrashell'} search $j \Q$_[0]\E | $SET{'intrashell'} add && $SET{'intrashell'} play" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+ } else {
+ print "%W/mcap (clear add play) (album|artist|filename|title) {search term} {search term}..%w";
+ print " - Search for {search term} and automagically add it to the end of the queue";
+ print " - This command does not support play number. (it doesn't make sense)";
+ print " - If not specified it will use filename by default";
+ }
+}
+
+sub clearAddShufflePlay {
+ if ($_[0]) {
+ &read_settings;
+ my $j;
+ &current_window;
+ if ($_[0] =~ /^album\s/ or $_[0]=~ /^filename\s/ or $_[0]=~ /^title\s/ or $_[0]=~ /^artist\s/ ) {
+ my @i = split / /, $_[0];
+ $j = $i[0];
+ $_[0] =~ s/^(\w+)\s//;
+ } else {
+ $j = "filename";
+ }
+ Irssi::command( "$SET{'intrairssi'} clear && $SET{'intrashell'} search $j \Q$_[0]\E | $SET{'intrashell'} add && $SET{'intrashell'} shuffle && $SET{'intrashell'} play" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+ } else {
+ print "%W/mcasp (clear add shuffle play) (album|artist|filename|title) {search term} {search term}..%w";
+ print " - Search for {search term} and automagically add it to the end of the queue";
+ print " - This command does not support play number. (it doesn't make sense)";
+ print " - If not specified it will use filename by default";
+ }
+}
+
+sub clearback {
+ &read_settings;
+ &song_count;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} del $COUNT{'sr1'}" );
+ &set_active;
+}
+
+sub crossfade {
+ &read_settings;
+ if ($_[0] =~ m/\d{1,4}/) {
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} crossfade $_[0]" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+ } else {
+ print "%W/mcrossfade <num> %w- Number of seconds to crossfade between songs";
+ }
+}
+
+sub current_status{
+ &read_settings;
+ &current_window;
+ my $i = `$SET{'intrashell'}`;
+ chomp($i);
+ $SET{'active'}->print( $i );
+ &set_active;
+ return;
+}
+
+sub current_window {
+ $SET{'active'} = Irssi::active_win();
+ if (! $SET{'current'}) {
+ Irssi::window_find_refnum($SET{'output'})->set_active;
+ }
+}
+
+sub delete {
+ if($_[0]) {
+ my (@i,$j,$k);
+ @i = split / /, $_[0];
+ $j = shift(@i);
+
+ &read_settings;
+ &current_window;
+ # You may ask why? This is for the future when del (hopefully) has useful output
+ $k = "$SET{'intrairssi'} playlist | grep \"$j\" | $SET{'intrashell'} del";
+ $_[0] =~ s/^(\w+)\s//;
+ $k = "$k && $SET{'intrashell'} playlist | grep \"$_[0]\" | $SET{'intrashell'} del";
+ Irssi::command( "$k" );
+ &set_active;
+ } else {
+ print"%W/mdel {search term} {search term}..%w";
+ print" - Search for {search term} and automagically";
+ print" - delete it from the queue";
+ }
+}
+
+sub iMPD_help {
+my $mpd_help = <<MPD_HELP;
+ %r---=[ %WMusic Control Commands %r]=---%w
+ %W/mmute %w- Mutes/Unmutes the volume
+ %W/mnext %w- Starts playing next song on playlist
+ %W/mpause %w- Pauses playing
+ %W/mplay <number> %w- Starts MPD (with optional number of song
+ to start on)
+ %W/mprev %w- Previous Song
+ %W/mstop <minutes> <m|h|d> %w- Stops the current playlist,
+ options are minutes, hours and days, seconds
+ are the default
+ %W/mupdate %w- Update MPD Database
+ %W/mvolume <value> (0-100) %w- Sets the volume on the OSS mixer
+ to <value> (0-100)
+
+ %r---=[ %WSearch Commands %r]=---%w
+ %W/madd (album|artist|filename|title) {search term} {search term} ..%w
+ %w- Search for {search term} and automagically
+ add it to the end of the queue, upto 5 search terms
+ - If not specified it will use filename by default
+ %W/mdel {search term} {search term} ..%w
+ %w- Search for {search term} and automagically
+ delete it from the queue
+ %W/msearch (album|artist|filename|title) {search term} {search term}..%w
+ %w- Search for {search term}
+ - If not specified it will use filename by default
+
+ %r---=[ %WNavigation/Playlist Commands %r]=---%w
+ %W/maddall %w- Add all known music to the playlist
+ %W/mclear %w- Clear the current playlist
+ %W/mclearback %w- Clears all songs before the current playing song
+ %W/mcrossfade <num> %w- Number of seconds to crossfade between songs
+ %W/mls [<directory>] %w- Lists all files/folders in <directory>
+ %W/mmove <num> <num> %w- Move song on playlist
+ %W/mplaylist <range> %w- Print entire playlist if there's no range
+ - Otherwise will print the range (i.e. 1-10)
+ %W/mplaylistls %w- List available playlists
+ %W/mplaylistload <file> %w- Load playlist <file>
+ %W/mplaylistrm <file> %w- Remove (delete) playlist <file>
+ %W/mplaylistsave <file> %w- Save playlist <file>
+ %W/mpls {search term} {search term}...%w
+ %w- Playlist search {search term}
+ %W/mseek <num> %w- Seeks to the spot specified for the current file, in terms of percent time (0-100)
+ %W/mshuffle %w- Shuffle the MPD playlist
+ %W/mrandom %w- Play the playlist randomly
+ %W/mwipe %w- Remove all songs but the one currently playing
+
+ %r---=[ %WMiscellaneous Commands %r]=---%w
+ %W/mhelp %w- This screen
+ %W/mloud %w- Show everyone in the current window the MPD stats
+ %W/mlouder %w- Show everyone in the current window the MPD stats
+ *use with caution*
+ %W/minfo %w- Show MPD Status in the status window
+ %W/mrm <num> <num>.. %w- Remove song from the current playlist (by number
+ %w- or number range)
+ See Also: /mhelpadv
+ /mhelpmpdbar
+ /set mpd_host mpd_port
+ /set mpd_current_window mpd_output_window (EXPERIMENTAL)
+MPD_HELP
+print $mpd_help;
+}
+
+sub iMPD_helpAdv{
+my $mpd_help_advanced = <<MPD_HELP_ADVANCED;
+ %r---=[ %WCombination Commands %r]=---%w
+ These do not take play arguments.
+ %W/map {search term} {search term} .. %w- Add, Play
+ %W/maap %w- Addall, Play
+ %W/maasp %w- Addall, Shuffle, Play
+ %W/mas {search term} {search term} .. %w- Add, Shuffle
+ %W/masp {search term} {search term} .. %w- Add, Shuffle, Play
+ %W/mcap {search term} {search term} .. %w- Clear, Add, Play
+ %W/mcaap %w- Clear, Addall, Play
+ %W/mcaasp %w- Clear, Addall, Shuffle, Play
+ %W/mcasp {search term} {search term} .. %w- Clear, Add, Shuffle, Play
+ %W/mwa {search term} {search term} .. %w- Wipe, Add,
+ %W/mwaa %w- Wipe, Addall
+ %W/mwaas %w- Wipe, Addall, Shuffle
+ %W/mwas {search term} {search term} .. %w- Wipe, Add, Shuffle
+
+ See Also: /set mpd_port mpd_host
+ /set mpd_current_window mpd_output_window (EXPERIMENTAL)
+MPD_HELP_ADVANCED
+print $mpd_help_advanced;
+}
+
+sub load_settings {
+ my ($file) = Irssi::get_irssi_dir."/iMPD.conf";
+
+ open CONF, "<", $file;
+ while (<CONF>) {
+ my($net,$val) = split;
+ if ($net && $val) {
+ $SAVE_VARS{$net} = $val;
+ }
+ close CONF;
+ }
+}
+
+# For those who want to be loud/annoying :)
+sub loud {
+ &read_settings;
+ my ($i,$j);
+ my @split = `$SET{'intrashell'}`;
+
+ if (! $split[1]) {
+ Irssi::print( "iMPD is not currently playing" );
+ return;
+ }
+
+ $i = basename $split[0];
+ $i =~ s/[_]/ /g;
+# Feel free to put your personal PERL regexps here ;p
+# Experiment with these to do some wicked stuff to your loud output.
+# $i =~ s/.mp3//ig;
+# $i =~ s/.flac//ig;
+# $i =~ s/.flc//ig;
+# $i =~ s/.ogg//ig;
+# $i =~ s/^\p{0,2}//;
+# $i =~ s/[.]//g;
+ $i = substr($i,0,-1);
+
+ Irssi::active_win->command( "/me is listening to $i" );
+ close Reader;
+}
+
+sub louder {
+ &read_settings;
+ my @split=`$SET{'intrashell'}`;
+ chomp(@split);
+ Irssi::active_win->command( "/say $split[0]" );
+ Irssi::active_win->command( "/say $split[1]" );
+ Irssi::active_win->command( "/say $split[2]" );
+ close Reader;
+}
+
+sub ls {
+ if ($_[0]) {
+ &read_settings;
+ &current_window;
+ $_[0] =~ "\Q$_[0]\E";
+ $_[0] =~ s/^\\//; # Rid of beginning / it doesn't delimit correctly.
+ $_[0] =~ s/\///; # Help out the degenerates.
+ Irssi::command( "$SET{'intrairssi'} ls " . "\Q$_[0]\E" );
+ &set_active;
+ } else {
+ print "%W/mls [<directory>] %w- Lists all files/folders in <directory>.";
+ }
+}
+
+sub lsplaylists {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} lsplaylists" );
+ &set_active;
+}
+
+sub move {
+ &read_settings;
+ if ($_[0] =~ m/\d{1,2}\s{1,2}/) {
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} move $_[0]" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+ } else {
+ print "%W/mmove <num> <num> %w- Move song on playlist";
+ }
+}
+
+sub mpdbar_help {
+my $mpdbarhelp = <<MPDBAR_HELP;
+ mpdbar was made to be a simple way to get your statusbar up and
+ to hide it when it's not playing. If you feel that I'm not being
+ flexable enough in my choices you're free to setup a statusbar
+ without these commands or present me with an idea for a new
+ mpdbar command. But the current ones are:
+
+ /set mpdbar_bottom on -
+ This command will (obviously) display a mpdbar on the bottom.
+
+ /set mpdbar_refresh <num> -
+ This command will set the refresh in seconds, it defaults to
+ 5 seconds, you might be able to set it higher although I don't
+ recommend setting it higher if your mpd server is across a
+ network (of any kind ;p).
+
+ /set mpdbar_top on
+ This command will (obviously) display a mpdbar on the top.
+
+ /set mpdbar_window on
+ This command will (not-so-obviously) display a mpdbar next to your
+ current window statusbar.
+MPDBAR_HELP
+print $mpdbarhelp;
+}
+
+sub mpdbar_get_stats {
+### Variable map ###
+# $SET{'stat_time'}-Time/Percent(change)
+# $SET{'stat_current'}-Status(change)
+# $SET{'songbase'}-basename filename
+ if(Irssi::settings_get_bool('mpdbar_bottom') or
+ Irssi::settings_get_bool('mpdbar_top') or
+ Irssi::settings_get_bool('mpdbar_window')) {
+ &read_settings;
+
+ ($SET{'stat1'},$SET{'stat2'},$SET{'stat3'}) = undef;
+ ($SET{'stat1'},$SET{'stat2'},$SET{'stat3'}) = `$SET{'intrashell'}`;
+ chomp($SET{'stat1'},$SET{'stat2'},$SET{'stat3'});
+
+ if ($SET{'stat2'} =~ m/(\d{1,5}\:\d{1,2}\s\(\d{1,3}\%\))/) {
+ $SET{'stat_time'} = $1;
+ }
+ if ($SET{'stat2'} =~ m/\[(\w+)\]/) {
+ $SET{'stat_current'} = $1;
+ }
+ if($SET{'stat2'} and $SET{'stat1'} =~ m/\//g) { # Not sure if this will have an effect :/
+ $SET{'songbase'} = basename $SET{'stat1'};
+ } else {
+ $SET{'songbase'} = $SET{'stat1'};
+ }
+ }
+}
+
+sub mpdbar_refresh {
+ if(Irssi::settings_get_bool('mpdbar_bottom') or
+ Irssi::settings_get_bool('mpdbar_top') or
+ Irssi::settings_get_bool('mpdbar_window')) {
+ &mpdbar_get_stats;
+ if (Irssi::settings_get_bool('mpdbar_bottom') and Irssi::settings_get_bool('mpdbar_top')) {
+ Irssi::print( "Have not implemented ability to mpdbar top and bottom at the same time" );
+ Irssi::print( "That's fine though, I'll just set it to the bottom for you for now" );
+ Irssi::settings_set_bool('mpdbar_bottom',1);
+ Irssi::settings_set_bool('mpdbar_top',0);
+ }
+ if (Irssi::settings_get_bool('mpdbar_window') and $SET{'stat2'}) {
+ $ENABLED{'window'} = "1";
+ Irssi::command( "statusbar window add mpdbar" );
+ Irssi::command( "statusbar window enable mpdbar" );
+ } else {
+ if($ENABLED{'window'} == 1) {
+ Irssi::command( "statusbar window remove mpdbar" );
+ $ENABLED{'window'} = 0;
+ }
+ }
+ if (Irssi::settings_get_bool('mpdbar_bottom') and $SET{'stat2'} and ! $ENABLED{'top'}) {
+ $ENABLED{'bottom'} = "1";
+ Irssi::command( "statusbar mpdbar placement bottom" );
+ Irssi::command( "statusbar mpdbar position 2" );
+ Irssi::command( "statusbar mpdbar enable" );
+ Irssi::command( "statusbar mpdbar add mpdbar" );
+ Irssi::command( "statusbar mpdbar visible active" );
+ } else {
+ if($ENABLED{'bottom'} == 1){
+ Irssi::command( "statusbar mpdbar remove mpdbar" );
+ Irssi::command( "statusbar mpdbar disable" );
+ $ENABLED{'bottom'} = 0;
+ }
+ }
+ if (Irssi::settings_get_bool('mpdbar_top') and $SET{'stat2'} and ! $ENABLED{'bottom'}) {
+ $ENABLED{'top'} = "1";
+ Irssi::command( "statusbar mpdbar placement top" );
+ Irssi::command( "statusbar mpdbar position 2" );
+ Irssi::command( "statusbar mpdbar enable" );
+ Irssi::command( "statusbar mpdbar add mpdbar" );
+ Irssi::command( "statusbar mpdbar visible active" );
+ } else {
+ if($ENABLED{'top'} == 1){
+ Irssi::command( "statusbar mpdbar remove mpdbar" );
+ Irssi::command( "statusbar mpdbar disable" );
+ $ENABLED{'top'} = 0;
+ }
+ }
+ }
+}
+
+sub mpdbar_setup {
+ my ($item, $get_size_only) = @_;
+ if (! $SET{'stat2'}) { # If it's not on
+ $item->default_handler($get_size_only, undef, "$SET{'stat2'}", 1);
+ } else {
+ $SET{'stat_current'} =~ s/$SET{'stat_current'}/\u\L$SET{'stat_current'}/;
+ $item->default_handler($get_size_only, undef, "$SET{'stat_current'} $SET{'songbase'} $SET{'stat_time'}", 1);
+ }
+}
+
+sub mute {
+ &read_settings;
+ &current_window;
+
+ my @i = `$SET{'intrashell'}`;
+ my $j;
+ # This next conditional is for when the music is not playing
+ if (exists $i[2]) {
+ $j = $i[2];
+ } else {
+ $j = $i[0];
+ }
+ if ($j =~ m/volume\:\s{0,2}(\d{1,3})\%/) {
+ $j = $1;
+ }
+
+ if ($j != 0 and ! $SAVE_VARS{'muted'} == 0) {
+ print "Warning: Not currently muted, although it said it was";
+ delete $SAVE_VARS{'muted'}
+ }
+ if ($j == 0 and ! $SAVE_VARS{'muted'}) {
+ print "Error: Volume is currently muted, but I don't know how it got there. Manually set the volume please.";
+ delete $SAVE_VARS{'muted'};
+ }
+ if (!$SAVE_VARS{'muted'}) {
+ $SAVE_VARS{'muted'} = $j;
+ `$SET{'intrashell'} volume 0`;
+ print "Sound is muted, to unmute just hit /mmute again";
+ } else {
+ `$SET{'intrashell'} volume $SAVE_VARS{'muted'}`;
+ print "Reset the volume back to it's originial position ($SAVE_VARS{'muted'}%)";
+ delete $SAVE_VARS{'muted'};
+ }
+}
+
+sub next {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} next" );
+ &set_active;
+ &mpdbar_refresh; # Impatience
+}
+
+sub pause {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} pause" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+}
+
+sub play {
+ &read_settings;
+ my $i;
+ &current_window;
+ if ($_[0] =~ m/\d{1,6}/) {
+ $i = $_[0];
+ }
+ Irssi::command( "$SET{'intrairssi'} play $i" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+}
+
+sub playlist {
+ &read_settings;
+ my @playlist;
+ if ($_[0] =~ m/\d{1,6}\-\d{1,6}/) {
+ my ($head,$tail);
+ my @playlist = `$SET{'intrashell'} playlist`;
+ ($head, $tail) = split /-/, $_[0];
+
+ # OK, just understand I'm here for you if you're
+ # tired enough to let this happen to you.
+ if($head > $tail) {
+ my $i;
+ $i = $head;
+ $head = $tail;
+ $tail = $i;
+ }
+
+ $head =~ $head--;
+ $tail = $tail - $head;
+ chomp $head;
+ chomp $tail;
+
+ @playlist = splice(@playlist,$head,$tail);
+ my $i = pop(@playlist);
+ chomp $i;
+ push (@playlist,$i);
+ print @playlist;
+ } else {
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} playlist" );
+ &set_active;
+ }
+}
+
+sub playlist_load {
+ if ($_[0]) {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} load \Q$_[0]\E" );
+ &set_active;
+ } else {
+ print "%W/mplaylistload <file> %w- Load playlist <file>";
+ }
+}
+
+sub playlist_remove {
+ if ($_[0]) {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} rm \Q$_[0]\E" );
+ &set_active;
+ }
+}
+
+sub playlist_save {
+ if ($_[0]) {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} save \Q$_[0]\E" );
+ &set_active;
+ } else {
+ print "%W/mplaylistsave <file> %w- Save playlist <file>";
+ }
+}
+
+sub playlistsearch {
+ if ($_[0]) {
+ &read_settings;
+ my @i = split / /, $_[0];
+ &current_window;
+ foreach(@i) {
+ Irssi::command( "$SET{'intrairssi'} playlist | grep $_" );
+ }
+ &set_active;
+ } else {
+ print "%W/pls {search term} {search term}..%w";
+ print " - Search for {search term} and automagically and show the playlist entry";
+ }
+}
+
+sub previous {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} prev" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+}
+
+sub random{
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} random" );
+ &set_active;
+}
+
+sub read_settings {
+ ($SET{'mbar_time'}) && Irssi::timeout_remove($SET{'mbar_time'});
+ $SET{'mbar_time'}=Irssi::timeout_add(Irssi::settings_get_int('mpdbar_refresh') * 1000, 'mpdbar_refresh', undef);
+
+ $SET{'current'} = Irssi::settings_get_bool('current_window');
+ $SET{'output'} = Irssi::settings_get_int('output_window');
+
+ if (Irssi::settings_get_int( "mpd_port" )) {
+ $SET{'port'} = Irssi::settings_get_int( "mpd_port" );
+ $SET{'port'} = "MPD_PORT=$SET{'port'}"
+ }
+ if (Irssi::settings_get_str( "mpd_host" )) {
+ $SET{'host'} = Irssi::settings_get_str( "mpd_host" );
+ $SET{'host'} = "MPD_HOST=$SET{'host'}"
+ }
+ my $MPC_BIN;
+ if ( ! -x $SET{'mpc_override'} ) {
+ my @paths = split/:/,$ENV{'PATH'};
+
+ foreach(@paths) {
+ my $path = $_;
+ if( -x "$path" . "/" . "mpc" ) {
+ $MPC_BIN = "$path/mpc";
+ }
+ }
+ } else {
+ $MPC_BIN = $SET{'mpc_override'};
+ }
+
+ if (! $MPC_BIN) {
+ print "mpc was not found in any of the known paths";
+ print "mpc is required to use this script, please download it from http://musicpd.org/files.php";
+ }
+
+ $SET{'intrashell'} = "$SET{'port'} $SET{'host'} $MPC_BIN";
+ $SET{'intrairssi'} = "exec - $SET{'intrashell'}";
+}
+
+sub repeat {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} repeat" );
+ &set_active;
+}
+
+sub remove_song {
+ &read_settings;
+ if ($_[0] =~ m/\d{1,6}/ or $_[0] =~ m/\d{1,6}\-\d{1,6}/) {
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} del $_[0]" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+ } else {
+ print "%W/mrm <num> <num>.. %w- Remove song from the current playlist (by number)";
+ print "%w - Note that <num> can be a range also";
+ }
+}
+
+sub search {
+ if ($_[0]) {
+ &read_settings;
+ my $j;
+ &current_window;
+ if ($_[0] =~ /^album\s/ or $_[0]=~ /^filename\s/ or $_[0]=~ /^title\s/ or $_[0]=~ /^artist\s/ ) {
+ my @i = split / /, $_[0];
+ $j = $i[0];
+ $_[0] =~ s/^(\w+)\s//;
+ } else {
+ $j = "filename";
+ }
+ Irssi::command( "$SET{'intrairssi'} search $j \Q$_[0]\E" );
+ &set_active;
+ } else {
+ print "%W/search (album|artist|filename|title) {search term} {search term}..%w";
+ print " - Search for {search term} and automagically add it to the end of the queue";
+ print " - If not specified it will use filename by default";
+ }
+}
+
+sub seek {
+ &read_settings;
+ if ($_[0] =~ m/\d{1,3}/) {
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} seek $_[0]" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+ } else {
+ print "%W/mseek <num> %w- Seeks to the spot specified for the current file, in terms of percent time (0-100)";
+ }
+}
+
+sub set_active {
+ if (! $SET{'current'}) {
+ $SET{'active'}->set_active;
+ }
+}
+
+sub shuffle{
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} shuffle" );
+ &set_active;
+}
+
+sub song_count {
+ %COUNT = undef;
+
+ my @counts = `$SET{'intrashell'}`;
+ chomp(@counts);
+
+ if ($counts[1] =~ m/\#(\d{1,6})\//) {
+ $COUNT{'song'} = $1;
+ }
+ if ($counts[1] =~ m/\/(\d{1,6})\s/) {
+ $COUNT{'playlist'} = $1;
+ }
+ if ($COUNT{'song'} > 1) {
+ my $i = $COUNT{'song'} - 1;
+ $COUNT{'sr1'} = "1-$i";
+ }
+ if ($COUNT{'song'} < $COUNT{'playlist'}){# and $COUNT{'song'} != $COUNT{'playlist'}) {
+ my $i = $COUNT{'song'} + 1;
+ $COUNT{'sr2'} = "$i-$COUNT{'playlist'}";
+ }
+}
+
+sub stop {
+ &read_settings;
+ my ($i,$time);
+ if ($_[0]) {
+ my $unit;
+ ($time, $unit) = split / /, $_[0];
+ if ($unit =~ /minute/i or $unit =~ /minutes/i) {
+ $time = ($time * 60);
+ }
+ if ($unit =~ /hour/i or $unit =~ /hours/i) {
+ $time = ($time * 86400);
+ }
+ #ok. it's ridiculous to use this script for days, but in any case here ya go.
+ if ($unit =~ /day/i or $unit =~ /days/i) {
+ $time = ($time * 2073600);
+ }
+ $time = $time . "s";
+ $i = "exec - /bin/sleep $time && $SET{'intrashell'} stop";
+ } else {
+ $i = "$SET{'intrairssi'} stop";
+ }
+ &current_window;
+ Irssi::command( "$i" );
+ &mpdbar_refresh; # Impatience
+ &set_active;
+}
+
+sub update {
+ &read_settings;
+ &current_window;
+ Irssi::command( "$SET{'intrairssi'} update" );
+ Irssi::print( "Irssi will not be accepting commands while updating" );
+ &set_active;
+}
+
+sub volume {
+ &read_settings;
+ &current_window;
+ my (@i,$j);
+ if ($_[0] =~ m/\d{1,3}/) {
+ @i = `$SET{'intrashell'} volume $_[0]`;
+ } else {
+ @i = `$SET{'intrashell'}`;
+ }
+ # This next conditional is for when the music is not playing
+ if (exists $i[2]) {
+ $j = $i[2];
+ } else {
+ $j = $i[0];
+ }
+ if ($j =~ m/volume\:\s{0,2}(\d{1,3})\%/) {
+ $j = $1;
+ }
+ # OK, if anyone wants to tell me _why_ this seems to be the only way
+ # to get a "%" on the end please feel free (suspected to be due to
+ # color codes
+ if ($_[0]) {
+ Irssi::print( "The volume is at $j%" . "%" );
+ } else {
+ $SET{'active'}->print( "The volume is at $j%" . "%" );
+ }
+ &set_active;
+}
+
+sub wipe {
+ &read_settings;
+ &current_window;
+ &song_count;
+ if($COUNT{'sr1'} or $COUNT{'sr2'}) {
+ Irssi::command( "$SET{'intrairssi'} del $COUNT{'sr1'} $COUNT{'sr2'}" );
+ } else {
+ Irssi::print( "Can't wipe when there's only one song in the playlist" );
+ }
+ &set_active;
+}
+
+sub wipeAdd{
+ if ($_[0]) {
+ &read_settings;
+ &song_count;
+ my $j;
+ if ($_[0] =~ /^album\s/ or $_[0]=~ /^filename\s/ or $_[0]=~ /^title\s/ or $_[0]=~ /^artist\s/ ) {
+ my @i = split / /, $_[0];
+ $j = $i[0];
+ $_[0] =~ s/^(\w+)\s//;
+ } else {
+ $j = "filename";
+ }
+ &current_window;
+ if($COUNT{'sr1'} or $COUNT{'sr2'}) {
+ Irssi::command( "$SET{'intrairssi'} del $COUNT{'sr1'} $COUNT{'sr2'} && $SET{'intrashell'} search $j \Q$_[0]\E | $SET{'intrashell'} add" );
+ } else { # Do the thinking for the person
+ Irssi::command( "$SET{'intrairssi'} search $j \Q$_[0]\E | $SET{'intrashell'} add" );
+ }
+ &set_active;
+ } else {
+ print "%W/mwa (wipe add) (album|artist|filename|title) {search term} {search term}..%w";
+ print " - Search for {search term} and automagically add it to the end of the queue";
+ print " - This command does not support play number. (it doesn't make sense)";
+ print " - If not specified it will use filename by default"
+ }
+}
+
+sub wipeAddall{
+ &read_settings;
+ &song_count;
+ &current_window;
+ if($COUNT{'sr1'} or $COUNT{'sr2'}) {
+ Irssi::command( "$SET{'intrairssi'} del $COUNT{'sr1'} $COUNT{'sr2'} && $SET{'intrashell'} add \"\"" );
+ } else {
+ Irssi::command( "$SET{'intrairssi'} add \"\"" );
+ }
+ &set_active;
+}
+
+sub wipeAddallShuffle{
+ &read_settings;
+ &song_count;
+ &current_window;
+ if($COUNT{'sr1'} or $COUNT{'sr2'}) {
+ Irssi::command( "$SET{'intrairssi'} del $COUNT{'sr1'} $COUNT{'sr2'} && $SET{'intrashell'} add \"\" && $SET{'intrashell'} shuffle" );
+ } else {
+ Irssi::command( "$SET{'intrairssi'} add \"\" && $SET{'intrashell'} shuffle" );
+ }
+ &set_active;
+}
+
+sub wipeAddShuffle{
+ if ($_[0]) {
+ &read_settings;
+ my $j;
+ if ($_[0] =~ /^album\s/ or $_[0]=~ /^filename\s/ or $_[0]=~ /^title\s/ or $_[0]=~ /^artist\s/ ) {
+ my @i = split / /, $_[0];
+ $j = $i[0];
+ $_[0] =~ s/^(\w+)\s//;
+ } else {
+ $j = "filename";
+ }
+ &song_count;
+ &current_window;
+ if($COUNT{'sr1'} or $COUNT{'sr2'}) {
+ Irssi::command( "$SET{'intrairssi'} del $COUNT{'sr1'} $COUNT{'sr2'} && $SET{'intrashell'} search $j \Q$_[0]\E | $SET{'intrashell'} add && $SET{'intrashell'} shuffle" );
+ } else {
+ Irssi::command( "$SET{'intrairssi'} search $j \Q$_[0]\E | $SET{'intrashell'} add && $SET{'intrashell'} shuffle" );
+ }
+ &set_active;
+ } else {
+ print "%W/mwas (wipe add shuffle) (album|artist|filename|title) {search term} {search term}..%w";
+ print " - Search for {search term} and automagically add it to the end of the queue";
+ print " - This command does not support play number. (it doesn't make sense)";
+ print " - If not specified it will use filename by default";
+ }
+}
+Irssi::settings_add_int('misc', 'mpdbar_refresh', '5');
+
+&load_settings;
+&mpdbar_refresh;
+
+Irssi::command_bind madd => \&add;
+Irssi::command_bind maddall => \&addall;
+# Irssi::command_bind maddnext => \&addNext;
+Irssi::command_bind maap => \&addallPlay;
+Irssi::command_bind maasp => \&addallShufflePlay;
+Irssi::command_bind mas => \&addShuffle;
+Irssi::command_bind masp => \&addShufflePlay;
+Irssi::command_bind map => \&addPlay;
+Irssi::command_bind mclear => \&clear;
+Irssi::command_bind mclearback => \&clearback;
+Irssi::command_bind mcaap => \&clearAddAllPlay;
+Irssi::command_bind mcaasp => \&clearAddAllShufflePlay;
+Irssi::command_bind mcap => \&clearAddPlay;
+Irssi::command_bind mcasp => \&clearAddShufflePlay;
+Irssi::command_bind mdel => \&delete;
+Irssi::command_bind mls => \&ls;
+Irssi::command_bind mhelp => \&iMPD_help;
+Irssi::command_bind mhelpadv => \&iMPD_helpAdv;
+Irssi::command_bind minfo => \&current_status;
+Irssi::command_bind mloud => \&loud;
+Irssi::command_bind mlouder => \&louder;
+Irssi::command_bind mmute => \&mute;
+Irssi::command_bind mnext => \&next;
+Irssi::command_bind mpause => \&pause;
+Irssi::command_bind mhelpmpdbar => \&mpdbar_help;
+Irssi::command_bind mmove => \&move;
+Irssi::command_bind mplay => \&play;
+Irssi::command_bind mplaylist => \&playlist;
+Irssi::command_bind mpls => \&playlistsearch;
+Irssi::command_bind mplaylistls => \&lsplaylists;
+Irssi::command_bind mplaylistload => \&playlist_load;
+Irssi::command_bind mplaylistrm => \&playlist_remove;
+Irssi::command_bind mplaylistsave => \&playlist_save;
+Irssi::command_bind mprev => \&previous;
+Irssi::command_bind mrandom => \&random;
+Irssi::command_bind mrepeat => \&repeat;
+Irssi::command_bind mrm => \&remove_song;
+Irssi::command_bind mseek => \&seek;
+Irssi::command_bind msearch => \&search;
+Irssi::command_bind mshuffle => \&shuffle;
+Irssi::command_bind mstop => \&stop;
+Irssi::command_bind mupdate => \&update;
+Irssi::command_bind mvolume => \&volume;
+Irssi::command_bind mwa => \&wipeAdd;
+Irssi::command_bind mwaa => \&wipeAddall;
+Irssi::command_bind mwaas => \&wipeAddallShuffle;
+Irssi::command_bind mwas => \&wipeAddShuffle;
+Irssi::command_bind mwipe => \&wipe;
diff --git a/scripts/identify-md5.pl b/scripts/identify-md5.pl
new file mode 100644
index 0000000..f6680fd
--- /dev/null
+++ b/scripts/identify-md5.pl
@@ -0,0 +1,168 @@
+use Irssi;
+use Digest::MD5 qw(md5_hex);
+use strict;
+use vars qw($VERSION %IRSSI @identify @reop);
+
+$VERSION = '1.05';
+%IRSSI = (
+ authors => 'Eric Jansen',
+ contact => 'chaos@sorcery.net',
+ name => 'identify-md5',
+ description => 'MD5 NickServ identification script for SorceryNet',
+ license => 'GPL',
+ modules => 'Digest::MD5',
+ url => 'http://xyrion.org/irssi/',
+ changed => 'Sat Mar 1 13:32:30 CET 2003'
+);
+
+################################################################################
+#
+# MD5 NickServ identification script for SorceryNet (irc.sorcery.net)
+#
+# The script will do several things:
+# - It adds the command /identify-md5 to Irssi, which can be used to identify
+# to your current nickname or a list of nicknames given as arguments using
+# the passwords provided below
+# - It will automatically issue this command whenever NickServ notices you
+# that you need to identify (e.g. after a services outage)
+# - It will remember any channels ChanServ deopped you in and try to regain
+# ops after authentication is accepted by NickServ
+#
+# For more information on SorceryNets MD5 identification see:
+# http://www.sorcery.net/help/howto/MD5_identify
+#
+# Put your nicknames and MD5-hashed passwords here:
+#
+
+my %nicknames = (
+ lc('nick1') => md5_hex('password1'), # Plain text password 'password1'
+ lc('nick2') => '6cb75f652a9b52798eb6cf2201057c73', # MD5-hash of password 'password2'
+ lc('nick3') => md5_hex('password3')
+);
+
+#
+# Please note: This file should NOT be world-readable. Although it's (quite)
+# impossible to get the original passwords from the hashes, a
+# malicious person can identify using the hash and then change
+# your password without knowing the old password.
+#
+################################################################################
+
+sub cmd_identify {
+
+ my ($data, $server, $witem) = @_;
+
+ # Are we connected?
+ if(!$server || !$server->{'connected'}) {
+
+ Irssi::print("Not connected to a server.");
+ return;
+ }
+
+ # Did the user specify what nick(s) to identify to?
+ if($data ne '') {
+
+ # Store the list of nicknames to identify to then
+ @identify = split /\s+/, $data;
+ }
+ else {
+
+ # Or put our current nick on the list
+ push @identify, $server->{'nick'};
+ }
+
+ # Start with some checks
+ for(my $i = $#identify; $i >= 0; $i--) {
+
+ # If we don't know the password
+ if(!defined $nicknames{lc $identify[$i]}) {
+
+ # Send an error
+ Irssi::print("I do not know the password for ${identify[$i]}. Please add it to identify-md5.pl.");
+
+ # And remove the nick from the list
+ splice @identify, $i, 1;
+ }
+ }
+
+ # Let's ask NickServ for a cookie if there are nicks left
+ $server->command("QUOTE NickServ identify-md5") if $#identify >= 0;
+}
+
+sub event_notice {
+
+ my ($server, $text, $nick, $address) = @_;
+
+ # Just ignore it if we are not on SorceryNet
+ return unless $server->{'real_address'} =~ /\.sorcery\.net$/;
+
+ # Is it a notice from NickServ?
+ if($nick eq 'NickServ') {
+
+ # Is it a cookie and do we need one?
+ if($text =~ /^205 S\/MD5 1\.0 (.+)$/ && $#identify >= 0) {
+
+ my $cookie = $1;
+
+ my $nickname = lc shift @identify;
+ my $password = $nicknames{$nickname};
+
+ # Create the hash and send it
+ my $hash = md5_hex("$nickname:$cookie:$password");
+ $server->command("QUOTE NickServ identify-md5 $nickname $hash");
+
+ # Suppress the notice from NickServ
+ Irssi::signal_stop();
+
+ # And get a new cookie if there are still nicks left to identify to
+ $server->command("QUOTE NickServ identify-md5") if $#identify >= 0;
+ }
+
+ # Is it a response?
+ elsif($text =~ /^\d{3} \- (.+)$/) {
+
+ my $response = $1;
+
+ # Just print the text-part and suppress the notice
+ Irssi::print($response);
+
+ if($response eq 'Authentication accepted -- you are now identified.') {
+
+ foreach my $channel (@reop) {
+ $server->command("QUOTE ChanServ $channel op $server->{nick}");
+ }
+ undef @reop;
+ }
+
+ Irssi::signal_stop();
+ }
+
+ # Do we know the password? Let's see what NickServ has to tell us then
+ elsif(defined $nicknames{lc $server->{'nick'}}) {
+
+ # Identify when NickServ asks us to
+ if($text =~ /^This nick belongs to another user\./) {
+
+ $server->command("identify-md5");
+ Irssi::signal_stop();
+ }
+
+ # Just ignore this notice, we already identify when receiving the other one
+ elsif($text eq 'If this is your nick please try: /msg NickServ ID password') {
+
+ Irssi::signal_stop();
+ }
+ }
+ }
+
+ # If it's ChanServ saying it just deopped us, remember the channel so we can reop
+ elsif($nick eq 'ChanServ' && $text =~ /^You are not allowed ops in ([^\s]+)$/) {
+
+ push @reop, $1;
+
+ Irssi::signal_stop();
+ }
+}
+
+Irssi::command_bind('identify-md5', 'cmd_identify');
+Irssi::signal_add('message irc notice', 'event_notice');
diff --git a/scripts/idlesince.pl b/scripts/idlesince.pl
new file mode 100644
index 0000000..5e4b112
--- /dev/null
+++ b/scripts/idlesince.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+use strict;
+use Irssi;
+use Time::localtime;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.1";
+%IRSSI = (
+ authors => "Leszek Matok",
+ contact => "lam\@lac.pl",
+ name => "idlesince",
+ description => "Adds 'idle since' line to whois replies.",
+ license => "GPL",
+ url => "",
+ changed => "17.9.2002",
+);
+
+sub event_server_event {
+ my ($server, $text, $sname) = @_;
+ my @items = split(/ /,$text);
+
+ my $idlesince = ctime(time()-$items[2]);
+ $server->printformat($items[1], MSGLEVEL_CRAP, 'whois_idlesince',
+ $items[1], $idlesince );
+}
+
+Irssi::theme_register([
+ 'whois_idlesince' => '{whois idlesince %|$1}'
+]);
+Irssi::signal_add_last('event 317', 'event_server_event');
diff --git a/scripts/idletime.pl b/scripts/idletime.pl
new file mode 100644
index 0000000..34c5085
--- /dev/null
+++ b/scripts/idletime.pl
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+#
+# Do you feel tired of typing /wii ick nick?
+# Just try idletime.pl :)
+# By Stefan "tommie" Tomanek (stefan@kann-nix.org)
+
+use strict;
+use Irssi;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "20030208";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "idletime",
+ description => "Retrieves the idletime of any nick",
+ license => "GPLv2",
+ url => "",
+ changed => "$VERSION",
+ commands => "idle"
+);
+
+
+
+my %nicks;
+
+sub cmd_idle {
+ my ($nicks, $server) = @_;
+ foreach (split(/\s+/, $nicks)) {
+ push @{$nicks{$server->{chatnet}}}, $_;
+ $server->command("whois ".$_." ".$_);
+ }
+}
+
+sub event_server_event {
+ my ($server, $text, $nick, $user) = @_;
+ my @items = split(/ /,$text);
+ my $type = $items[0];
+
+ if ( ($type eq 301) or ($type eq "311") or ($type eq "312") or ($type eq "317") or ($type eq "318") or ($type eq "319") ) {
+ my $name = $items[2];
+ my $i = 0;
+ if ( has_item($name,@{$nicks{$server->{chatnet}}}) ) {
+ Irssi::signal_stop();
+ print_idletime($name, $server, $items[3]) if ($type eq "317");
+ splice(@{$nicks{$server->{chatnet}}},$i,1) if ($type eq "318");
+ $i++;
+ }
+ }
+}
+
+sub has_item {
+ my ($item, @list) = @_;
+ foreach (@list) {
+ $item == $_ && return(1);
+ }
+ return(0)
+}
+
+sub print_idletime {
+ my ($name, $ircnet, $time) = @_;
+ my $hours = int($time / 3600);
+ my $minutes = int(($time % 3600)/60);
+ my $seconds = int(($time % 3600)%60);
+ $ircnet->print(undef,$name." is idle for ".$hours." hours, ".$minutes." minutes and ".$seconds." seconds.", MSGLEVEL_CRAP);
+}
+
+Irssi::command_bind('idle', 'cmd_idle');
+Irssi::signal_add('server event', 'event_server_event');
diff --git a/scripts/idonkey.pl b/scripts/idonkey.pl
new file mode 100644
index 0000000..39e3b4f
--- /dev/null
+++ b/scripts/idonkey.pl
@@ -0,0 +1,1408 @@
+# iDonkey for mldonkey
+#
+## by Stefan Tomanek
+#
+
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "2004051601";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "iDonkey",
+ description => "equips Irssi with an interface to mldonkey",
+ license => "GPLv2",
+ changed => "$VERSION",
+ modules => "IO::Socket::INET Data::Dumper LWP::UserAgent HTML::Entities",
+ sbitems => "idonkey",
+ commands => "idonkey"
+);
+
+
+use Irssi 20020324;
+use Irssi::TextUI;
+use IO::Socket::INET;
+use LWP::UserAgent;
+use HTML::Entities;
+use Data::Dumper;
+use POSIX;
+use vars qw($forked $timer $timer2 $index %downloads $nresults $seen $credits $noul %edlinks $expected);
+
+sub show_help() {
+ my $help = $IRSSI{name}." $VERSION
+/idonkey (downloads)
+ List your current downloads
+/idonkey launch
+ Start a new mldonkey process
+/idonkey quit
+ Quit the mldonkey
+/idonkey servers (connected)
+ List connected servers
+/idonkey servers all
+ List all servers
+/idonkey servers connect <num>
+ Connect to server with id <num>
+ or connect more servers
+/idonkey servers disconnect <num>
+ Disconnnect from server with id <num>
+/idonkey overnet (stats)
+ Print OverNet statistics
+/idonkey dllink (force) <link>
+ Download an ed2k-link
+/idonkey search <query>
+ Query the donkey network for a file
+/idonkey results
+ Display the results of the last query
+/idonkey get (force) <num1> <num2>
+ Download the named files
+/idonkey pause <filename>
+ Pause a download
+/idonkey resume <filename>
+ Resume a download
+/idonkey cancel <filename>
+ Cancel a download
+/idonkey commit
+ Move downloaded files to the incoming directory
+/idonkey settings show
+ Display the current mldonkey settings
+/idonkey settings change <key> <value>
+ Change settings of mldonkey
+/idonkey shares reshare
+ Check all shared files
+/idonkey shares close
+ Close all open file descriptors
+/idonkey sharereactor (latest)
+ Display the latest releases
+/idonkey sharereactor search <query>
+ Search www.sharereactor.com
+/idonkey sharereactor download <release>
+ Download all files of a release
+/idonkey bittorrent search <quer>
+ Search torrents
+/idonkey noupload <min>
+ Disable uploading for <min> minutes
+/idonkey client-stats
+ Display detailed client statistics
+/idonkey forget
+ Clear all searches
+";
+ my $text = '';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP &draw_box($IRSSI{name}, $text, "help", 1);
+}
+
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ unless ($colour) {
+ $box =~ s/%(.)/$1 eq '%'?$1:''/eg;
+ }
+ return $box;
+}
+
+sub array2table {
+ my (@array) = @_;
+ my @width;
+ foreach my $line (@array) {
+ for (0..scalar(@$line)-1) {
+ my $l = $line->[$_];
+ $l =~ s/%[^%]//g;
+ $l =~ s/%%/%/g;
+ $width[$_] = length($l) if $width[$_]<length($l);
+ }
+ }
+ my $text;
+ foreach my $line (@array) {
+ for (0..scalar(@$line)-1) {
+ my $l = $line->[$_];
+ $text .= $line->[$_];
+ $l =~ s/%[^%]//g;
+ $l =~ s/%%/%/g;
+ $text .= " "x($width[$_]-length($l)+1) unless ($_ == scalar(@$line)-1);
+ }
+ $text .= "\n";
+ }
+ return $text;
+}
+
+sub donkey_connect {
+ my $host = Irssi::settings_get_str('idonkey_host');
+ my $port = Irssi::settings_get_int('idonkey_port');
+ my $password = Irssi::settings_get_str('idonkey_password');
+ my $sock = IO::Socket::INET->new(PeerAddr => $host,
+ PeerPort => $port,
+ Proto => 'tcp');
+ return 0 unless $sock;
+ my $password = Irssi::settings_get_str('idonkey_password');
+ while ($_ = $sock->getline()) {
+ s/\e.*?m//g;
+ if (/Use \? for help/) {
+ $sock->print("auth ".$password."\n");
+ } elsif (/Full access enabled/) {
+ $sock->print("ansi false\n");
+ foreach (1..3) {
+ $sock->getline();
+ }
+ return $sock;
+ } elsif (/Bad login\/password/) {
+ $sock->close();
+ return 0;
+ }
+ }
+}
+
+sub bg_do ($) {
+ my ($cmd) = @_;
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ return if $forked > 1;
+ $forked++;
+ my $pid = fork();
+ if ($pid > 0) {
+ close $wh;
+ Irssi::pidwait_add($pid);
+ my $pipetag;
+ my @args = ($rh, \$pipetag); $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
+ } else {
+ eval {
+ my $result;
+ if ($cmd eq 'downloads') {
+ $result->{downloads} = get_downloads();
+ } elsif ($cmd =~ /^(pause|cancel|resume) (.*)/) {
+ transfer_command($1, $2);
+ } elsif ($cmd =~ /^results *(.*)/) {
+ $result->{results} = get_results($1);
+ } elsif ($cmd eq 'servers') {
+ $result->{servers} = get_servers(0);
+ } elsif ($cmd eq 'allservers') {
+ $result->{servers} = get_servers(1);
+ } elsif ($cmd eq 'status') {
+ if (Irssi::settings_get_bool('idonkey_update_results')) {
+ #$result->{nresults} = scalar @{ get_results('/.*/')->{results} };
+ }
+ $result->{status} = get_status_info();
+ } elsif ($cmd eq 'ovstats') {
+ $result->{ovstats} = get_ovstats();
+ } elsif ($cmd =~ /^settings (.*?)$/) {
+ my $regexp = $1;
+ $regexp = '.*' unless $regexp;
+ $result->{settings} = get_settings($regexp);
+ } elsif ($cmd =~ /^set (.*?) (.*)$/) {
+ my ($key, $val) = ($1, $2);
+ $result->{change} = change_setting($key, $val);
+ } elsif ($cmd eq 'reshare') {
+ $result->{reshare} = reshare();
+ } elsif ($cmd eq 'close_fds') {
+ $result->{close_fds} = close_fds();
+ } elsif ($cmd =~ /^sr-search (.*)$/) {
+ $result->{sr_search} = sharereactor_search($1);
+ } elsif ($cmd eq "sr-latest") {
+ $result->{sr_latest} = sharereactor_latest();
+ } elsif ($cmd =~ /^bt-search (.*)$/) {
+ $result->{bt_search} = bittorrent_search($1);
+ } elsif ($cmd =~ /^noupload (.*)$/) {
+ $result->{noupload} = no_upload($1);
+ } elsif ($cmd eq 'client-stats') {
+ $result->{client_stats} = get_client_stats();
+ } elsif ($cmd eq 'forget') {
+ $result->{forget} = forget_searches();
+ } elsif ($cmd =~ /^fake (.*)/) {
+ $result->{fake} = check_fake($1);
+ }
+ my $dumper = Data::Dumper->new([$result]);
+ $dumper->Purity(1)->Deepcopy(1);
+ my $text = $dumper->Dump;
+ print($wh $text);
+ #store_fd $result, $wh;
+ close($wh);
+ };
+ POSIX::_exit(1);
+ }
+
+}
+
+sub pipe_input {
+ my ($rh, $pipetag) = @{$_[0]};
+ $forked--;
+ Irssi::input_remove($$pipetag);
+ my $text;
+ $text .= $_ foreach <$rh>;
+ #print "RETURN";
+ #print $text;
+ no strict 'vars';
+ my $result = eval "$text";
+ return unless ref $result;
+ %downloads = %{ $result->{downloads} } if ref $result->{downloads};
+ $expected = $result->{results}->{waiting} if defined $result->{results} && $result->{results}->{waiting};
+ show_client_stats($result->{client_stats}) if ref $result->{client_stats};
+ list_downloads($result->{downloads}) if ref $result->{downloads};
+ list_results($result->{results}) if ref $result->{results};
+ list_servers($result->{servers}) if ref $result->{servers};
+ show_ovstats($result->{ovstats},0) if ref $result->{ovstats};
+ show_settings($result->{settings}) if ref $result->{settings};
+ show_change($result->{change}) if ref $result->{change};
+ update_status($result->{status}) if ref $result->{status};
+ show_sr_search($result->{sr_search}) if ref $result->{sr_search};
+ show_sr_latest($result->{sr_latest}) if ref $result->{sr_latest};
+ show_bt_search($result->{bt_search}) if ref $result->{bt_search};
+ store_links($result->{sr_search}) if ref $result->{sr_search};
+ store_links_bt($result->{bt_search}) if ref $result->{bt_search};
+ $nresults = $result->{nresults} if $result->{nresults};
+
+ show_fake($result->{fake}) if $result->{fake};
+ print CLIENTCRAP "%B>>%n Forgot ".$result->{forget}." searche(s)" if exists $result->{forget};
+ print CLIENTCRAP "%B>>%n Upload disabled for ".$result->{noupload}->[0]." minutes" if exists $result->{noupload};
+ print CLIENTCRAP "%B>>%n Shares have been checked" if $result->{reshare};
+ print CLIENTCRAP "%B>>%n Files have been closed" if $result->{close_fds};
+}
+
+sub show_fake ($) {
+ my ($data) = @_;
+ my $name = $data->{filename};
+ my $hash = $data->{hash};
+ my $text = "%B>>%n '".$name."' [".$hash."] is ";
+ $text .= 'not ' unless $data->{fake};
+ $text .= 'a fake';
+ print CLIENTCRAP $text;
+}
+
+sub store_links ($) {
+ my ($results) = @_;
+ %edlinks = ();
+ foreach (@$results) {
+ $edlinks{$_->{name}} = $_->{files};
+ }
+}
+
+sub store_links_bt ($) {
+ my ($results) = @_;
+ %edlinks = ();
+ foreach (@$results) {
+ $edlinks{$_->{name}} = [ $_->{torrent} ];
+ }
+}
+
+
+sub check_fake ($) {
+ my ($num) = @_;
+ my $results = get_results('/.*/');
+ my $res;
+ foreach (@{$results->{results}}) {
+ #print $num." ".$_->{id};
+ $res = $_ if $_->{id} eq $num;
+ }
+ return undef unless $res;
+ $res->{fake} = is_fake($res->{hash});
+ return $res;
+}
+
+sub forget_searches {
+ my $sock = donkey_connect();
+ return undef unless $sock;
+ my $i = 0;
+ foreach (keys %{ get_queries() }) {
+ $sock->print('forget '.$_."\n");
+ $i++;
+ }
+ $sock->print("q\n");
+ $sock->close();
+ return $i;
+}
+
+sub show_client_stats ($) {
+ my ($data) = @_;
+ my @table;
+ foreach (sort keys %$data) {
+ my $first = 1;
+ foreach my $item (sort keys %{ $data->{$_} }) {
+ next if $item eq 'banned';
+ next if $item eq 'seen';
+ next if $data->{$_}{$item}{num} == 0;
+ my @line;
+ push @line, $first ? "%9".$_."%9" : '';
+ $first = 0;
+ push @line, uc substr($item, 0, 1);
+ push @line, $data->{$_}{$item}{percent}."%";
+ push @line, '#'x(80/100 * $data->{$_}{$item}{percent});
+ push @table, \@line;
+ }
+ }
+ my $text = array2table(@table);
+ print CLIENTCRAP &draw_box('iDonkey', $text, 'Client Stats', 1);
+}
+
+sub show_sr_latest ($) {
+ my ($results) = @_;
+ my @table;
+ foreach (@$results) {
+ push @table, [$_->{date}, $_->{category}, "%9".$_->{title}."%9"];
+ #$text .= $_->{date}." %9".$_->{title}."%9 [".$_->{category}."]\n";
+ }
+ my $text = array2table(@table);
+ print CLIENTCRAP &draw_box('iDonkey', $text, 'Sharereactor latest releases', 1);
+}
+
+sub show_sr_search ($) {
+ my ($results) = @_;
+ my $text;
+ foreach (@$results) {
+ $text .= "%9".$_->{name}."%9 [".$_->{category}."]\n";
+ foreach (@{ $_->{files} }) {
+ $text .= '-> '.$_."\n";
+ }
+ }
+ print CLIENTCRAP &draw_box('iDonkey', $text, 'ShareReactor', 1);
+}
+
+sub show_bt_search ($) {
+ my ($results) = @_;
+ my $text;
+ foreach (@$results) {
+ $text .= "%9".$_->{name}."%9\n";
+ my $url = $_->{torrent};
+ $url =~ s/%/%%/g;
+ $text .= "-> $url\n";
+ }
+ print CLIENTCRAP &draw_box('iDonkey', $text, 'BitTorrent results', 1);
+}
+
+sub show_change (\%) {
+ my ($change) = @_;
+ print CLIENTCRAP "%B>>%n [iDonkey] Setting %9".$change->{key}."%9 changed from '".$change->{old}."' to '".$change->{new}."'";
+}
+
+sub show_settings (\%) {
+ my ($settings) = @_;
+ my @table;
+ foreach (sort keys %$settings) {
+ push @table, ["%9".$_."%9", $settings->{$_}];
+ }
+ my $text = array2table(@table);
+ print CLIENTCRAP &draw_box('iDonkey', $text, 'settings', 1);
+}
+
+sub show_ovstats (\%$) {
+ my ($stats, $nodes) = @_;
+ my $text;
+
+ if ($nodes) {
+ $text .= "%9Connected nodes:%9\n";
+ $text .= ' '.$_."\n" foreach @{ $stats->{nodes} };
+ $text .= "\n";
+ }
+ #$text .= @{ $stats->{nodes} }." connected nodes\n\n";
+ $text .= "%9Search hits:%9 ".$stats->{search_hits}."\n";
+ $text .= "%9Source hits:%9 ".$stats->{source_hits};
+ print CLIENTCRAP &draw_box('iDonkey', $text, 'OverNet stats', 1);
+}
+
+sub update_status (\%) {
+ my ($data) = @_;
+ return unless ref $data;
+ $expected = $data->{waiting};
+ $noul = $data->{noupload};
+ $credits = $data->{credit};
+ %downloads = %{ $data->{downloads} };
+ Irssi::statusbar_items_redraw('idonkey');
+}
+
+sub no_upload ($) {
+ my ($min) = @_;
+ my $sock = donkey_connect();
+ return undef unless $sock;
+ my $noup;
+ my $credit;
+ $sock->print('nu '.$min."\n");
+ $sock->flush();
+ $sock->print("vu\n");
+ while ($_ = $sock->getline()) {
+ if (/^Upload credits : (\d+) minutes$/) {
+ $credit = $1;
+ } elsif (/^Upload disabled for (\d+)/) {
+ $noup = $1;
+ $sock->close();
+ }
+ }
+ return [$noup, $credit];
+}
+
+sub get_client_stats {
+ my %stats;
+ my $sock = donkey_connect();
+ return \%stats unless $sock;
+ $sock->print("client_stats\n");
+ my $op;
+ while ($_ = $sock->getline()) {
+ if (/Total seens:/) {
+ $op = "seen";
+ } elsif (/Total filerequests received:/) {
+ $op = "requests";
+ } elsif (/Total downloads:/) {
+ $op = "downloads";
+ } elsif (/Total uploads:/) {
+ $op = "uploads";
+ } elsif (/Total banneds:/) {
+ $op = "banned";
+ } elsif (/^ *(.*?): *(\d+) \((\d+\.\d+) %\)/) {
+ $stats{$1}{$op}{num} = $2;
+ $stats{$1}{$op}{percent} = $3;
+ } elsif (/^$/) {
+ $sock->close();
+ last;
+ }
+ }
+ return \%stats;
+}
+
+sub get_downloads {
+ my %downloads;
+ my $sock = donkey_connect();
+ return \%downloads unless $sock;
+ $sock->print("vd\n");
+ my $ready;
+ my $nfiles;
+ my @files;
+ my $sent;
+ while ($_ = $sock->getline()) {
+ my $line = $_;
+ #print $line foreach (1..100);
+ if (/^Downloaded (\d+)\/(\d+) files/) {
+ $nfiles = $1+$2;
+ #} elsif (/^\[(.*?) *(\d+) *?\] +(?:.*?) +([-0-9.]+) +(?:-?\d+) +(?:\d+) +[\d-]+:([\d-]+) +([0-9.-]+|Paused|Queued)/) {
+ } elsif (/^\[(.*?) *(\d+) *?\] +(?:.*?) +([-0-9.]+) +(?:-?\d+) +(?:\d+) +(?:\d+) +[\d-]+:([\d-]+) +\d+\/\d+ +([0-9.-]+|Paused|Queued)/) {
+ #print $_;
+ my $id = $2;
+ $downloads{$id}{percent} = $3;
+ $downloads{$id}{available} = ($4 == 0) ? 1 : 0;
+ $downloads{$id}{rate} = $5;
+ push @files, $id;
+ } elsif (/^ *\[(.*?) *(\d+) *?\] +(.*?) +(\d+) +[0-9A-Z]{32}/) {
+ my $id = $2;
+ $downloads{$id}{net} = $1;
+ $downloads{$id}{percent} = 100;
+ $downloads{$id}{rate} = "Completed";
+ $downloads{$id}{size} = $4;
+ $downloads{$id}{downloaded} = $4;
+ push @{ $downloads{$id}{names} }, $3;
+ #$sock->print("vd ".$id."\n");
+ push @files, $id;
+ } elsif (/\[(.*?) *(\d+) *?\] +(.*?) +(\d+) +(\d+)$/) {
+ $downloads{$sent}{net} = $1;
+ $downloads{$sent}{size} = $4;
+ $downloads{$sent}{downloaded} = $5;
+ push @{ $downloads{$sent}{names} }, $3;
+ } elsif (/^ \((.*?)\)$/) {
+ push @{ $downloads{$sent}{names} }, $1;
+ } elsif (/^(\d+) sources:/) {
+ $downloads{$sent}{sources} = $1;
+ $sent = undef;
+ #$downloads{$processing}{onlist} = 0;
+ } elsif (/^Chunks: \[(\d+)\]/ && not $downloads{$sent}{net} eq 'BitTorrent') {
+ foreach (split(//, $1)) {
+ push @{ $downloads{$sent}{chunks} }, $_;
+ #print $processing if $processing eq '3';
+ }
+ }
+ $ready = 1 if (@files == $nfiles);
+ #} elsif (/^ *(?:.*?) \(last_ok <(?:.*?)> lasttry <(?:.*?)> nexttry <(?:.*?)> onlist (true|false)\)$/) {
+ # $downloads{$processing}{onlist}++ if $1 eq 'true';
+ #}
+ if (($nfiles == 0) || defined @files && @files == 0 && not defined $sent) {
+ $sock->close();
+ return \%downloads;
+ } else {
+ if ($ready && not defined $sent) {
+ $sent = pop @files;
+ if (1) {
+ $sock->close();
+ $sock = donkey_connect();
+ #$sock->print("id\n");
+ $sock->print('vd '.$sent."\n");
+ # What a hack :) FIXME in mldonkey
+ } else {
+ $sent = undef;
+ }
+ }
+ }
+ }
+}
+
+sub transfer_command ($$) {
+ my ($cmd, $transfer) = @_;
+ my $sock = donkey_connect();
+ return undef unless $sock;
+ my $downloads = get_downloads();
+ if ($downloads->{$transfer}) {
+ $sock->print($cmd." ".$transfer."\n");
+ } else {
+ foreach (keys %$downloads) {
+ foreach my $name (@{$downloads->{$_}{names}}) {
+ next unless $name eq $transfer;
+ $sock->print($cmd." ".$_."\n");
+ }
+ }
+ }
+ $sock->close();
+}
+
+sub sharereactor_latest {
+ my $ua = LWP::UserAgent->new(env_proxy => 1,
+ keep_alive => 1,
+ timeout => 30);
+ my $response = $ua->get('http://www.sharereactor.com/');
+ my @releases;
+ foreach (split /\n/, $response->content() ) {
+ if (/^<a href="release\.php\?id=(\d+)">(\d+\.\d+\.\d+) - (.*?)<\/a> <a href="category\.php\?id=\d+">\((.*?)\)<\/a><br>/) {
+ #print "FOO";
+ my $new = { date => $2, id => $1, title => $3, category => $4 };
+ push @releases, $new;
+ }
+ }
+ return \@releases;
+}
+
+sub sharereactor_search ($) {
+ my ($query) = @_;
+ my $enc_query = HTML::Entities::encode($query);
+ my $ua = LWP::UserAgent->new(env_proxy => 1,
+ keep_alive => 1,
+ timeout => 30);
+ my $response = $ua->get('http://www.sharereactor.com/search.php?search='.$enc_query.'&category=0');
+ return unless $response->is_success();
+ my @results;
+ foreach (split /\n/, $response->content()) {
+ if (/<a href="release\.php\?id=(\d+)">(.*?)<\/a>/) {
+ push @results, { name => $2, id => $1 };
+
+ my $ua2 = LWP::UserAgent->new(env_proxy => 1,
+ keep_alive => 1,
+ timeout => 30);
+ my $response2 = $ua2->get('http://www.sharereactor.com/downloadrelease.php?id='.$1);
+ foreach (split /\n/, $response2->content()) {
+ if (/"(ed2k:\/\/\|file\|.*?\|\d+\|.*?\|)";/) {
+ push @{ $results[-1]->{files} }, $1;
+ }
+ }
+ } elsif (/<a href="category\.php\?id=\d+">(.*?)<\/a>/) {
+ $results[-1]->{category} = $1;
+ }
+ }
+ #print $_->{name}." ".$_->{id}."\n" foreach @results;
+ return \@results;
+}
+
+sub bittorrent_search ($) {
+ my ($query) = @_;
+ my $enc_query = HTML::Entities::encode($query);
+ my $ua = LWP::UserAgent->new(env_proxy => 1,
+ keep_alive => 1,
+ timeout => 30);
+ my $response = $ua->get('http://www.bytemonsoon.com/?search='.$enc_query.'&cat=0&incldead=0');
+ return unless $response->is_success();
+ my @results;
+ foreach (split /\n/, $response->content()) {
+ if (/^<td><a href="details\.php\?id=(\d+)&amp;hit=1"><b>(.*?)<\/b><\/a><\/td>$/) {
+ push @results, { name => $2, id => $1 };
+ } elsif (/^<td align="center"><a href="(.*?)">torrent<\/a><\/td>$/) {
+ $results[-1]->{torrent} = "http://www.bytemonsoon.com/$1";
+ }
+ }
+ return \@results
+}
+
+sub get_ovstats {
+ my $sock = donkey_connect();
+ return unless $sock;
+ $sock->print("ovstats\n");
+ my $result;
+ $result->{nodes} = [];
+ while ($_ = $sock->getline()) {
+ if (/^ +(\d+\.\d+\.\d+.\d+:\d+)$/) {
+ push @{ $result->{nodes} }, $1;
+ } elsif (/^ Search hits: (\d+)$/) {
+ $result->{search_hits} = $1;
+ } elsif (/^ Source hits: (\d+)$/) {
+ $result->{source_hits} = $1;
+ } elsif (/^$/) {
+ last;
+ }
+ }
+ return $result;
+}
+
+sub is_fake ($) {
+ my ($hash) = @_;
+ my $ua = LWP::UserAgent->new(env_proxy => 1,
+ keep_alive => 1,
+ timeout => 30);
+ my $url = 'http://edonkeyfakes.ath.cx/fakecheck/update/fakecheck.php';
+ my %form = ( hash => $hash );
+ my $response = $ua->post($url, \%form);
+ return unless $response->is_success();
+ return not ($response->content() =~ /Your query didn't match anything in our fakedatabase\!/);
+}
+
+sub get_settings ($) {
+ my ($regexp) = @_;
+ my $sock = donkey_connect();
+ return unless $sock;
+ $sock->print("voo\n");
+ my $result = {};
+ while ($_ = $sock->getline()) {
+ if (/^(.*?) = (.*?)$/) {
+ my ($key, $val) = ($1, $2);
+ #print "<".$regexp.">";
+ next unless ($key =~ /$regexp/i);
+ $result->{$key} = $val;
+ } else {
+ $sock->close();
+ return $result;
+ }
+ }
+}
+
+sub reshare {
+ my $sock = donkey_connect();
+ return 0 unless $sock;
+ $sock->print("reshare\n");
+ $sock->close();
+ return 1;
+}
+
+sub close_fds {
+ my $sock = donkey_connect();
+ return 0 unless $sock;
+ $sock->print("close_fds\n");
+ $sock->close();
+ return 1;
+}
+
+sub change_setting ($$) {
+ my ($key, $val) = @_;
+ my $result;
+ $result->{key} = $key;
+ $result->{old} = get_settings($key)->{$key};
+ my $sock = donkey_connect();
+ return unless $sock;
+ $sock->print("set ".$key." ".$val."\n");
+ $sock->close();
+ #$result->{new} = $val;
+ $result->{new} = get_settings($key)->{$key};
+ return $result;
+}
+
+sub get_servers ($) {
+ my ($all) = @_;
+ my $sock = donkey_connect();
+ return unless $sock;
+ if ($all) {
+ $sock->print("vma\n");
+ } else {
+ $sock->print("vm\n");
+ }
+ my $result;
+ while ($_ = $sock->getline()) {
+ #if (/^\[(.*?) (\d+) *\] ([0-9.]+):(\d+) + (.*?) + (\d+) +(\d+) (Connected)?$/) {
+ if (/^\[(.*?) (\d+) *\] (.+):(\d+) + (.*?) + (\d+) +(\d+) (Connected)?$/) {
+ my $server = { net => $1,
+ id => $2,
+ ip => $3,
+ port => $4,
+ comment => $5,
+ users => $6,
+ files => $7
+ };
+ $result->{$2} = $server;
+ } elsif (/^ *$/) {
+ $sock->close();
+ return $result;
+ }
+ }
+}
+
+sub search_file ($) {
+ my ($query) = @_;
+ my $sock = donkey_connect();
+ return unless $sock;
+ $sock->print("s ".$query."\n");
+ while ($_ = $sock->getline()) {
+ if (/Query \d+ Sent to \d+/) {
+ $sock->close;
+ return 1;
+ } elsif (/exception/) {
+ $sock->close;
+ return 0;
+ }
+ }
+}
+
+sub list_downloads ($) {
+ my ($data) = @_;
+ my $text = downloads2text($data, '/.*/'); #downloads_list($data, '/.*/');
+ print CLIENTCRAP &draw_box('iDonkey', $text, 'Downloads', 1);
+}
+
+sub get_best_name ($) {
+ my ($names) = @_;
+ my $result;
+ foreach (@$names) {
+ # It's a hash
+ $result = $_;
+ last unless /[A-Z0-9]{32}/;
+ }
+ return $result;
+}
+
+sub downloads2text ($$) {
+ my ($downloads, $regexp) = @_;
+ my $length = Irssi::settings_get_int('idonkey_max_filename_length');
+ my $text;
+ my @table;
+ my @chunks;
+ my @names;
+ my ($speed, $downloaded, $size) = (0,0,0);
+ foreach (sort {get_best_name($downloads->{$a}{names}) cmp get_best_name($downloads->{$b}{names})} keys %$downloads) {
+ my @line;
+ my $filename = get_best_name($downloads->{$_}{names});
+ my $name = shorten_filename($filename, $length);
+ $name =~ s/%/%%/g;
+ my $download;
+ # Color codes:
+ # Yellow Paused
+ # Bold green Completed
+ # Green Downloading & 100% available
+ # Blue Downloading, but not completly on network
+ if ($downloads->{$_}{rate} =~ /Paused|Queued/) {
+ $download .= '%yo%n';
+ } elsif ($downloads->{$_}{rate} eq 'Completed') {
+ $download .= '%Go%n';
+ } else {
+ if ($downloads->{$_}{available}) {
+ $download .= '%go%n';
+ } else {
+ $download .= '%bo%n';
+ }
+ $speed += $downloads->{$_}{rate};
+ }
+ $size += $downloads->{$_}{size};
+ $downloaded += $downloads->{$_}{downloaded};
+ $download .= ' %9'.$name.'%9 ('.$_.')';
+ push @names, $download;
+ #$text .= "\n" if 1;
+ push @line, round($downloads->{$_}{downloaded}, $downloads->{$_}{size});
+ #$text .= ' '.round($downloads->{$_}{downloaded}, $downloads->{$_}{size})."/";
+ push @line, round($downloads->{$_}{size},$downloads->{$_}{size});
+ push @line, '('.$downloads->{$_}{percent}.'%%)';
+ #$text .= round($downloads->{$_}{size},$downloads->{$_}{size})." (".$downloads->{$_}{percent}."%%)";
+ if ($downloads->{$_}{rate} =~ /^[0-9.]+$/) {
+ push @line, $downloads->{$_}{rate}." kb/s";
+ } elsif ($downloads->{$_}{rate} eq '-') {
+ push @line, "0 kb/s";
+ } else {
+ push @line, $downloads->{$_}{rate};
+ }
+ #push @line, ' ['.$downloads->{$_}{sources}.'/'.$downloads->{$_}{onlist}.' @'.$downloads->{$_}{net}.']' if (defined $downloads->{$_}{sources});
+ my $netload = '[';
+ $netload .= $downloads->{$_}{sources}."@";
+ $netload .= $downloads->{$_}{net}.']';
+ push @line, $netload;
+ push @line, .$downloads->{$_}{tag};
+ #$text .= "\n";
+ if (1 || $downloads->{$_}{chunks}) {
+ if (ref $downloads->{$_}{chunks} && @{$downloads->{$_}{chunks}} > 1) {
+ my $chunk;
+ $chunk .= '[';
+ foreach (@{$downloads->{$_}{chunks}}) {
+ if ($_ > 1) {
+ $chunk .= '%g|%n';
+ } elsif ($_ == 1) {
+ $chunk .= '%b:%n';
+ } else {
+ $chunk .= '%r.%n';
+ }
+ }
+ $chunk .= "]";
+ push @chunks, $chunk;
+ } else {
+ push @chunks, "";
+ }
+ }
+ push @table, \@line;
+ }
+ foreach (split /\n/, array2table(@table)) {
+ $text .= (shift @names)."\n";
+ $text .= " ".$_."\n";
+ if (Irssi::settings_get_bool('idonkey_show_chunks')) {
+ my $chunk = shift @chunks;
+ $text .= " ".$chunk."\n" if $chunk;
+ }
+ }
+ my $percent = $size > 0 ? ($downloaded / $size)*100 : 0;
+ $percent = $1 if ($percent =~ /(\d+\.\d{1}).*?/);
+ if (keys %$downloads > 1) {
+ $text .= "".'%9Total:%9 ';
+ $text .= round($downloaded, $size).'/';
+ $text .= round($size, $size);
+ $text .= ' ('.$percent.'%%), '.$speed.' kb/s';
+ }
+ return $text;
+}
+
+sub round ($$) {
+ return $_[0] unless Irssi::settings_get_bool('idonkey_round_filesize');
+ if ($_[1] > 100000) {
+ return sprintf "%.2fMB", $_[0]/1024/1024;
+ } else {
+ return sprintf "%.2fKB", $_[0]/1024;
+ }
+}
+
+sub get_queries {
+ my $sock = donkey_connect();
+ # FIXME A real parser here?
+ return undef unless $sock;
+ $sock->print("vs\n");
+ my %result;
+ my $num;
+ while ($_ = readline($sock)) {
+ chop;
+ if (/^Searching (\d+) queries$/) {
+ $num = $1;
+ } elsif (/^\[(\d+) *\](.*) .*?$/) {
+ my $id = $1;
+ my $regexp = $2;
+ my @token = $regexp =~ /CONTAINS\[(.*?)\]/g;
+ $result{$id} = \@token;
+ $num--;
+ }
+ last if (defined $num && $num == 0);
+ }
+ return \%result;
+}
+
+sub get_results ($) {
+ my ($filter) = @_;
+ my $sock = donkey_connect();
+ my $net = '.*';
+ if ($filter =~ /-net (.*?)(?: |$)/) {
+ $net = $1;
+ }
+ #my $regexp = '.*';
+ my @filters;
+ while ($filter =~ /(\!?)\/(.*?)\//g) {
+ my %entry = ( "reverse" => $1 ? 1 : 0,
+ "regexp" => $2
+ );
+ push @filters, \%entry;
+ }
+ my $result;
+ my @results;
+ my $waiting = 0;
+ my $filtered = 0;
+ return undef unless $sock;
+ my $num = 0;
+ $sock->print("vr\n");
+ my @token;
+ while ($_ = readline($sock)) {
+ chop;
+ if (/^Result of search (\d+)$/) {
+ my $searches = get_queries();
+ @token = @{ $searches->{$1} } if ref $searches->{$1};
+ } elsif (/^(\d+) results \((?:done|(-?\d+) waiting)\)$/) {
+ $num = $1;
+ $waiting = $2 if $2;
+ unless ($num) {
+ $sock->close();
+ last();
+ }
+ } elsif (/^\[ *(\d+)\] (.*?(?: Napster)?) (.*)/) {
+ # FIXME Find a better Solution for open Napster
+ my %data = ( id=> $1, filename => $3, visible => 1, net => $2);
+
+ $data{visible} = 1 unless @filters;
+ foreach my $entry (@filters) {
+ next unless $data{visible};
+ my $regexp = $entry->{regexp};
+ my $reverse = $entry->{reverse};
+ if (not $reverse) {
+ $data{visible} = 0 if not ($data{filename} =~ /$regexp/i);
+ } else {
+ $data{visible} = 0 if ($data{filename} =~ /$regexp/i);
+ }
+ }
+ if (Irssi::settings_get_bool('idonkey_filter_search_results') && @token) {
+ foreach (@token) {
+ $data{visible} = 0 unless $data{filename} =~ /$_/i;
+ last unless $data{visible};
+ }
+ $data{visible} = 0 unless $data{net} =~ /$net/i;
+ }
+ if (Irssi::settings_get_bool('idonkey_filter_nameless_results')) {
+ $data{visible} = 0 unless $data{filename};
+ }
+ push @results, \%data;
+ } elsif (/^ ALREADY DOWNLOADED$/) {
+ $results[-1]->{downloaded} = 1;
+ } elsif (/^ +(-?\d+) ([0-9A-Z]{32}) (\d+)?/) {
+ $results[-1]->{size} = $1;
+ $results[-1]->{hash} = $2;
+ $results[-1]->{sources} = $3;
+ unless ($results[-1]->{visible}) {
+ pop @results;
+ $filtered++;
+ } else {
+ #$results[-1]->{fake} = is_fake($results[-1]->{hash});
+ }
+ } elsif (/No search to print/ || /^$/ || /^exception/) {
+ $sock->close();
+ last();
+ }
+ }
+ my $sortby = Irssi::settings_get_str('idonkey_sort_results_by');
+ @results = sort {uc($a->{$sortby}) <=> uc($b->{$sortby})} @results;
+ $result->{results} = \@results;
+ $result->{waiting} = $waiting;
+ $result->{filtered} = $filtered;
+ return $result;
+}
+
+sub list_servers ($) {
+ my ($data) = @_;
+ my @text;
+ foreach (sort { $data->{$a}{id} <=> $data->{$b}{id} } keys %$data) {
+ push @text, ["%9".$data->{$_}{id}."%9", $data->{$_}{net}, $data->{$_}{ip}.':'.$data->{$_}{port}, $data->{$_}{users}, $data->{$_}{files}, $data->{$_}{comment}];
+ }
+ unshift @text, ["%9ID%9", "%9net%9", "%9address%9", "%9users%9", "%9files%9", "%9comment%9"] if @text;
+ print CLIENTCRAP &draw_box('iDonkey', array2table(@text), 'servers', 1);
+}
+
+sub list_results ($) {
+ my ($data) = @_;
+ my $results = $data->{results};
+ my @text;
+ $seen = $nresults;
+ my $length = Irssi::settings_get_int('idonkey_max_filename_length');
+ foreach (@$results) {
+ my @line;
+ next unless $_->{visible};
+ my $file = shorten_filename($_->{filename}, $length);
+ $file =~ s/%/%%/g;
+ push @line, '%9'.$_->{id}.'%9';
+ push @line, '%9'.$file.'%9';
+ push @line, $_->{fake} ? '%RF%n' : '';
+ push @line, $_->{downloaded} ? '%GD%n' : '';
+ push @line, $_->{net} if defined $_->{net};
+ push @line, '['.$_->{sources}.']';
+ push @line, round($_->{size}, $_->{size});
+
+ push @text, \@line;
+ }
+ my $footer = 'Results';
+ $footer .= ' ('.$data->{filtered}.' filtered)' if $data->{filtered} > 0;
+ $footer .= ' ('.$data->{waiting}.' waiting)' if $data->{waiting} > 0;
+ print CLIENTCRAP &draw_box('iDonkey', array2table(@text), $footer, 1);
+}
+
+sub get_file ($$) {
+ my ($file, $force) = @_;
+ my $sock = donkey_connect();
+ return unless $sock;
+ $sock->print("d ".$file."\n");
+ while ($_ = $sock->getline()) {
+ if (/download started/) {
+ $sock->close();
+ return 1;
+ } elsif (/(File already downloaded|could not start download)/) {
+ if ($force) {
+ $sock->print("force_download\n");
+ $sock->close();
+ return 1
+ } else {
+ $sock->close();
+ return 0;
+ }
+ }
+ }
+}
+
+sub download_link ($$) {
+ my ($url, $force) = @_;
+ my $sock = donkey_connect();
+ return unless $sock;
+ $sock->print("dllink ".$url."\n");
+ $sock->print("force_download\n") if $force;
+ while ($_ = $sock->getline()) {
+ if (/download (started|forced)|Done/) {
+ $sock->close();
+ return 1;
+ } elsif (/Unable|bad syntax|exception/ && not $force) {
+ $sock->close();
+ return 0;
+ }
+ }
+}
+
+sub connect_servers ($$) {
+ my ($ids, $disconnect) = @_;
+ my $sock = donkey_connect();
+ return unless $sock;
+ $sock->print("c\n") unless (@$ids);
+ foreach (@$ids) {
+ if ($disconnect) {
+ $sock->print("x ".$_."\n");
+ } else {
+ $sock->print("c ".$_."\n");
+ }
+ }
+ $sock->close();
+}
+
+sub quit_donkey {
+ my $sock = donkey_connect();
+ return unless $sock;
+ $sock->print("kill\n");
+ $sock->close();
+ return 1;
+}
+
+sub commit_downloads {
+ my $sock = donkey_connect();
+ return unless $sock;
+ $sock->print("commit\n");
+ $sock->close();
+ until ($_ = $sock->getline()) {
+ #if (/commited/) {
+ return 1;
+ #} else {
+ # return 0;
+ #}
+ }
+}
+
+sub get_status_info {
+ my $result;
+ $result->{downloads} = get_downloads();
+ $result->{waiting} = get_results('/.*/')->{waiting};
+ my $upload = no_upload(0);
+ $result->{credit} = $upload->[1];
+ $result->{noupload} = $upload->[0];
+ return $result;
+}
+
+sub cmd_idonkey ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @arg = split(/ /, $args);
+ if (@arg == 0 || $arg[0] eq 'downloads') {
+ #list_downloads();
+ bg_do('downloads');
+ } elsif ($arg[0] eq 'help') {
+ show_help();
+ } elsif ($arg[0] =~ /pause|resume|cancel/ && defined $arg[1]) {
+ bg_do(join(' ', @arg));
+ } elsif ($arg[0] =~ /results/) {
+ bg_do(join(' ', @arg));
+ } elsif ($arg[0] eq 'search') {
+ shift @arg;
+ if (search_file(join(' ', @arg))) {
+ $seen = 0;
+ $nresults = 0;
+ print CLIENTCRAP "%R>>%n Query '".join(' ', @arg)."' sent to network...";
+ }
+ } elsif ($arg[0] eq 'get' && defined $arg[1]) {
+ shift @arg;
+ my $force = 0;
+ foreach my $id (@arg) {
+ if ($id eq 'force') {
+ $force = 1;
+ } elsif (get_file($id, $force)) {
+ print CLIENTCRAP "%R>>%n Download of file ".$id." started";
+ } else {
+ print CLIENTCRAP "%R>>%n Download of file ".$id." failed";
+ }
+ }
+ } elsif ($arg[0] eq 'dllink' && defined $arg[1]) {
+ shift @arg;
+ join(' ', @arg) =~ /(force )?(.*)/;
+ my $force = defined $1 ? 1 : 0;
+ if (download_link($2, $1)) {
+ print CLIENTCRAP "%R>>%n Download of ".$2." started";
+ } else {
+ print CLIENTCRAP "%R>>%n Download of ".$2." failed";
+ }
+ } elsif ($arg[0] eq 'commit') {
+ if (commit_downloads()) {
+ print CLIENTCRAP "%R>>%n Completed downloads saved";
+ } else {
+ print CLIENTCRAP "%R>>%n Saving completed downloads failed";
+ }
+ } elsif ($arg[0] eq 'launch') {
+ my $cmd = Irssi::settings_get_str('idonkey_mldonkey_cmd');
+ system($cmd);
+ print CLIENTCRAP "%R>>%n MLDonkey launched";
+ } elsif ($arg[0] eq 'quit') {
+ if ( quit_donkey() ) {
+ print CLIENTCRAP "%R>>%n MLDonkey killed";
+ } else {
+ print CLIENTCRAP "%R>>%n Unable to kill MLDonkey";
+ }
+ } elsif ($arg[0] eq 'servers') {
+ shift @arg;
+ if ( (not @arg) || ($arg[0] eq 'connected') ) {
+ bg_do('servers');
+ } elsif ($arg[0] eq 'disconnect') {
+ shift @arg;
+ connect_servers(\@arg, 1);
+ } elsif ($arg[0] eq 'connect') {
+ shift @arg;
+ connect_servers(\@arg, 0);
+ } elsif ($arg[0] eq 'all') {
+ bg_do('allservers');
+ }
+ } elsif ($arg[0] eq 'overnet') {
+ shift @arg;
+ if ( (not @arg) || ($arg[0] eq 'stats') ) {
+ bg_do('ovstats');
+ } elsif ($arg[0] eq 'nodes') {
+ bg_do('ovnodes');
+ }
+ } elsif ($arg[0] eq 'settings') {
+ shift @arg;
+ if ( (not @arg) ) {
+ # Do something
+ } elsif ($arg[0] eq 'show') {
+ shift @arg;
+ bg_do('settings '.join(' ',@arg));
+ } elsif ($arg[0] eq 'change') {
+ shift @arg;
+ return unless (defined $arg[0] && defined $arg[1]);
+ my $key = shift @arg;
+ my $val = join(' ', @arg);
+ bg_do('set '.$key.' '.$val)
+ }
+ } elsif ($arg[0] eq 'shares') {
+ shift @arg;
+ if ( (not @arg) ) {
+ ## list shares?
+ } elsif ($arg[0] eq 'reshare') {
+ bg_do('reshare');
+ } elsif ($arg[0] eq 'close') {
+ bg_do('close_fds');
+ }
+ } elsif ($arg[0] eq 'sharereactor') {
+ shift @arg;
+ if ( (not @arg) || $arg[0] eq 'latest') {
+ print CLIENTCRAP "%B>>%n Retrieving latest releases...";
+ bg_do('sr-latest');
+ } elsif ($arg[0] eq 'search') {
+ shift @arg;
+ bg_do('sr-search '.join(" ", @arg));
+ print CLIENTCRAP "%B>>%n Searching ShareReactor for '".join(" ", @arg)."'";
+ } elsif ($arg[0] eq 'download' && defined $arg[1]) {
+ shift @arg;
+ download_sr(join(" ", @arg));
+ }
+ } elsif ($arg[0] eq 'bittorrent') {
+ shift @arg;
+ if ($arg[0] eq 'search') {
+ shift @arg;
+ bg_do('bt-search '.join(" ", @arg));
+ print CLIENTCRAP "%B>>%n Searching BitTorrent for '".join(" ", @arg)."'";
+ }
+ } elsif ($arg[0] eq 'noupload') {
+ shift @arg;
+ if (@arg && $arg[0] =~ /-?\d+/) {
+ bg_do('noupload '.$arg[0]);
+ }
+ } elsif ($arg[0] eq 'client-stats') {
+ bg_do('client-stats');
+ } elsif ($arg[0] eq 'forget') {
+ bg_do('forget');
+ } elsif ($arg[0] eq 'fake' && defined $arg[1]) {
+ shift @arg;
+ foreach (@arg) {
+ next unless /\d+/;
+ bg_do('fake '.$_);
+ }
+ }
+}
+
+sub download_sr ($) {
+ my ($download) = @_;
+ if (defined $edlinks{$download}) {
+ foreach my $link (@{ $edlinks{$download} }) {
+ if (download_link($link,0)) {
+ print CLIENTCRAP "%R>>%n Download of ".$link." started";
+ } else {
+ print CLIENTCRAP "%R>>%n Download of ".$link." failed";
+ }
+ }
+ } else {
+ print CLIENTCRAP "%B>>%n Unknown release, try searching for it.";
+ }
+}
+
+
+sub shorten_filename ($$) {
+ my ($file, $length) = @_;
+ unless ($length == 0) {
+ my $post = 4;
+ my $pre = $length-5-$post;
+ $file =~ s/^(.{$pre}).*(.{$post})/$1\[\.\.\.\]$2/;
+ }
+ return $file;
+}
+
+sub filename_percent ($$) {
+ my ($name, $percent) = @_;
+ my $length = length($name);
+ my $done = $length * ($percent/100);
+ my $string = '%g%U'.substr($name, 0, $done).'%U%n%y'.substr($name, $done, $length).'%n';
+ return $string;
+}
+
+sub sb_idonkey ($$) {
+ my ($item, $get_size_only) = @_;
+ my $line;
+ $line .= $nresults."|" if ($seen != $nresults && defined $seen);
+ $line .= '%F'.$expected."%F|" if $expected > 0;
+ $line .= $noul."min|" if $noul > 0;
+ #my $length = Irssi::settings_get_int('idonkey_max_filename_length');
+ my $length = Irssi::settings_get_int('idonkey_statusbar_max_filename_length');
+ my $i = 0;
+ foreach (sort keys %downloads) {
+ $index = 0 if $index > (scalar keys %downloads)-1;
+ unless ($i == $index) {
+ $i++;
+ next;
+ }
+ unless (Irssi::settings_get_bool('idonkey_statusbar_show_paused')) {
+ if ($downloads{$_}{rate} eq 'Paused') {
+ $index++;
+ next;
+ }
+ }
+ my $filename = get_best_name($downloads{$_}{names});
+ my $file = shorten_filename($filename, $length);
+ $line .= filename_percent($file, $downloads{$_}{percent});
+ $line .= ' '.$downloads{$_}{percent}.'%% ';
+ unless ($downloads{$_}{rate} eq '-') {
+ $line .= $downloads{$_}{rate};
+ $line .= ' kb/s' if $downloads{$_}{rate} =~ /^[0-9.]+$/;
+ }
+ $line .= ' ';
+ $i++;
+ }
+ $line =~ s/ $//;
+ my $format = "{sb ".$line."}";
+ $item->{min_size} = $item->{max_size} = length($line);
+ $item->default_handler($get_size_only, $format, 0, 1);
+}
+
+sub call_for_status {
+ bg_do('status');
+}
+
+sub sig_complete_word ($$$$$) {
+ my ($list, $window, $word, $linestart, $want_space) = @_;
+ if ($linestart =~ /^.idonkey (pause|resume|cancel)/) {
+ foreach (sort {get_best_name($downloads{$a}{names}) cmp get_best_name($downloads{$b}{names})} keys %downloads) {
+ my $name = get_best_name($downloads{$_}{names});
+ if ( ($1 eq 'resume' && $downloads{$_}{rate} eq 'Paused') ||
+ ($1 eq 'pause' && not $downloads{$_}{rate} eq 'Paused') ||
+ ($1 eq 'cancel') ) {
+ push @$list, $name if $name =~ /^(\Q$word\E.*)?$/i;
+ }
+ }
+ Irssi::signal_stop();
+ } elsif ($linestart =~ /^.idonkey search/) {
+ my @opts = ('minsize', 'maxsize', 'media', 'Video', 'Audio', 'format', 'title', 'album', 'artist', 'field', 'not', 'and', 'or');
+ foreach (@opts) {
+ $_ = '-'.$_;
+ push @$list, $_ if /^(\Q$word\E.*)?$/i;
+ }
+ Irssi::signal_stop();
+ } elsif ($linestart =~ /^.idonkey sharereactor download/) {
+ foreach (sort keys %edlinks) {
+ push @$list, $_ if /^(\Q$word\E.*)?$/i;
+ }
+ Irssi::signal_stop();
+ } elsif ($linestart =~ /^.idonkey dllink/) {
+ foreach (sort keys %edlinks) {
+ foreach my $link (@{ $edlinks{$_} }) {
+ push @$list, $link if $link =~ /^(\Q$word\E.*)?$/i;
+ }
+ }
+ Irssi::signal_stop();
+ } elsif ($linestart =~ /^.idonkey results/) {
+ my @opts = ('net');
+ foreach (@opts) {
+ $_ = '-'.$_;
+ push @$list, $_ if /^(\Q$word\E.*)?$/i;
+ }
+ }
+}
+
+sub next_status {
+ $index++;
+ $index = 0 if $index > (scalar keys %downloads)-1;
+ Irssi::statusbar_items_redraw('idonkey');
+}
+
+sub install_timer {
+ return if defined $timer;
+ my $timeout = Irssi::settings_get_int('idonkey_statusbar_interval');
+ my $timeout2 = Irssi::settings_get_int('idonkey_update_interval');
+ return unless $timeout && $timeout2;
+ $timer = Irssi::timeout_add($timeout*1000, \&next_status, undef);
+ $timer2 = Irssi::timeout_add($timeout2*1000, \&call_for_status, undef);
+}
+
+sub uninstall_timer {
+ return unless defined $timer;
+ Irssi::timeout_remove($timer);
+ Irssi::timeout_remove($timer2);
+ $timer = undef;
+}
+
+Irssi::command_bind('idonkey', \&cmd_idonkey);
+foreach my $cmd ('downloads', 'pause', 'resume', 'results', 'search', 'get', 'get force', 'cancel', 'help', 'commit', 'dllink', 'dllink force', 'launch', 'quit', 'servers', 'servers disconnect', 'servers connected', 'servers all', 'servers connect', 'overnet', 'overnet stats', 'overnet nodes', 'settings', 'settings show', 'settings change', 'shares', 'shares reshare', 'shares close', 'sharereactor', 'sharereactor search', 'sharereactor download', 'sharereactor latest', 'noupload', 'client-stats', 'forget', 'fake', 'bittorrent', 'bittorrent search') {
+ Irssi::command_bind('idonkey '.$cmd => sub {
+ cmd_idonkey("$cmd ".$_[0], $_[1], $_[2]); });
+}
+Irssi::signal_add_first('complete word', \&sig_complete_word);
+
+Irssi::settings_add_str($IRSSI{name}, 'idonkey_password', '');
+Irssi::settings_add_str($IRSSI{name}, 'idonkey_host', 'localhost');
+Irssi::settings_add_int($IRSSI{name}, 'idonkey_port', 4000);
+Irssi::settings_add_int($IRSSI{name}, 'idonkey_max_filename_length', 65);
+# sources, filename, id, size
+Irssi::settings_add_str($IRSSI{name}, 'idonkey_sort_results_by', "id");
+Irssi::settings_add_bool($IRSSI{name}, 'idonkey_round_filesize', 1);
+
+
+Irssi::settings_add_bool($IRSSI{name}, 'idonkey_filter_nameless_results', 1);
+Irssi::settings_add_bool($IRSSI{name}, 'idonkey_filter_search_results', 0);
+Irssi::settings_add_bool($IRSSI{name}, 'idonkey_show_chunks', 1);
+
+Irssi::settings_add_str($IRSSI{name}, 'idonkey_mldonkey_cmd', 'screen mldonkey');
+Irssi::settings_add_int($IRSSI{name}, 'idonkey_statusbar_interval', 0);
+Irssi::settings_add_bool($IRSSI{name}, 'idonkey_statusbar_show_paused', 1);
+Irssi::settings_add_int($IRSSI{name}, 'idonkey_update_interval', 0);
+Irssi::settings_add_bool($IRSSI{name}, 'idonkey_update_results', 1);
+Irssi::settings_add_int($IRSSI{name}, 'idonkey_statusbar_max_filename_length', 25);
+
+Irssi::statusbar_item_register('idonkey', 0, "sb_idonkey");
+
+install_timer();
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded, /idonkey help';
diff --git a/scripts/ignore_log.pl b/scripts/ignore_log.pl
new file mode 100644
index 0000000..38c1ca1
--- /dev/null
+++ b/scripts/ignore_log.pl
@@ -0,0 +1,78 @@
+#!/usr/bin/perl
+
+# ignore_log.pl (ignore_log -- send [some] ignored events to log), Version 0.1
+# this script is dedicated to bormann@IRCNET.
+#
+# Copyleft (>) 2004 jsn <jason@nichego.net>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# The complete text of the GNU General Public License can be found
+# on the World Wide Web: <URL:http://www.gnu.org/licenses/gpl.html>
+
+use strict;
+use Irssi;
+
+use POSIX qw/strftime/ ;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.1";
+%IRSSI = (
+ authors => 'Dmitry "jsn" Kim',
+ contact => 'jason@nichego.net',
+ name => 'ignore_log',
+ description => 'script to log ignored messages',
+ license => 'GPL',
+ url => 'http://',
+ changed => '2004-09-10',
+ changes => 'initial version'
+);
+
+Irssi::print("*****\n* $IRSSI{name} $VERSION loaded.");
+Irssi::print("* use `/set ignore_log <filename>' to configure") ;
+Irssi::print("* use `/set ignore_log none' to disable ignore logging") ;
+
+sub handle_public {
+ my ($srv, $msg, $nick, $addr, $tgt) = @_;
+ return if lc(Irssi::settings_get_str("ignore_log")) eq "none" ;
+ write_log($nick, $msg, $tgt)
+ if $srv->ignore_check($nick, $addr, $tgt, $msg, MSGLEVEL_PUBLIC) ;
+}
+
+sub handle_private {
+ my ($srv, $msg, $nick, $addr) = @_;
+ return if lc(Irssi::settings_get_str("ignore_log")) eq "none" ;
+ write_log($nick, $msg)
+ if $srv->ignore_check($nick, $addr, "", $msg, MSGLEVEL_MSGS) ;
+}
+
+sub write_log {
+ my ($nick, $msg, $tgt) = @_ ;
+ $tgt ||= "->" ;
+ my ($lfile) = glob Irssi::settings_get_str("ignore_log");
+ if (open(LF, ">>", $lfile)) {
+ my $ts = strftime("%D %H:%M", localtime()) ;
+ print LF "[$ts] $tgt $nick $msg\n" ;
+ close LF ;
+ } else {
+ Irssi::active_win()->print("can't open file `$lfile': $!") ;
+ }
+}
+
+Irssi::settings_add_str("ignore_log", "ignore_log", "~/.irssi/ignore.log");
+
+Irssi::print("* logging ignored users to `" .
+ Irssi::settings_get_str("ignore_log") . "'") ;
+
+Irssi::signal_add_first("message public", "handle_public") ;
+Irssi::signal_add_first("message private", "handle_private") ;
+
diff --git a/scripts/ignoreoc.pl b/scripts/ignoreoc.pl
new file mode 100644
index 0000000..776b3d7
--- /dev/null
+++ b/scripts/ignoreoc.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/perl -w
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.6";
+%IRSSI = (
+ authors => "Erkki Seppälä",
+ contact => "flux\@inside.org",
+ name => "Ignore-OC",
+ description => "Ignore messages from people not on your channels." .
+ "Now people you msg are added to bypass-list.",
+ license => "Public Domain",
+ url => "http://www.inside.org/~flux/software/irssi/",
+ changed => "Mon Jun 16 08:10:45 EEST 2008"
+);
+
+my %bypass = ();
+
+my $ignoredMessages = 0;
+
+sub cmd_message_private {
+ my ($server, $message, $nick, $address) = @_;
+ my $channel;
+
+=cut
+ my ($addressNick) = $address =~ /^([^@]*)/;
+
+ if ($addressNick ne $server->{nick}) {
+ Irssi::print "Irssi bug? Received a message sent to $address";
+ return 1;
+ }
+=cut
+
+ if ($message =~ m/oc:/i ||
+ exists $bypass{$nick}) {
+ return 1;
+ }
+
+ foreach $channel ($server->channels()) {
+ foreach my $other ($channel->nicks()) {
+ if ($other->{nick} eq $nick) {
+ return 1;
+ }
+ }
+ }
+
+ ++$ignoredMessages;
+ $server->command("^NOTICE $nick You're not on any channel I'm on, thus, due to spambots, your message was ignored. Prefix your message with 'OC:' to bypass the ignore.");
+ Irssi::signal_stop();
+}
+
+sub cmd_message_own_private {
+ my ($server, $message, $nick, $address) = @_;
+ $bypass{$nick} = 1;
+}
+
+sub cmd_ignoreoc {
+ Irssi::print("You've ignored $ignoredMessages messages since startup.");
+}
+
+Irssi::signal_add_first("message private", "cmd_message_private");
+Irssi::signal_add("message own_private", "cmd_message_own_private");
+Irssi::command_bind("ignoreoc", "cmd_ignoreoc");
+
+Irssi::print "IgnoreOC version $VERSION by flux with patches from Exstatica. Try /ignoreoc"
diff --git a/scripts/il.pl b/scripts/il.pl
new file mode 100644
index 0000000..b7dd342
--- /dev/null
+++ b/scripts/il.pl
@@ -0,0 +1,133 @@
+#
+# for all who dont like perl:
+# inputlength = "{sb length: $@L}";
+#
+# with leading spaces: (3 spaces in example)
+# inputlength = "{sb $[-!3]@L}";
+#
+# with leading char "-"
+#
+# inputlength = "{sb $[-!3-]@L}";
+#
+# you cant use numbers here. if you want to use the numbers use the
+# perl script
+#
+#
+# thanks to: Wouter Coekaerts <wouter@coekaerts.be> aka coekie
+#
+# add one of these 2 lines to your config in statusbar items section
+#
+# the perl scripts reacts on every keypress and updates the counter.
+# if you dont need/want this the settings are maybe enough for you.
+# with the settings the item is update with a small delay.
+#
+
+use strict;
+use Irssi 20021105;
+use Irssi::TextUI;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '0.0.6';
+%IRSSI = (
+ authors => 'Marcus Rueckert',
+ contact => 'darix@irssi.org',
+ name => 'inputlength',
+ description => 'adds a statusbar item which show length of the inputline',
+ sbitems => 'inputlength',
+ license => 'BSD License or something more liberal',
+ url => 'http://www.irssi.de./',
+ changed => '2021-01-11'
+);
+
+my $help = << "END";
+%9Name%9
+ $IRSSI{name}
+%9Version%9
+ $VERSION
+%9Description%9
+ $IRSSI{description}
+
+ To activate the inputlength indicator do:
+ /STATUSBAR window add inputlength
+ Statusbar syntax was changed in Irssi 1.2.
+ /STATUSBAR ADDITEM inputlength window
+%9Settings%9
+ /set inputlength_width 0
+ /set inputlength_padding_char
+END
+
+sub beancounter {
+ my ( $sbItem, $get_size_only ) = @_;
+
+ my ( $width, $padChar, $padNum, $length );
+
+ #
+ # getting settings
+ #
+ $width = Irssi::settings_get_int ( 'inputlength_width' );
+ $padChar = Irssi::settings_get_str ( 'inputlength_padding_char' );
+
+ #
+ # only one char allowed
+ #
+ $padChar =~ s/^(.).*?$/$1/;
+
+ #
+ # do we have to deal wit numbers for padding?
+ #
+ if ( $padChar =~ m/\d/ ) {
+ $padNum = $padChar;
+ $padChar = '-';
+ };
+
+ #
+ # getting formatted lengh
+ #
+ $length = Irssi::parse_special ( "\$[-!$width$padChar]\@L" );
+
+ #
+ # did we have a number?
+ #
+ $length =~ s/$padChar/$padNum/g if ( $padNum ne '' );
+
+ $sbItem->default_handler ( $get_size_only, "{sb $length}", undef, 1 );
+}
+
+Irssi::statusbar_item_register ( 'inputlength', 0, 'beancounter' );
+#
+# ToDo:
+# - statusbar item register doesnt support function references.
+# so we have to stuck to the string and wait for cras.
+#
+
+Irssi::signal_add_last 'gui key pressed' => sub {
+ Irssi::statusbar_items_redraw ( 'inputlength' );
+};
+
+Irssi::settings_add_int ( 'inputlength', 'inputlength_width', 0 );
+#
+# setting:
+#
+# 0 means it resizes automatically
+# greater means it has at least a size of n chars.
+# it will grow if the space is to space is too small
+#
+
+Irssi::settings_add_str ( 'inputlength', 'inputlength_padding_char', " " );
+#
+# char to pad with
+#
+# you can use any char you like here. :) even numbers should work
+#
+
+sub cmd_help {
+ my ($args, $server, $witem)=@_;
+ $args=~ s/\s+//g;
+ if ($IRSSI{name} eq $args) {
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop();
+ }
+}
+
+Irssi::command_bind('help', \&cmd_help);
+Irssi::command_bind($IRSSI{name}, sub { cmd_help($IRSSI{name}); } );
diff --git a/scripts/imdb.pl b/scripts/imdb.pl
new file mode 100644
index 0000000..601b480
--- /dev/null
+++ b/scripts/imdb.pl
@@ -0,0 +1,115 @@
+use strict;
+use Irssi;
+use LWP::UserAgent;
+use HTML::Entities;
+use vars qw($VERSION %IRSSI $cache);
+
+$VERSION = '1.05';
+%IRSSI = (
+ authors => 'Eric Jansen',
+ contact => 'chaos@sorcery.net',
+ name => 'imdb',
+ description => 'Automatically lookup IMDB-numbers in nicknames',
+ license => 'GPL',
+ modules => 'LWP::UserAgent HTML::Entities',
+ url => 'http://xyrion.org/irssi/',
+ changed => '2022-12-09',
+ selfcheckcmd=> 'imdb check',
+);
+
+my $ua = new LWP::UserAgent;
+$ua->agent("Irssi/imdb/$VERSION");
+
+# Set the timeout to five second, so it won't freeze the client too long on laggy connections
+$ua->timeout(5);
+
+my $last_result;
+
+sub event_nickchange {
+
+ my ($channel, $nick, $old_nick) = @_;
+
+ # Lookup any 7-digit number in someone elses nick
+ if($nick->{'nick'} ne $channel->{'ownnick'}->{'nick'} && $nick->{'nick'} =~ /\D(\d{7})(?:\D|$)/) {
+
+ my $id = $1;
+
+ # See if we know the title already
+ if(defined $cache->{$id}) {
+
+ # Print it
+ $channel->printformat(MSGLEVEL_CRAP, 'imdb_lookup', $old_nick, $cache->{$id}->{'title'}, $cache->{$id}->{'year'});
+ }
+
+ # Otherwise, contact IMDB
+ else {
+
+ # Fetch the movie detail page
+ my $req = new HTTP::Request(GET => "http://www.imdb.com/title/tt$id/");
+ my $res = $ua->request($req);
+
+ # Get the title and year from the fetched page
+ if($res->is_success
+ && $res->content =~ /<title>(.+?) \((.+)\).*<\/title>/i) {
+
+ # https://www.imdb.com/title/tt1234567/
+ # <title>&quot;So You Think You Can Dance&quot; The Top 14 Perform (TV Episode 2008) - IMDb</title>
+ # https://www.imdb.com/title/tt0234567/
+ # <title>The Ranchman's Nerve (1911) - IMDb</title>
+
+ my ($title, $year) = ($1, $2);
+
+ # Decode special characters in the title
+ $title= decode_entities($title);
+ $last_result= { title=> $title, year=> $year };
+
+ # Print it
+ if ($channel->{type} eq "CHANNEL" ) {
+ $channel->printformat(MSGLEVEL_CRAP, 'imdb_lookup', $old_nick, $title, $year);
+ } else {
+ Irssi::printformat(MSGLEVEL_CRAP, 'imdb_lookup', $old_nick, $title, $year);
+ }
+
+ # And cache it
+ $cache->{$id} = {
+ 'title' => $title,
+ 'year' => $year
+ };
+ }
+ }
+ }
+}
+
+# /imdb
+sub cmd {
+ my ($args, $server, $witem)=@_;
+ if ($args =~ m/check/) {
+ my $s='ok';
+ $last_result= {};
+ $witem->{'ownnick'}->{'nick'}="sepp";
+ my $nick={ nick=>"susi_1234567" };
+ event_nickchange( $witem, $nick , "imdb");
+ unless ( $last_result->{title} =~ m/You Can Dance/ ) {
+ $s="Error: title ($last_result->{title})";
+ }
+ unless ($last_result->{year} =~ m/2008/ ) {
+ $s="Error: year ($last_result->{year})";
+ }
+ Irssi::print("imdb: self check: $s");
+ my $schs = exists $Irssi::Script::{'selfcheckhelperscript::'};
+ Irssi::command("selfcheckhelperscript $s") if ( $schs );
+ } elsif ( $args =~ m/\d{7}/ ) {
+ $args =~ s/\s//g;
+ $witem->{'ownnick'}->{'nick'}="sepp";
+ my $nick={ nick=>"susi_$args" };
+ event_nickchange( $witem, $nick , "imdb");
+ }
+}
+
+Irssi::theme_register([
+ 'imdb_lookup', '{nick $0} is watching {hilight $1} ($2)'
+]);
+Irssi::signal_add('nicklist changed', 'event_nickchange');
+Irssi::command_bind($IRSSI{name},\&cmd);
+
+# vim:set ts=8 sw=4:
diff --git a/scripts/intercept.pl b/scripts/intercept.pl
new file mode 100644
index 0000000..4fef6f6
--- /dev/null
+++ b/scripts/intercept.pl
@@ -0,0 +1,217 @@
+# Some elements borrowed from ideas developed by shabble@freenode(https://github.com/shabble/irssi-docs/wiki )
+#
+# You can change what intercept.pl considers a linestart by setting
+# /set intercept_linestart to a regular expression that fits your needs.
+# For most, a simple whitespace or . pattern will stop most accidental
+# inputs.
+#
+# You can also tell which patterns should be ignored, for example
+# /set intercept_exceptions s/\w+/[\w\s\d]+/ wouldn't consider
+# s/word a mistyped command if it is followed by a slash, string of
+# valid characters and a final slash.
+# You can enter several patterns separated by a space.
+
+use strict;
+use warnings;
+use Data::Dumper;
+use Carp qw( croak );
+use Irssi;
+use Data::Munge 'list2re';
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.3";
+%IRSSI = (
+ authors => "Jari Matilainen",
+ contact => 'vague!#irssi@libera.chat on irc',
+ name => "intercept",
+ description => "Intercept misprinted commands and offer to remove the first character before sending it on",
+ license => "Public Domain",
+ url => "https://irssi.org",
+ changed => "04 Mar 16:00:00 CET 2022",
+ );
+
+my $active = 0;
+my $permit_pending = 0;
+my $pending_input = {};
+my $verbose = 0;
+my $isword = 0;
+my $cmdregexp = list2re map {$_->{cmd}} Irssi::commands();
+
+sub script_is_loaded {
+ return exists($Irssi::Script::{$_[0] . '::'});
+}
+
+if (script_is_loaded('uberprompt')) {
+ app_init();
+}
+else {
+ print "This script requires 'uberprompt.pl' in order to work. "
+ . "Attempting to load it now...";
+
+ Irssi::signal_add('script error', 'load_uberprompt_failed');
+ Irssi::command("script load uberprompt.pl");
+
+ unless(script_is_loaded('uberprompt')) {
+ load_uberprompt_failed("File does not exist");
+ }
+ app_init();
+}
+
+sub load_uberprompt_failed {
+ Irssi::signal_remove('script error', 'load_uberprompt_failed');
+
+ print "Script could not be loaded. Script cannot continue. "
+ . "Check you have uberprompt.pl installed in your scripts directory and "
+ . "try again. Otherwise, it can be fetched from: ";
+ print "https://github.com/shabble/irssi-scripts/raw/master/"
+ . "prompt_info/uberprompt.pl";
+
+ croak "Script Load Failed: " . join(" ", @_);
+}
+
+sub sig_send_text {
+ my ($data, $server, $witem) = @_;
+
+ if($permit_pending == 1) {
+ $pending_input = {};
+ $permit_pending = 0;
+ Irssi::signal_continue(@_);
+ }
+ elsif($permit_pending == 2) {
+ my $regexp = Irssi::settings_get_str('intercept_linestart');
+ $pending_input = {};
+ $permit_pending = 0;
+ Irssi::signal_stop();
+ $data =~ s/^$regexp//;
+
+ if(ref $witem && $witem->{type} eq 'CHANNEL') {
+ $witem->command($data);
+ }
+ else {
+ $server->command($data);
+ }
+ }
+ elsif($permit_pending == 3) {
+ $pending_input = {};
+ $permit_pending = 0;
+ $isword = 0;
+ Irssi::signal_stop();
+
+ if(ref $witem && $witem->{type} eq 'CHANNEL') {
+ $witem->command($data);
+ }
+ else {
+ $server->command($data);
+ }
+ }
+ else {
+ (my $cmdchars = Irssi::settings_get_str('cmdchars')) =~ s/(.)(.)/$1|$2/;
+ my @exceptions = split / /, Irssi::settings_get_str('intercept_exceptions');
+
+ foreach(@exceptions) {
+ return if($data =~ m{$_}i);
+ }
+
+ my ($first) = split ' ', $data;
+
+ my $regexp = Irssi::settings_get_str('intercept_linestart');
+ $regexp =~ s/(^[\^])|([\$]$)//g;
+ if($data =~ /^($regexp)($cmdchars)/i) {
+ my $text = "You have " . ($1 eq ' '?'a space':$1) . " infront of your cmdchar '$2', is this what you wanted? [y/F/c]";
+ $pending_input = {
+ text => $data,
+ server => $server,
+ win_item => $witem,
+ };
+
+ Irssi::signal_stop();
+ require_confirmation($text);
+ }
+ elsif($data =~ /^\s*($cmdregexp)\b/i) {
+ my $text = "The first word, '$1', looks like a command, is this what you wanted? [y/F/c]";
+ $isword = 1;
+ $pending_input = {
+ text => $data,
+ server => $server,
+ win_item => $witem,
+ };
+
+ Irssi::signal_stop();
+ require_confirmation($text);
+ }
+ }
+}
+
+sub sig_gui_keypress {
+ my ($key) = @_;
+
+ return if not $active;
+
+ my $char = chr($key);
+
+ # we support f, F, enter for Fix.
+ if($char =~ m/^f?$/i) {
+ $permit_pending = 2 + $isword;
+ Irssi::signal_stop();
+ Irssi::signal_emit('send text',
+ $pending_input->{text},
+ $pending_input->{server},
+ $pending_input->{win_item});
+ $active = 0;
+ set_prompt('');
+ }
+ elsif($char =~ m/^y$/i) {
+ # y or Y for send as is
+ $permit_pending = 1;
+ Irssi::signal_stop();
+ Irssi::signal_emit('send text',
+ $pending_input->{text},
+ $pending_input->{server},
+ $pending_input->{win_item});
+ $active = 0;
+ set_prompt('');
+ }
+ elsif ($char =~ m/^c$/i or $key == 3 or $key == 7) {
+ # we support c, C, Ctrl-C, and Ctrl-G for don't send
+ Irssi::signal_stop();
+ set_prompt('');
+ $permit_pending = 0;
+ $active = 0;
+ $pending_input = {};
+ }
+ else {
+ Irssi::signal_stop();
+ return;
+ }
+}
+
+sub app_init {
+ Irssi::signal_add_first("send text" => \&sig_send_text);
+ Irssi::signal_add_first('gui key pressed' => \&sig_gui_keypress);
+ Irssi::signal_add("commandlist new" =>
+ sub {
+ $cmdregexp = list2re map {$_->{cmd}} Irssi::commands();
+ });
+ Irssi::settings_add_str('Intercept', 'intercept_exceptions', 's/\w+/[\w\s\d]+/');
+ Irssi::settings_add_str('Intercept', 'intercept_linestart', '\s');
+}
+
+sub require_confirmation {
+ $active = 1;
+ set_prompt(shift);
+}
+
+sub set_prompt {
+ my ($msg) = @_;
+ $msg = ': ' . $msg if length $msg;
+ Irssi::signal_emit('change prompt', $msg, 'UP_INNER');
+}
+
+sub _debug {
+ return unless $verbose;
+
+ my ($msg, @params) = @_;
+ my $str = sprintf($msg, @params);
+ print $str;
+}
diff --git a/scripts/invitejoin.pl b/scripts/invitejoin.pl
new file mode 100644
index 0000000..d3b5871
--- /dev/null
+++ b/scripts/invitejoin.pl
@@ -0,0 +1,298 @@
+#!/usr/bin/perl -w
+
+## Bugreports and Licence disclaimer.
+#
+# For bugreports and other improvements contact Geert Hauwaerts <geert@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+##
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '0.02';
+
+%IRSSI = (
+ authors => 'Geert Hauwaerts',
+ contact => 'geert@irssi.org',
+ name => 'invitejoin.pl',
+ description => 'This script will join a channel if somebody invites you to it.',
+ license => 'Public Domain',
+ url => 'https://github.com/irssi/scripts.irssi.org/blob/master/scripts/invitejoin.pl',
+ changed => 'Di 17. Jan 19:32:45 CET 2017',
+);
+
+my $help = <<EOF;
+
+/SET invitejoin 0|1
+/TOGGLE invitejoin
+ Description: If this setting is turned on, you will join the channel
+ when invited to.
+
+Default is to follow every invite, you can specify a list of allowed nicks.
+
+/INVITEJOIN [addnick <ircnet> <nick>]
+ [delnick <ircnet> <nick>]
+ [listnick]
+ [help]
+
+addnick: Add a new nickname on the given net as allowed autoinvite source.
+delnick: Delete a nickname from the allowed list.
+listnick: Display the contents of the allowed nickname list.
+help: Display this useful little helptext.
+
+Examples: (all on one line)
+/INVITEJOIN addnick Freenode ChanServ
+
+Note: This script doesn't allow wildcards
+EOF
+
+my @allowed_nicks = ();
+my $allowed_nicks_file = "invitejoin.nicks";
+
+my $irssidir = Irssi::get_irssi_dir();
+
+Irssi::theme_register([
+ 'invitejoin_usage', '%R>>%n %_Invitejoin:%_ Insufficient parameters: Use "%_/INVITEJOIN help%_" for further instructions.',
+ 'invitejoin_help', '$0',
+ 'invitejoin_loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.',
+ 'invitejoin_invited', '%R>>%n %_Invitejoin:%_ Joined $1 (Invited by $0).',
+ 'invitejoin_usage_add_nick', '%R>>%n %_Invitejoin:%_ Insufficient parameters: Usage "%_/INVITEJOIN addnick ircnet ChanServ%_".',
+ 'invitejoin_no_net', '%R>>%n %_Invitejoin:%_ Unknown Irssi ircnet %_$0%_.',
+ 'saved_nick', '%R>>%n %_Invitejoin:%_ Added allowed nick "%_$1%_" on %_$0%_.',
+ 'nick_already_present', '%R>>%n %_Invitejoin:%_ Nick already present.',
+ 'invitejoin_delusage', '%R>>%n %_Invitejoin:%_ Insufficient parameters: Usage "%_/INVITEJOIN delnick ircnet nick%_".',
+ 'invitejoin_delled', '%R>>%n %_Invitejoin:%_ Deleted %_$1%_ on %_$0%_ from allowed list.',
+ 'invitejoin_nfound', '%R>>%n %_Invitejoin:%_ The nick %_$1%_ on %_$0%_ could not be found.',
+ 'allowed_nicks_info', '%_Ircnet Nick%_',
+ 'allowed_nicks_empty', '%R>>%n %_Invitejoin:%_ Your allowed nick list is empty. All invites will be followed.',
+ 'allowed_nicks_print', '$[18]0 $1',
+ 'invite_denied', '%R>>%n %_Invitejoin:%_ Invite from nick %_$1%_ on %_$0%_ to %_$2%_ not followed because it is not in the allowed list.',
+]);
+
+sub load_allowed_nicks {
+ my ($file) = @_;
+
+ @allowed_nicks = load_file($file, sub {
+ my $new_allowed = new_allowed_nick(@_);
+
+ return undef if ($new_allowed->{net} eq '' || $new_allowed->{nick} eq '');
+ return $new_allowed;
+ });
+}
+
+sub save_allowed_nicks {
+ my ($file) = @_;
+ save_file($file, \@allowed_nicks, \&allowed_nick_to_list);
+}
+
+sub allowed_nick_to_list {
+ my $allowed_nick = shift;
+
+ return (
+ $allowed_nick->{net},
+ $allowed_nick->{nick}
+ );
+}
+
+sub new_allowed_nick {
+ return {
+ net => shift,
+ nick => shift
+ };
+}
+
+# file: filename to be read
+# parse_line_fn: receives array of entries of a single line as input, should
+# return parsed data object or undef in the data is incomplete
+# returns: parsed data array
+sub load_file {
+ my ($file, $parse_line_fn) = @_;
+ my @parsed_data = ();
+
+ if (-e $file) {
+ open(my $fh, "<", $file);
+ local $/ = "\n";
+
+ while (<$fh>) {
+ chomp;
+ my $data = $parse_line_fn->(split("\t"));
+ push(@parsed_data, $data) if $data;
+ }
+
+ close($fh);
+ }
+
+ return @parsed_data;
+}
+
+# file: filename to be written, is created accessable only by the user
+# data_ref: array ref of data entries
+# serialize_fn: receives a data reference and should return an array or tuples
+# for that data that will be serialized into one line
+sub save_file {
+ my ($file, $data_ref, $serialize_fn) = @_;
+
+ create_private_file($file) unless -e $file;
+
+ open(my $fh, ">", $file) or die "Can't create $file. Reason: $!";
+
+ for my $data (@$data_ref) {
+ print($fh join("\t", $serialize_fn->($data)), "\n");
+ }
+
+ close($fh);
+}
+
+sub create_private_file {
+ my ($file) = @_;
+ my $umask = umask 0077; # save old umask
+ open(my $fh, ">", $file) or die "Can't create $file. Reason: $!";
+ close($fh);
+ umask $umask;
+}
+
+sub add_allowed_nick {
+ my ($network, $nick) = split(" ", $_[0], 2);
+ my ($correct_net);
+
+ if ($network eq '' || $nick eq '') {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'invitejoin_usage_add_nick');
+ return;
+ }
+
+ if ($network) {
+ my ($ircnet) = Irssi::chatnet_find($network);
+ if (!$ircnet) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'invitejoin_no_net', $network);
+ return;
+ } else {
+ $correct_net = 1;
+ }
+ }
+
+ if ($correct_net && $nick) {
+ if (is_nick_in_list($network, $nick)) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nick_already_present');
+ return;
+ }
+
+ push(@allowed_nicks, new_allowed_nick($network, $nick));
+ save_allowed_nicks("$irssidir/$allowed_nicks_file");
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'saved_nick', $network, $nick);
+ }
+}
+
+sub del_allowed_nick {
+ my ($ircnet, $nick) = split(" ", $_[0], 2);
+
+ if ($ircnet eq '' || $nick eq '') {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'invitejoin_delusage');
+ return;
+ }
+
+ my $size_before = scalar(@allowed_nicks);
+ @allowed_nicks = grep { ! ($_->{net} eq $ircnet && $_->{nick} eq $nick) } @allowed_nicks;
+ my $size_after = scalar(@allowed_nicks);
+
+ if ($size_after != $size_before) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'invitejoin_delled', $ircnet, $nick);
+ save_allowed_nicks("$irssidir/$allowed_nicks_file");
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'invitejoin_nfound', $ircnet, $nick);
+ }
+
+ if ($size_after == 0) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'allowed_nicks_empty');
+ }
+}
+
+sub list_allowed_nicks {
+ if (@allowed_nicks == 0) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'allowed_nicks_empty');
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'allowed_nicks_info');
+
+ for my $allowed (@allowed_nicks) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'allowed_nicks_print', $allowed->{net}, $allowed->{nick});
+ }
+ }
+}
+
+sub invitejoin_runsub {
+ my ($data, $server, $item) = @_;
+ $data =~ s/\s+$//g;
+
+ if ($data) {
+ Irssi::command_runsub('invitejoin', $data, $server, $item);
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'invitejoin_usage');
+ }
+}
+
+sub is_nick_in_list {
+ my ($net, $nick) = @_;
+
+ return (grep {
+ $_->{net} eq $net &&
+ $_->{nick} eq $nick
+ } @allowed_nicks) > 0;
+}
+
+sub is_allowed_nick {
+ my ($net, $nick) = @_;
+
+ # If no allowed nicks are specified (initial configuration) accept
+ # all invite requests.
+ # # (This mimics previous behavior of this script
+ # before there was an allowed list)
+ return 1 if @allowed_nicks == 0;
+
+ return is_nick_in_list($net, $nick);
+}
+
+sub invitejoin {
+ my ($server, $channel, $nick, $address) = @_;
+ my $invitejoin = Irssi::settings_get_bool('invitejoin');
+
+ if ($invitejoin) {
+ if (is_allowed_nick($server->{tag}, $nick)) {
+ $server->command("join $channel");
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'invitejoin_invited', $nick, $channel);
+ Irssi::signal_stop();
+ }
+ else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'invite_denied', $server->{tag}, $nick, $channel);
+ }
+ }
+}
+
+Irssi::signal_add('message invite', 'invitejoin');
+
+Irssi::settings_add_bool('invitejoin', 'invitejoin' => 1);
+
+load_allowed_nicks("$irssidir/$allowed_nicks_file");
+
+Irssi::command_bind('invitejoin', 'invitejoin_runsub');
+Irssi::command_bind('invitejoin addnick', 'add_allowed_nick');
+Irssi::command_bind('invitejoin delnick', 'del_allowed_nick');
+Irssi::command_bind('invitejoin listnick', 'list_allowed_nicks');
+Irssi::command_bind('invitejoin help' => sub { Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'invitejoin_help', $help) });
+
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'invitejoin_loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
diff --git a/scripts/ipupdate.pl b/scripts/ipupdate.pl
new file mode 100644
index 0000000..dc99c45
--- /dev/null
+++ b/scripts/ipupdate.pl
@@ -0,0 +1,39 @@
+# IPupdate 1.2
+#
+# automatically update your IP on server connections
+#
+# original create by legion (a.lepore@email.it)
+#
+# thanks xergio for IP show php script :>
+#
+# Fixed by Axel Gembe <derago@gmail.com> to use ifconfig.co/ip
+# because the original server did not work anymore.
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+require LWP::UserAgent;
+use HTTP::Request::Common;
+
+$VERSION = '1.3';
+%IRSSI = (
+ authors => 'xlony, Axel Gembe',
+ contact => 'anderfdez@yahoo.es',
+ name => 'IPupdate',
+ description => 'Auto "/set dcc_own_ip IP" on connect.',
+ license => 'GPL',
+ changed => '2017-11-08',
+);
+
+sub ipset {
+ my $user = LWP::UserAgent->new(timeout => 30);
+ my $get = GET "http://ifconfig.co/ip";
+ my $req = $user->request($get);
+ my $out = $req->content();
+
+ Irssi::print("%9IP update%_:", MSGLEVEL_CRAP);
+ Irssi::command("set dcc_own_ip $out");
+}
+
+Irssi::signal_add('server connected', 'ipset');
+Irssi::command_bind('ipupdate', 'ipset');
diff --git a/scripts/irccomplete.pl b/scripts/irccomplete.pl
new file mode 100644
index 0000000..d2ac527
--- /dev/null
+++ b/scripts/irccomplete.pl
@@ -0,0 +1,213 @@
+# TAB complete words from dictionary
+# for irssi 0.7.99 by Timo Sirainen
+# Greatly modified by Erkki Seppälä to build dictionary of said words
+
+use strict;
+use Irssi;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.1";
+%IRSSI = (
+ authors => "Erkki Seppälä",
+ contact => "flux\@inside.org",
+ name => "IRC Completion",
+ description => "Adds words from IRC to your tab-completion list, plus fixes typos",
+ license => "Public Domain",
+ url => "http://xulfad.inside.org/~flux/software/irssi/",
+ changed => "Thu Feb 7 22:45:55 EET 2002"
+);
+
+
+my @wordHistory;
+my %words;
+my %permanent;
+
+my $wordChars = join("", ('a'..'z', '0'..'9', 'öä'));
+my $maxWords = 5000;
+my $minWordLength = 4;
+my $maxWordLength = 80;
+my $maxTypoLength = 10;
+my $permanentThreshold = 1;
+
+my %typoWords;
+my $correctWordCounter = 1;
+my %correctWordsByIndex;
+my %correctWordsByWord;
+
+# by word
+sub addCorrectWord {
+ my $index = $correctWordsByWord{$_[0]} or 0;
+ if ($index > 0) {
+ ++$correctWordsByIndex{$index}->[1];
+ return $index;
+ } else {
+ $correctWordsByIndex{$correctWordCounter} = [$_[0], 1];
+ $correctWordsByWord{$_[0]} = $correctWordCounter;
+ ++$correctWordCounter;
+ return $correctWordCounter - 1;
+ }
+};
+
+# by word
+sub delCorrectWord {
+ my ($word) = @_;
+ my $index = $correctWordsByWord{$word};
+ if (--$correctWordsByIndex{$index}->[1] == 0) {
+ delete $correctWordsByWord{$correctWordsByIndex{$index}->[0]};
+ delete $correctWordsByIndex{$index};
+ }
+}
+
+sub sig_complete {
+ my ($complist, $window, $word, $linestart, $want_space) = @_;
+
+ $word =~ s/([^a-zA-Z0-9])/\\\1/g;
+
+ @$complist = reverse (@$complist, grep(/^$word/, (keys %permanent, keys %words)));
+
+ if (exists $typoWords{$word}) {
+ my $correctWord = $correctWordsByIndex{$typoWords{$word}->[0]}->[0];
+ @$complist = (@$complist, $correctWord);
+ }
+
+ my $n;
+ my %m = map { ($_ => $n++); } @$complist;
+ @$complist = ();
+ my %m2;
+ foreach my $key (sort keys %m) {
+ $m2{$m{$key}}=$key;
+ }
+ foreach my $key (reverse sort keys %m2) {
+ push @$complist, $m2{$key};
+ }
+}
+
+# $word, $removes
+sub generate_drops {
+ my ($word, $changes) = @_;
+ my @list;
+ for (my $c = 0; $c < length($word) - 1; ++$c) {
+ my $misWord = substr($word, 0, $c) . substr($word, $c + 1);
+ if ($changes > 1) {
+ push @list, generate_drops($misWord, $changes - 1);
+ } else {
+ push @list, $misWord;
+ }
+ }
+ return @list;
+}
+
+sub generate_translations {
+ my ($word, $changes) = @_;
+ my @list;
+ for (my $c = 1; $c < length($word); ++$c) {
+ my $misWord = substr($word, 0, $c - 1) . substr($word, $c, 1) . substr($word, $c - 1, 1) . substr($word, $c + 1);
+ if ($changes > 1) {
+ push @list, generate_drops($misWord, $changes - 1);
+ } else {
+ push @list, $misWord;
+ }
+ }
+ return @list;
+}
+
+# $word
+sub generate_typos {
+ my $maxTypoLength = Irssi::settings_get_int('irccomplete_maximum_typo_length');
+ my ($word) = @_;
+
+ if (length($word) > $maxTypoLength) {
+ return ();
+ } else {
+ return (generate_drops($word, 1), generate_translations($word));
+ }
+}
+
+sub sig_message {
+ my ($server, $message) = @_;
+ my $maxWords = Irssi::settings_get_int('irccomplete_words');
+ my $minWordLength = Irssi::settings_get_int('irccomplete_minimum_length');
+ my $maxWordLength = Irssi::settings_get_int('irccomplete_maximum_length');
+ my $wordChars = Irssi::settings_get_str("irccomplete_word_characters");
+ my $permanentThreshold = Irssi::settings_get_int('irccomplete_permanent_percent');
+ foreach my $word (split(/[^$wordChars]/, $message)) {
+ if (length($word) >= $minWordLength && length($word) <= $maxWordLength) {
+ if (++$words{$word} > $permanentThreshold / 100.0 * $maxWords) {
+ if (++$permanent{$word} == 1) {
+ #Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'irccomplete_permanent', $word);
+ Irssi::print "Added $word to the list of permanent words";
+ }
+ }
+ push @wordHistory, $word;
+ my $wordIndex = addCorrectWord($word);
+ foreach my $misword (generate_typos($word, 1)) {
+ if (!exists $typoWords{$misword}) {
+ $typoWords{$misword} = [$wordIndex, 1];
+ } else {
+ ++$typoWords{$misword}->[1];
+ }
+ }
+ while (@wordHistory > $maxWords) {
+ my $word = shift @wordHistory;
+ if (--$words{$word} == 0) {
+ delete $words{$word};
+ }
+ foreach my $misword (generate_typos($word, 1)) {
+ if (--$typoWords{$misword}->[1] == 0) {
+ delete $typoWords{$misword};
+ }
+ }
+ delCorrectWord($word);
+ }
+ }
+ }
+
+
+ return 1;
+}
+
+sub cmd_typowords {
+ Irssi::print (scalar(@wordHistory) . " words, " .
+ scalar(keys %typoWords) . " typowords, " .
+ scalar(keys %correctWordsByWord) . "x" . scalar(keys %correctWordsByIndex) . " correct words");
+ my $line = "";
+
+ foreach my $word (keys %typoWords) {
+ $line .= $word . "|" . $typoWords{$word}->[0] . " ";
+ }
+ Irssi::print "$line";
+ $line = "";
+
+ foreach my $index (keys %correctWordsByIndex) {
+ $line .= $index . ":[" . join("|", @{$correctWordsByIndex{$index}}) . "] ";
+ }
+ Irssi::print "$line";
+ $line = "";
+
+ foreach my $word (keys %correctWordsByWord) {
+ $line .= $word . ":" . $correctWordsByWord{$word} . " ";
+ }
+ Irssi::print "$line";
+ $line = "";
+
+ return 1;
+};
+
+Irssi::theme_register(['irccomplete_permanent', 'Added $1 to the list of permanent words']);
+
+Irssi::settings_add_str("misc", "irccomplete_word_characters", $wordChars);
+Irssi::settings_add_int("misc", "irccomplete_words", $maxWords);
+Irssi::settings_add_int("misc", "irccomplete_minimum_length", $minWordLength);
+Irssi::settings_add_int("misc", "irccomplete_maximum_length", $maxWordLength);
+Irssi::settings_add_int("misc", "irccomplete_maximum_typo_length", $maxTypoLength);
+Irssi::settings_add_int("misc", "irccomplete_permanent_percent", $permanentThreshold);
+
+foreach my $sig ("message public", "message private",
+ "message own_public", "message own_private",
+ "message topic") {
+#foreach my $sig ("message own_public", "message own_private") {
+ Irssi::signal_add($sig, "sig_message");
+}
+Irssi::signal_add_last('complete word', 'sig_complete');
+
+Irssi::command_bind("irccomplete_typowords", "cmd_typowords");
diff --git a/scripts/ircgallery.pl b/scripts/ircgallery.pl
new file mode 100644
index 0000000..d700210
--- /dev/null
+++ b/scripts/ircgallery.pl
@@ -0,0 +1,257 @@
+# Show IRC gallery (http://irc-galleria.net, finnish only) information
+# on /WHOIS or /GALLERY
+
+# version 1.13
+# for irssi 0.8.0 by Timo Sirainen
+use strict;
+use Symbol;
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.13";
+%IRSSI = (
+ authors => "Timo \'cras\' Sirainen",
+ contact => "tss\@iki.fi",
+ name => "ircgallery",
+ description => "Show IRC gallery (http://irc-galleria.net, finnish only) information on /WHOIS or /GALLERY",
+ license => "Public Domain",
+ url => "http://irssi.org/",
+ changed => "2002-03-04T22:47+0100"
+);
+
+
+Irssi::theme_register([
+ 'whois_gallery', '{whois gallery $1}',
+ 'gallery_header', '{hilight $0} - IRC gallery information',
+ 'gallery_line', ' $[8]0 : $1',
+ 'gallery_footer', 'End of info',
+ 'gallery_notfound', '$0 is not in IRC gallery',
+ 'gallery_nolist', 'Nick list of IRC gallery not downloaded yet - please wait'
+]);
+
+
+my $cache_path = glob "~/.irssi/ircgallery";
+my @print_queue;
+
+my $nicklist_path = "$cache_path/nicks.list";
+my $gallery_nicks_time = 0;
+my %gallery_nicks = {};
+
+my $last_whois_nick;
+
+sub get_view_url {
+ return 'http://irc-galleria.net/view.php?nick='.$_[0];
+}
+
+# print the gallery information - assumes the file is in cache directory
+sub print_gallery {
+ my %print_notfound;
+ my $nick = shift;
+
+ my $found = 0;
+ my $next_channels = 0;
+ my $channels;
+
+ local $/ = "\n";
+ my $f = gensym;
+ if (!open($f, "<", "$cache_path/$nick")) {
+ Irssi::print("Couldn't open file $cache_path/$nick: $!", MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ while (<$f>) {
+ last if (/\<title\>.*Etsi nick/); # unknown nick
+
+ if ($next_channels) {
+ if (m,\<a .*\>(#.*)\</a>,) {
+ $channels .= "$1 ";
+ next;
+ } else {
+ $next_channels = 0;
+ if ($channels) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'gallery_line',
+ "channels", $channels);
+ $channels = "";
+ }
+ }
+ }
+
+ if (/\<h1\>[^\(]*\(([^\)]*)/) {
+ my $realname = $1;
+ Irssi::printformat(MSGLEVEL_CRAP, 'gallery_header', $nick);
+ Irssi::printformat(MSGLEVEL_CRAP, 'gallery_line',
+ "ircname", $realname);
+ Irssi::printformat(MSGLEVEL_CRAP, 'gallery_line',
+ "url", get_view_url($nick));
+ $found = 1;
+ next;
+ }
+
+ if (/\<img.*src="([^"]*)".*alt="$nick"/) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'gallery_line',
+ "image", "http://irc-galleria.net/$1");
+ next;
+ }
+
+ my ($title, $value) = $_ =~ m,\<span class="otsikko"\>([^:]+):\</span\> (.*)\<br /\>,;
+ if ($value =~ m,\<a .*\>(.*)\</a\>,) {
+ $value = $1;
+ }
+ $next_channels = 1 if (m,\<span class="otsikko"\>Kanavat,);
+
+ if ($title && $value) {
+ if ($title eq "Maili") {
+ $title = "e-mail";
+ } elsif ($title =~ /Kaupunki/) {
+ $title = "city";
+ } elsif ($title eq "Syntynyt") {
+ $title = "birthday";
+ } elsif ($title eq "Muutettu") {
+ $title = "last modified";
+ }
+ Irssi::printformat(MSGLEVEL_CRAP, 'gallery_line', $title, $value);
+ }
+ }
+ close($f);
+
+ if ($found) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'gallery_footer', $nick);
+ } elsif ($print_notfound{$nick}) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'gallery_notfound', $nick);
+ }
+
+ delete $print_notfound{$nick};
+}
+
+# download the info from gallery to cache dir,
+# if the files aren't there already.
+sub download_nicks_info {
+ foreach my $nick (@_) {
+ my $filename = "$cache_path/$nick";
+ if (! -f $filename) {
+ # FIXME: we could do this ourself with sockets...
+ Irssi::command("exec - wget -O$filename.tmp -q -UMozilla ".get_view_url($nick)."; mv $filename.tmp $filename");
+ }
+ }
+}
+
+# print info from all given nicks that have file in cache dir
+sub gallery_show {
+ foreach my $nick (@_) {
+ if (-f "$cache_path/$nick") {
+ print_gallery($nick);
+ } else {
+ push @print_queue, $nick;
+ }
+ }
+}
+
+sub print_whois_gallery {
+ my ($server, $nick) = @_;
+
+ if ($gallery_nicks{lc $nick}) {
+ $server->printformat($nick, MSGLEVEL_CRAP, 'whois_gallery',
+ $nick, get_view_url($nick));
+ }
+}
+
+# /WHOIS - print the gallery URL after realname
+sub event_whois {
+ my ($server, $data) = @_;
+ my ($temp, $nick) = split(" ", $data);
+
+ print_whois_gallery($server, $last_whois_nick) if ($last_whois_nick);
+ $last_whois_nick = $nick;
+}
+
+sub event_end_of_whois {
+ my ($server) = @_;
+
+ if ($last_whois_nick) {
+ print_whois_gallery($server, $last_whois_nick);
+ $last_whois_nick = undef;
+ }
+}
+
+# /GALLERY <nicks>
+sub cmd_gallery {
+ my @nicks = split(/[, ]/, $_[0]);
+
+ if (!$gallery_nicks_time) {
+ Irssi::printformat(MSGLEVEL_CLIENTERROR, 'gallery_nolist');
+ return;
+ }
+
+ my @new_list;
+ foreach my $nick (@nicks) {
+ my $gallery_nick = $gallery_nicks{lc $nick};
+ if (!$gallery_nick) {
+ Irssi::printformat(MSGLEVEL_CRAP, 'gallery_notfound', $nick);
+ } else {
+ push @new_list, $gallery_nick;
+ }
+ }
+
+ download_nicks_info(@new_list);
+ gallery_show(@new_list);
+
+ if ($gallery_nicks_time < time()-(3600*8)) {
+ # nicklist hasn't been updated for a while, refresh it
+ download_nicklist();
+ }
+}
+
+# parse all known nicks from nick index file
+sub parse_nicks {
+ my $filename = shift;
+
+ %gallery_nicks = {};
+ $gallery_nicks_time = time();
+
+ my $f = gensym;
+ if (!open($f, "<", $filename)) {
+ Irssi::print("Couldn't open file $filename: $!", MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ while (<$f>) {
+ if (m,\<a href="view.php.*\>(.*)\</a\>,) {
+ $gallery_nicks{lc $1} = $1;
+ }
+ }
+ close($f);
+}
+
+# /EXEC finished - maybe there's new files downloaded in cache dir?
+sub sig_exec_remove {
+ my @new_queue;
+
+ if (-f $nicklist_path) {
+ parse_nicks($nicklist_path);
+ unlink($nicklist_path);
+ }
+
+ foreach my $nick (@print_queue) {
+ if (-f "$cache_path/$nick") {
+ print_gallery($nick);
+ } else {
+ push @new_queue, $nick;
+ }
+ }
+ @print_queue = @new_queue;
+}
+
+sub download_nicklist {
+ Irssi::command("exec - wget -O$nicklist_path -q -UMozilla http://irc-galleria.net/list.php?letter=_");
+}
+
+# clear cache dir
+if (-d $cache_path) {
+ unlink(<$cache_path/*>);
+} else {
+ mkdir($cache_path, 0700) || die "Can't create cache directory $cache_path";
+}
+
+# we need the nick list, get it once per hour
+download_nicklist();
+
+Irssi::signal_add_first('event 311', 'event_whois');
+Irssi::signal_add_first('event 318', 'event_end_of_whois');
+Irssi::signal_add('exec remove', 'sig_exec_remove');
+Irssi::command_bind('gallery', 'cmd_gallery');
diff --git a/scripts/ircgmessagenotify.pl b/scripts/ircgmessagenotify.pl
new file mode 100644
index 0000000..cb019d1
--- /dev/null
+++ b/scripts/ircgmessagenotify.pl
@@ -0,0 +1,218 @@
+#!/usr/bin/perl -T -w
+
+# Harjoitustyönä tehty skripta.
+
+# Käyttö:
+# 1) kopioi .irssi/scripts hakemistoon
+# 2) /run ircgmessagenotify.pl
+# 3) /set ircgusername yournick
+# 4) /set ircgpassword yourpassword
+# 5) Voit myös optionaalisesti säätää ircgcheck_interval arvoa joka sekunneissa määärää kyselyjen välisen ajan sekunteina
+# 6) ircgdo_polling asetus voi olla joko 1 tai 0 ja se määrää pollataanko serveriä ylipäänsä
+# 7) /statusbar window add ircgcomments komento lisää statusbariin kohdan IRCG: n jossa n kuvaa uusien viestien lukumäärää. =)
+# 8) /ircgcomments komento kyselee käsin pakotettuna tilanteen
+
+# jos polling on asetettu 0 ei edes käsipelin kysely toimi.
+
+# Kiitokset statusbar ideasta Whiz:ille.. kiitos pällistä ideasta pälliin skriptaan jne.
+# Kiitoksia ei heru Whizille kylläkään toimimattomista regexpeistä... joutu ihan itse opetteleen keletanatu.
+
+use strict;
+use LWP::UserAgent;
+use HTTP::Cookies;
+use Irssi;
+use Irssi::TextUI;
+
+# ------------------------------------
+# Ircgalleria skriptin poikanen
+#
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.1b";
+%IRSSI = (
+ authors => "BCOW",
+ contact => "bcow\@iki.fi",
+ name => "ircgmessagenotify",
+ description => "Tarkistelee irc-galleria.net:iä ja sanoo kun sinulle on uusia viestejä.",
+ sbitems => "ircgcomments",
+ license => "GPLv2",
+ url => "http://www.verkonpaino.net/",
+ changed => "21.01.2004 23:55:00 EET"
+);
+
+# alustetaan asetukset
+Irssi::settings_add_str('ircgmessagenotify', 'ircgusername', '');
+Irssi::settings_add_str('ircgmessagenotify', 'ircgpassword', '');
+Irssi::settings_add_int('ircgmessagenotify', 'ircgcheck_interval', '120');
+Irssi::settings_add_int('ircgmessagenotify', 'ircgdo_polling', '1');
+
+# alustetaan keksisäilö :P
+my $cookie_jar = HTTP::Cookies->new(file => $ENV{'HOME'}. "/.irssi/ircgmessagenotify_cookie_jar.dat", autosave => 1,);
+# alustetaan viestilaskuri
+my $lastcount = 0;
+# alustetaan timeria
+my $timeout;
+my $timeouttag;
+
+# -- aseta timeri
+sub setup_timer
+{
+ # aseta uusi timeri
+ $timeout = Irssi::settings_get_int("ircgcheck_interval");
+ if ($timeout < 60)
+ {
+ $timeout == 60;
+ Irssi::print("ircgcheck_interval ei voi olla pienempi kuin 60. Asetin sen 60:een.");
+ }
+ $timeouttag = Irssi::timeout_add($timeout * 1000, 'check_for_new_messages', '');
+}
+
+# -- varmistetaan että timeri muuttuu ja sen mukaan myös skriptan ajo.
+sub setup_changed
+{
+ # määritykset muuttui. aseta timeri uudestan =)
+ Irssi::timeout_remove($timeouttag);
+ &setup_timer;
+ # jokatapauksessa piirrä statusbar uudestaan
+ Irssi::statusbar_items_redraw("ircgcomments");
+}
+
+# -- varsinainen funktio jolla tsekataan viestit
+sub check_messages
+{
+ my $forced = $_[0];
+
+ my $ua = LWP::UserAgent->new;
+ $ua->agent("Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)");
+ $ua->timeout(10);
+ $ua->cookie_jar($cookie_jar);
+
+ my $irclogin = Irssi::settings_get_str('ircgusername');
+ my $passwd = Irssi::settings_get_str('ircgpassword');
+
+ my $req = HTTP::Request->new(POST => "http://irc-galleria.net/login.php");
+ $req->content_type("application/x-www-form-urlencoded");
+ $req->content("login=$irclogin&passwd=$passwd");
+
+ my $res = $ua->request($req);
+
+ # Oliko palautus ok vai virhe
+ if ($res->is_success) {
+ #print $res->content;
+ # okei saatiin tehtyä kirjautuminen.. ööm ja saatiin se mitä pitäisikin. tämä ei ole kuitenkaan se mitä halutaan ;)
+ Irssi::print("ircgmessagenotify.pl sanoo: ööömm.. tätä ei pitänyt tapahtua: ". $res->as_string);
+ } elsif ($res->is_redirect) {
+ # okei uudelleenohjaus niinkuin pitäisikin(?) olla´
+ if ($res->header("Location") =~ /error/)
+ {
+ # gallerian virhe
+ Irssi::print("ircgmessagenotify.pl sanoo VIRHE kirjauduttaessa: gallerian virhekoodi!");
+ } else {
+ # homma ok. Haetaanpas sitten uudella requestilla viestit
+ my $req2 = HTTP::Request->new(GET => "http://irc-galleria.net/". $res->header("Location"));
+
+ # useragent toivottavasti muistaa keksit
+ my $res2 = $ua->request($req2);
+
+ if ($res2->is_success)
+ {
+ # ookii ;) saatiin content!
+ if ($res2->content =~ /Sinulle on uusia kommentteja/)
+ {
+ #Irssi::print("Sinulle on uusia kommentteja irc-galleriassa!!!");
+ my $newcount = $res2->content;
+ #$newcount =~ s/.*commentcount\"\>\(//i;
+ #$newcount =~ s/\)\<.*//i;
+
+ # irroita arvo :)
+ $newcount =~ /.*commentcount\"\>\((\d)\)\<.*/;
+ $newcount = $1;
+
+ my $uusia = $newcount - $lastcount;
+
+ #Irssi::print("Uusia: $uusia, newcount: $newcount, lastcount: $lastcount");
+
+ # sitten viimeinen tarkistus ;)
+ if ($lastcount < $newcount)
+ {
+ # uusia viestejä! jeee!
+ Irssi::print("Sinulle on irc-galleriassa $uusia kpl uusia kommentteja. Yhteensä $newcount kpl.");
+ } elsif ($lastcount > $newcount) {
+ # viestejä on luettu sitten viimekerran tai jotain muuta hassua, mutta niitä on kuitenkin
+ Irssi::print("Sinulle on irc-galleriassa $newcount kpl viestejä odottamassa lukemista.");
+ } # nolla tekee jotakin omituista :)
+
+ # aseta arvo
+ $lastcount = $newcount;
+ } else {
+ # aseta arvo nollille koska ei ole uusia viestejä
+ $lastcount = 0;
+ if ($forced == 1)
+ {
+ # hassuja epäloogisuuksia tuossa ylempänä ja siinä mitä tässä tapahtuu ;)
+ Irssi::print("Sinulle ei ole uusia kommentteja irc-galleriassa.");
+ }
+ }
+ } else {
+ # virhe :(((
+ Irssi::print("ircgmessagenotify.pl sanoo VIRHE viestien lukumäärää selvitettäessä: ". $res2->status_line);
+ }
+ }
+ } else {
+ #print $res->status_line, "\n";
+ # virhe :(((
+ Irssi::print("ircgmessagenotify.pl sanoo VIRHE kirjauduttaessa: ". $res->status_line);
+ }
+}
+
+# -- tarkista pakotetusti
+sub check_messages_forced
+{
+ &check_messages(1);
+ # jokatapauksessa piirrä statusbar uudestaan
+ Irssi::statusbar_items_redraw("ircgcomments");
+}
+
+# -- tarkista onko uusia viestejä eli yhdy palvelimeen ja tsekkaa lukema
+sub check_for_new_messages
+{
+ # tarkista tarvitseeko tehdä mitään?
+ if (Irssi::settings_get_int("ircgdo_polling") > 0)
+ {
+ #Irssi::print("Tick");
+ &check_messages(0);
+ } # do_polling
+ # jokatapauksessa piirrä statusbar uudestaan
+ Irssi::statusbar_items_redraw("ircgcomments");
+}
+
+# -- näytä tieto tän hetkisestä laskurista statusbarissa -)
+sub statusbar
+{
+ my ($item, $get_size_only) = @_;
+
+ my $state;
+
+ if (Irssi::settings_get_int("ircgdo_polling") > 0)
+ {
+ # jos pollataan näytäkkin jotain
+ $state = $lastcount;
+ } else {
+ # ei pollata joten näytä -
+ $state = "-";
+ }
+
+ $item->default_handler($get_size_only, undef, "IRCG: $state", 1);
+}
+
+# Kiinnitetään timeri
+&setup_timer;
+
+# sitten signaali liitoksia
+Irssi::signal_add("setup changed", "setup_changed");
+
+# ja komento liitoksia
+Irssi::command_bind('ircgcomments', 'check_messages_forced');
+
+# viimeiseksi jää statusbar liitos
+Irssi::statusbar_item_register('ircgcomments','{sb $0-}', 'statusbar');
diff --git a/scripts/ircops.pl b/scripts/ircops.pl
new file mode 100644
index 0000000..96e25be
--- /dev/null
+++ b/scripts/ircops.pl
@@ -0,0 +1,44 @@
+use Irssi;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.1";
+%IRSSI = (
+ authors => 'BC-bd',
+ contact => 'bd@bc-bd.org',
+ name => 'ircops',
+ description => '/IRCOPS - Display IrcOps in current channel',
+ license => 'GPL v2',
+ url => 'https://bc-bd.org/svn/repos/irssi/trunk/',
+);
+
+sub cmd_ircops {
+ my ($data, $server, $channel) = @_;
+
+ my (@list,$text,$num);
+
+ if (!$channel || $channel->{type} ne 'CHANNEL') {
+ Irssi::print('No active channel in window');
+ return;
+ }
+
+ foreach my $nick ($channel->nicks()) {
+ if ($nick->{serverop}) {
+ push(@list,$nick->{nick});
+ }
+ }
+
+ $num = scalar @list;
+
+ if ($num == 0) {
+ $text = "no IrcOps on this channel";
+ } else {
+ $text = "IrcOps (".$num."): ".join(" ",@list);
+ }
+
+ $channel->print($text);
+}
+
+Irssi::command_bind('ircops', 'cmd_ircops');
+
diff --git a/scripts/ircsec.pl b/scripts/ircsec.pl
new file mode 100644
index 0000000..00dea4c
--- /dev/null
+++ b/scripts/ircsec.pl
@@ -0,0 +1,205 @@
+# by Stefan 'tommie' Tomanek
+
+use strict;
+
+use Irssi 20020324;
+use Irssi::TextUI;
+use Crypt::CBC;
+use Digest::MD5 qw(md5 md5_hex md5_base64);;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '20190114';
+%IRSSI = (
+ authors => 'Stefan \'tommie\' Tomanek',
+ contact => 'stefan@pico.ruhr.de',
+ name => 'IRCSec',
+ description => 'secures your conversation',
+ license => 'GPLv2',
+ changed => $VERSION,
+ modules => 'Crypt::CBC Digest::MD5',
+ sbitems => 'ircsec',
+ commands => "ircsec",
+
+);
+
+use vars qw(%channels);
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub show_help() {
+ my $help=$IRSSI{name}." ".$VERSION."
+/ircsec secure <key>
+ Encrypt and decrypt conversation in current channel/query with <key>
+/ircsec unlock
+ Disable de/encryption
+/ircsec toggle
+ Temporary dis- or enable security
+";
+ my $text = '';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP &draw_box($IRSSI{name}." help", $text, "help", 1) ;
+}
+
+
+sub encrypt ($$$) {
+ my ($text, $key, $algo) = @_;
+ my $cipher;
+ $cipher = Crypt::CBC->new( -key => $key,
+ -cipher => $algo,
+ -iv => '$KJh#(}q',
+ -literal_key => 0,
+ -padding => 'space',
+ -header => 'randomiv'
+ );
+ return unless $cipher;
+ my $checksum = md5_base64($text);
+ my $ciphertext = $cipher->encrypt_hex($text." ".$checksum);
+ return $ciphertext;
+}
+
+sub decrypt ($$$) {
+ my ($data, $key, $algo) = @_;
+ my $cipher;
+ $cipher = Crypt::CBC->new( -key => $key,
+ -cipher => $algo,
+ -iv => '$KJh#(}q',
+ -literal_key => 0,
+ -padding => 'space',
+ -header => 'randomiv'
+ );
+
+ return unless $cipher;
+ my $plaintext = $cipher->decrypt_hex($data);
+ my ($text, $checksum) = $plaintext =~ /^(.*) (.*?)$/;
+ if ($checksum eq md5_base64($text)) {
+ return $text;
+ } else {
+ return undef;
+ }
+}
+
+sub sig_send_text ($$$) {
+ my ($line, $server, $witem) = @_;
+ return unless ref $witem;
+ my $tag = $witem->{server}->{tag};
+ if (defined $channels{$tag}{$witem->{name}} && $channels{$tag}{$witem->{name}}{active}) {
+ my $key = $channels{$tag}{$witem->{name}}{key};
+ Irssi::signal_stop();
+ my $cipher = Irssi::settings_get_str('ircsec_default_cipher');
+ my $crypt = encrypt($line, $key, $cipher);
+# if (defined $crypt) {
+ Irssi::signal_continue("[IRCSec:".$cipher."] ".$crypt, $server, $witem);
+# } else {
+# $witem->print("%R[IRCSec]>%n Unknown cipher method '".$cipher."'", MSGLEVEL_CLIENTCRAP);
+# }
+ }
+}
+
+sub decode ($$$) {
+ my ($server, $text, $target) = @_;
+ return unless ($text =~ /^\[IRCSec(:(.*?))?\] ([\d\w]+)/);
+ my $string = $3;
+ my $cipher = $2;
+ $cipher = Irssi::settings_get_str('ircsec_default_cipher') unless $cipher;
+ my $witem = $server->window_item_find($target);
+ return unless ref $witem;
+ return unless defined $channels{$server->{tag}}{$target};
+ my $key = $channels{$server->{tag}}{$target}{key};
+ my $plain = decrypt($string, $key, $cipher);
+ if (defined $plain) {
+ $witem->print("%B[IRCSec:".$cipher."]>%n $plain", MSGLEVEL_CLIENTCRAP);
+ } else {
+ $witem->print("%R[IRCSec]>%n Unknown cipher method '".$cipher."' or wrong key", MSGLEVEL_CLIENTCRAP);
+ }
+}
+
+sub sb_ircsec ($$) {
+ my ($item, $get_size_only) = @_;
+ my $win = !Irssi::active_win() ? undef : Irssi::active_win()->{active};
+ my $line;
+ if (ref $win && ($win->{type} eq "CHANNEL" || $win->{type} eq "QUERY")){
+ my $name = $win->{name};
+ my $tag = $win->{server}->{tag};
+ if ($channels{$tag}{$name} && $channels{$tag}{$name}{active}) {
+ $line = "%G%Uo-m%U%n";
+ } elsif ($channels{$tag}{$name}){
+ $line = "%Ro-m%n";
+ }
+ }
+ my $format = "{sb ".$line."}";
+ $item->{min_size} = $item->{max_size} = length($line);
+ $item->default_handler($get_size_only, $format, 0, 1);
+ $item->default_handler($get_size_only, $format, 0, 1);
+}
+
+sub cmd_ircsec ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @arg = split(/ /, $args);
+ if (@arg == 0 || $arg[0] eq 'help') {
+ # do some stuff
+ show_help();
+ } elsif ($arg[0] eq 'secure') {
+ shift @arg;
+ return unless ref $witem;
+ if (@arg) {
+ my $key = join(' ', @arg);
+ if (length($key) < 8) {
+ $witem->print("%R>>%n Key must be a minimum of 8 characters", MSGLEVEL_CLIENTCRAP);
+ } else {
+ $channels{$server->{tag}}{$witem->{name}}{key} = join(' ', @arg);
+ $channels{$server->{tag}}{$witem->{name}}{active} = 1;
+ $witem->print("%B>>%n %Go-m%n Conversation secured", MSGLEVEL_CLIENTCRAP);
+ }
+ } else {
+ $witem->print("%R>>%n Please specify a key", MSGLEVEL_CLIENTCRAP);
+ }
+ Irssi::statusbar_items_redraw('ircsec');
+ } elsif ($arg[0] eq 'unlock') {
+ delete $channels{$server->{tag}}{$witem->{name}};
+ $witem->print("%B>>%n %Ro-m%n Security disabled", MSGLEVEL_CLIENTCRAP);
+ Irssi::statusbar_items_redraw('ircsec');
+ } elsif ($arg[0] eq 'toggle') {
+ return unless ref $witem;
+ if ($channels{$server->{tag}}{$witem->{name}}) {
+ $channels{$server->{tag}}{$witem->{name}}{active} = not $channels{$server->{tag}}{$witem->{name}}{active};
+ Irssi::statusbar_items_redraw('ircsec');
+ }
+ }
+}
+
+Irssi::signal_add('message private', sub { decode($_[0], $_[1], $_[2]); });
+Irssi::signal_add('message public', sub { decode($_[0], $_[1], $_[4]); });
+Irssi::signal_add('message own_private', sub { decode($_[0], $_[1], $_[2]); });
+Irssi::signal_add('message own_public', sub { decode($_[0], $_[1], $_[2]); });
+
+Irssi::signal_add_first('send text', "sig_send_text");
+Irssi::signal_add('window changed', sub { Irssi::statusbar_items_redraw('ircsec'); });
+Irssi::signal_add('window item changed', sub { Irssi::statusbar_items_redraw('ircsec'); });
+
+Irssi::statusbar_item_register('ircsec', 0, 'sb_ircsec');
+
+Irssi::settings_add_str($IRSSI{name}, 'ircsec_default_cipher', 'Blowfish');
+
+Irssi::command_bind('ircsec', \&cmd_ircsec);
+
+foreach my $cmd ('unlock', 'secure', 'toggle') {
+ Irssi::command_bind('ircsec '.$cmd => sub {
+ cmd_ircsec("$cmd ".$_[0], $_[1], $_[2]); });
+}
+
+print CLIENTCRAP "%B>>%n ".$IRSSI{name}." ".$VERSION." loaded: /ircsec help for help";
+
+# vim:set ts=8 sw=4:
diff --git a/scripts/irssiBlaster.pl b/scripts/irssiBlaster.pl
new file mode 100644
index 0000000..1775763
--- /dev/null
+++ b/scripts/irssiBlaster.pl
@@ -0,0 +1,446 @@
+# irssiBlaster 1.6
+# Copyright (C) 2003 legion
+#
+# "Now Playing" (mp3blaster) in Irssi and more.
+#
+# - mp3blaster (http://www.stack.nl/~brama/mp3blaster.html)
+# - irssi (http://irssi.org)
+# for /npsend (EXPERIMENTAL):
+# - lsof (ftp://vic.cc.purdue.edu/pub/tools/unix/lsof/)
+#
+# NOTE: these applications are available in any linux distribution.
+#
+# should work with any version (i'm using irssi 0.8.8 & mp3blaster 3.2.0)
+# bug reports,features requests or comments -> a.lepore@email.it
+#
+# License:
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or any later version. www.gnu.org
+#
+#################################################################################
+# *** USAGE:
+#
+# /np : display the "Artist - Song" played in current window,
+# any argument is printed after the song name (i.e. you own comment).
+#
+# /npa : like /np, but prints "Artist - Album [Year]".
+# If there isn't an appropriate album tag,print nothing.
+#
+# /anp : /np in all channels.
+#
+# /anpa : /npa in all channels.
+#
+# /npinfo : display all available info for the current file.
+#
+# /cleanbar : clean the statubar item (until the next song).
+#
+# /npsend NICK : *EXPERIMENTAL* (irssi often CRASH)
+# send the current played file to NICK user.
+# maybe it will be usable in version 2.0.
+#
+#
+# *** SETTINGS:
+#
+# blaster_bar ON/OFF : statusbar item activation.
+# ATTENTION:
+# you also have to add the item 'blaster' to your statusbar.
+# see: http://irssi.org/?page=docs&doc=startup-HOWTO#c12
+# example:
+# /statusbar window add -priority "-10" -alignment right blaster
+#
+# blaster_infos_path FILE : the file with infos (mp3blaster -f FILE).
+# default is ~/.infoz
+#
+# blaster_bar_prefix STRING : the bar prefix to filename. default is "playing:"
+#
+# blaster_prefix : the /np prefix to filename. default is "np:"
+#
+#################################################################################
+# Changelog:
+#
+# 1.6:
+# - /npinfo.
+# - /cleanbar.
+# - /anpa.
+# - /npa.
+# - help fixes. $infofile is now /tmp/irssiblaster.
+# - /npsend (EXPERIMENTAL).
+# - /np [comment].
+# - /anp.
+# - BUGFIX: no spaces at the end of the filenames.
+# - added code comments.
+# - prefixes can be changed.
+# - statusbar realtime print.
+# - 'mp3blaster_infos_path' is now 'blaster_infos_path'.
+#
+# 1.0:
+# - initial release.
+#
+# TODO:
+# - working /npsend
+# - (automatic) /cleanbar
+# - support for others stuff (album,time..)
+# - /help
+# - use strict;
+#################################################################################
+
+use strict;
+use Irssi;
+use Irssi::TextUI;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.6';
+%IRSSI = (
+ authors => 'legion',
+ contact => 'a.lepore@email.it',
+ name => 'irssiBlaster',
+ description => 'Display the song played by mp3blaster in channels and statusbar. See the top of the file for usage.',
+ sbitems => 'blaster',
+ license => 'GNU GPLv2 or later',
+ changed => 'Fri Oct 31 12:22:08 CET 2003',
+);
+
+# TODO get rid of all those globals. This script needs some serious rework.
+my (@all, @artist, @title, @album, @year, @name, @status, @comment, @mode, @format, @bitrate, @samplerate, @length, @next, @tot);
+my ($name, $infofile, $status, $artist, $title, $year, $album, $comment, $format, $bitrate, $mode, $samplerate, $length, $next, $min, $sec, $secs, $prefix, $barprefix, $tot);
+
+sub get_info {
+
+ my $infofile = Irssi::settings_get_str('blaster_infos_path');
+ open (FILE, "<", $infofile); # open and read file with infos
+ my @all = <FILE>;
+ close (FILE);
+
+ @artist = grep (/^artist/, @all); # get the lines with tag infos
+ @title = grep (/^title/, @all);
+ @album = grep (/^album/, @all);
+ @year = grep (/^year/, @all);
+ @name = grep (/^path/, @all); # get the line with filename
+
+} ##
+
+sub get_allinfo {
+
+ $infofile = Irssi::settings_get_str('blaster_infos_path');
+ open (FILE, "<", $infofile);
+ @all = <FILE>;
+ close (FILE);
+
+ @name = grep (/^path/, @all);
+ $name = $name[0];
+ $name =~ s/^path //;
+ chomp $name;
+ @status = grep (/^status/, @all);
+ $status = $status[0];
+ $status =~ s/^status //;
+ chomp $status;
+ @artist = grep (/^artist/, @all);
+ $artist = $artist[0];
+ $artist =~ s/^artist //;
+ chomp $artist;
+ @title = grep (/^title/, @all);
+ $title = $title[0];
+ $title =~ s/^title //;
+ chomp $title;
+ @album = grep (/^album/, @all);
+ $album = $album[0];
+ $album =~ s/^album //;
+ chomp $album;
+ @year = grep (/^year/, @all);
+ $year = $year[0];
+ $year =~ s/^year //;
+ chomp $year;
+ @comment = grep (/^comment/, @all);
+ $comment = $comment[0];
+ $comment =~ s/^comment //;
+ chomp $comment;
+ @mode = grep (/^mode/, @all);
+ $mode = $mode[0];
+ $mode =~ s/^mode //;
+ chomp $mode;
+ @format = grep (/^format/, @all);
+ $format = $format[0];
+ $format =~ s/^format //;
+ chomp $format;
+ @bitrate = grep (/^bitrate/, @all);
+ $bitrate = $bitrate[0];
+ $bitrate =~ s/^bitrate //;
+ chomp $bitrate;
+ @samplerate = grep (/^samplerate/, @all);
+ $samplerate = $samplerate[0];
+ $samplerate =~ s/^samplerate //;
+ chomp $samplerate;
+ @length = grep (/^length/, @all);
+ $length = $length[0];
+ $length =~ s/^length //;
+ chomp $length;
+ @next = grep (/^next/, @all);
+ $next = $next[0];
+ $next =~ s/^next //;
+ chomp $next;
+
+} ##
+
+sub get_status {
+
+ $infofile = Irssi::settings_get_str('blaster_infos_path');
+ open (FILE, "<", $infofile);
+ @all = <FILE>;
+ close (FILE);
+
+ @status = grep (/^status/, @all);
+} ##
+
+sub get_tag_info {
+
+ $artist = $artist[0]; # is an one-element array
+ $artist =~ s/^artist //; # remove prefixes
+ chomp $artist; # remove last char (for correct printing)
+ $title = $title[0];
+ $title =~ s/^title //;
+ chomp $title;
+ $album = $album[0];
+ $album =~ s/^album //;
+ chomp $album;
+ $year = $year[0];
+ $year =~ s/^year //;
+ chomp $year;
+
+ $prefix = Irssi::settings_get_str('blaster_prefix');
+ $barprefix = Irssi::settings_get_str('blaster_bar_prefix');
+
+} ##
+
+sub get_name_info {
+
+ $name = $name[0];
+ $name =~ s/^path //; # remove prefix
+ $name =~ s/\.mp3$//i; # remove extensions
+ $name =~ s/\.ogg$//i;
+ $name =~ s/_/ /g; # change underscores to spaces
+ chomp $name;
+
+ $prefix = Irssi::settings_get_str('blaster_prefix');
+ $barprefix = Irssi::settings_get_str('blaster_bar_prefix');
+
+} ##
+
+sub noinfo_error {
+
+ $infofile = Irssi::settings_get_str('blaster_infos_path');
+ # print help if the info file is not valid
+ Irssi::print(
+ "%9IrssiBlaster:%_ \"$infofile\" is not a valid info file. %9Make sure%_ %Rmp3blaster -f $infofile%n %9is running!!!%_\n".
+ "%9IrssiBlaster:%_ (Hint: put %9alias mp3blaster='mp3blaster -f $infofile'%_ in your ~/.bashrc )"
+ , MSGLEVEL_CRAP);
+
+} ##
+
+
+
+
+sub cmd_np { # /np stuff
+
+get_info;
+
+if (@artist && @title) { # if file has a an id3tag
+
+ get_tag_info;
+
+ my ($comment, $server, $witem) = @_; # np: blabla in current window (copied from other scripts..)
+ if ($witem && ($witem->{type} eq "CHANNEL" || $witem->{type} eq "QUERY")) {
+ $witem->command("me $prefix $artist - $title $comment");
+ }
+ else {
+ Irssi::print("$prefix $artist - $title $comment", MSGLEVEL_CRAP); # or print in client level if no active channel/query
+ }
+}
+
+elsif (@name) { # if there isn't id3tag we use the filename
+
+ get_name_info;
+
+ my ($comment, $server, $witem) = @_;
+ if ($witem && ($witem->{type} eq "CHANNEL" || $witem->{type} eq "QUERY")) {
+ $witem->command("me $prefix $name $comment");
+ }
+ else {
+ Irssi::print("$prefix $name $comment", MSGLEVEL_CRAP);
+ }
+}
+
+else { noinfo_error; }
+
+} ##
+
+sub cmd_npall { # /anp stuff
+
+get_info;
+
+if (@artist && @title) {
+
+ get_tag_info;
+
+ my ($comment, $server, $witem) = @_;
+ Irssi::command("foreach channel /me $prefix $artist - $title $comment");
+}
+
+elsif (@name) {
+
+ get_name_info;
+
+ my ($comment, $server, $witem) = @_;
+ Irssi::command("foreach channel /me $prefix $name $comment");
+}
+
+else { noinfo_error; }
+
+} ##
+
+sub cmd_npalbum { # /npa stuff
+
+if (@artist && @album) {
+
+ get_tag_info;
+
+ if ($year) { $year = "[$year]"; }
+
+ my ($comment, $server, $witem) = @_;
+ if ($witem && ($witem->{type} eq "CHANNEL" || $witem->{type} eq "QUERY")) {
+ $witem->command("me $prefix $artist - $album $year $comment");
+ }
+ else {
+ Irssi::print("$prefix $artist - $album $year $comment", MSGLEVEL_CRAP);
+ }
+}
+else {
+ Irssi::print("%9IrssiBlaster:%_ filename has no album tag.", MSGLEVEL_CRAP);
+}
+} ##
+
+sub cmd_npalbumall { # /anpa stuff
+
+get_info;
+
+if (@artist && @album) {
+
+ get_tag_info;
+
+ if ($year) { $year = "[$year]"; }
+
+ my ($comment, $server, $witem) = @_;
+ Irssi::command("foreach channel /me $prefix $artist - $album $year $comment");
+}
+else {
+ Irssi::print("%9IrssiBlaster:%_ filename has no album tag.", MSGLEVEL_CRAP);
+}
+} ##
+
+sub cmd_info {
+
+get_allinfo;
+
+$tot = $length/60; # calculating minutes:seconds
+@tot = split(/\./, $tot);
+$min = $tot[0];
+$sec = $min*60;
+$secs = $length-$sec;
+
+Irssi::print("\n%9IrssiBlaster - File Info:%_", MSGLEVEL_CRAP);
+Irssi::print("%9F%_ile%9:%_ $name", MSGLEVEL_CRAP);
+Irssi::print("%9S%_tatus%9:%_ $status", MSGLEVEL_CRAP);
+if ($artist) { Irssi::print("%9A%_rtist%9:%_ $artist", MSGLEVEL_CRAP); }
+if ($title) { Irssi::print("%9T%_itle%9:%_ $title", MSGLEVEL_CRAP); }
+if ($album) { Irssi::print("%9A%_lbum%9:%_ $album", MSGLEVEL_CRAP); }
+if ($year) { Irssi::print("%9Y%_ear%9:%_ $year", MSGLEVEL_CRAP); }
+if ($comment) { Irssi::print("%9C%_omment%9:%_ $comment", MSGLEVEL_CRAP); }
+Irssi::print("%9-%_----------%9-%_", MSGLEVEL_CRAP);
+if ($secs =~ /^.{1}$/) { Irssi::print("%9L%_ength%9:%_ $min\:0$secs", MSGLEVEL_CRAP); }
+else { Irssi::print("%9L%_ength%9:%_ $min\:$secs", MSGLEVEL_CRAP); }
+if ($format =~ /0$/) { Irssi::print("%9F%_iletype%9:%_ $format (Ogg/Vorbis?)", MSGLEVEL_CRAP); }
+else { Irssi::print("%9F%_iletype%9:%_ $format", MSGLEVEL_CRAP); }
+Irssi::print("%9R%_ate%9:%_ $bitrate\kb/$samplerate\Khz", MSGLEVEL_CRAP);
+if ($mode) { Irssi::print("%9M%_ode%9:%_ $mode", MSGLEVEL_CRAP); }
+if ($next) { Irssi::print("%9N%_ext in playlist%9:%_ $next", MSGLEVEL_CRAP); }
+
+} ##
+
+#######################################################################################
+
+sub bar_np { # statusbar stuff
+
+my ($item, $get_size_only) = @_;
+
+my $bar_activation = Irssi::settings_get_str('blaster_bar');
+if ($bar_activation =~ /^on$/i) { # display in bar only if /set blaster_bar = ON
+
+get_info;
+
+if (@artist && @title) {
+
+ get_tag_info;
+
+ # print in statusbar
+ $item->default_handler($get_size_only, "{sb $barprefix $artist - $title}", undef, 1);
+}
+
+elsif (@name) {
+
+ get_name_info;
+
+ $item->default_handler($get_size_only, "{sb $barprefix $name}", undef, 1);
+}
+
+else {
+ $item->default_handler($get_size_only, undef, undef, 1);
+}
+}
+} ##
+
+sub refresh {
+ Irssi::statusbar_items_redraw('blaster'); # refresh statusbar
+ Irssi::statusbars_recreate_items();
+} ##
+
+sub cmd_cleanbar { # /cleanbar stuff
+
+my $infofile = Irssi::settings_get_str('blaster_infos_path');
+unlink $infofile;
+
+} ##
+
+sub cmd_send { # /npsend stuff
+
+ get_info;
+
+ my @name = grep (/^path/, @all);
+ my $name = $name[0];
+ $name =~ s/path //;
+ chomp $name;
+
+ # get the full path of the file from 'lsof' (i have lsof 4.64)
+ my @open_files = grep (/$name$/, `lsof -c mp3blaste -F n`);
+ $open_files[0] =~ s/^n//;
+ my $filename = $open_files[0];
+ chomp $filename;
+
+ my ($target, $server, $witem) = @_;
+ $server->command("DCC SEND $target \"$filename\""); # /dcc send
+
+} ##
+
+
+Irssi::settings_add_str('irssiBlaster', 'blaster_infos_path', '/tmp/irssiblaster'); # register settings
+Irssi::settings_add_str('irssiBlaster', 'blaster_prefix', 'np:');
+Irssi::settings_add_str('irssiBlaster', 'blaster_bar_prefix', 'playing:');
+Irssi::settings_add_str('irssiBlaster', 'blaster_bar', 'OFF');
+Irssi::command_bind('np', 'cmd_np'); # register /commands
+Irssi::command_bind('anp', 'cmd_npall');
+Irssi::command_bind('npa', 'cmd_npalbum');
+Irssi::command_bind('anpa', 'cmd_npalbumall');
+Irssi::command_bind('npinfo', 'cmd_info');
+Irssi::command_bind('cleanbar', 'cmd_cleanbar');
+Irssi::command_bind('npsend', 'cmd_send');
+Irssi::statusbar_item_register('blaster', undef, 'bar_np'); # register statusbar item
+Irssi::timeout_add(1000, 'refresh', undef); # refresh every 1 second
diff --git a/scripts/isdn.pl b/scripts/isdn.pl
new file mode 100644
index 0000000..b1ceed8
--- /dev/null
+++ b/scripts/isdn.pl
@@ -0,0 +1,58 @@
+# DESCRIPTION
+# Displays incoming ISDN calls to active window
+# Looks even nicer with entries in
+# /etc/isdn/callerid.conf - see callerid.conf(5)
+#
+# CHANGELOG
+# 17.06.04
+# Script now runs for several days without any
+# problems. Added documentation.
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.3";
+%IRSSI = (
+ authors => "Uli Baumann",
+ contact => "f-zappa\@irc-muenster.de",
+ name => "isdn",
+ description => "Displays incoming ISDN calls",
+ license => "GPL",
+ changed => "Thu Jun 17 12:49:55 CEST 2004",
+);
+
+my $timer;
+
+sub incoming_call() # triggered by a timer; use of input_add
+ { # caused crash
+ while (my $message = <ISDNLOG>)
+ {
+ chomp($message);
+ if ($message =~ / Call to tei .* RING/) # just incoming calls
+ {
+ my $from = $message; # extract caller
+ $from =~ s/.*Call to tei.*from (.*) on.*RING.*/$1/;
+ my $to = $message; # extract callee
+ $to =~ s/.*Call to tei.*from .* on (.*) RING.*/$1/;
+ my $window = Irssi::active_win(); # write message to active win
+ $window->print("%YISDN:%n call from $from");
+ $window->print(" to $to");
+ }
+ }
+ }
+
+sub isdn_unload() # for a clean unload
+ {
+ close ISDNLOG;
+ Irssi::timeout_remove($timer);
+ }
+
+# when starting, open the isdnlog file and set pointer to eof
+open ISDNLOG, "< /var/log/isdn/isdnlog" or die "Can't open isdnlog";
+seek ISDNLOG,0,2;
+# install timeout for the incoming_call subroutine
+$timer=Irssi::timeout_add(1000, \&incoming_call, \&args);
+
+# disable timer and close file when script gets unloaded
+Irssi::signal_add_first('command script unload','isdn_unload');
+
diff --git a/scripts/itime.pl b/scripts/itime.pl
new file mode 100644
index 0000000..8483a59
--- /dev/null
+++ b/scripts/itime.pl
@@ -0,0 +1,47 @@
+# Internet Time statusbar item.
+# See http://www.timeanddate.com/time/internettime.html
+
+# /STATUSBAR window ADD itime
+
+use strict;
+use Irssi::TextUI;
+
+use vars qw($VERSION %IRSSI $itime_ratio $current_itime);
+
+$VERSION = '0.9';
+%IRSSI = (
+ authors => 'Johan "Ion" Kiviniemi',
+ contact => 'ion at hassers.org',
+ name => 'itime',
+ description =>
+'Internet Time statusbar item. See http://www.timeanddate.com/time/internettime.html',
+ sbitems => 'itime',
+ license => 'Public Domain',
+ url => 'http://ion.amigafin.org/scripts/',
+ changed => 'Tue Mar 12 22:20 EET 2002',
+);
+
+$itime_ratio = 1000 / 86400;
+$current_itime = get_itime();
+
+sub get_itime {
+ my ($s, $m, $h) = gmtime time + 3600;
+ my $itime = $itime_ratio * (3600 * $h + 60 * $m + $s);
+ return sprintf '@%03d', int $itime;
+}
+
+sub itime {
+ my ($item, $get_size_only) = @_;
+ $item->default_handler($get_size_only, undef, $current_itime, 1);
+}
+
+sub refresh_itime {
+ my $itime = get_itime();
+ return if $itime eq $current_itime;
+ $current_itime = $itime;
+ Irssi::statusbar_items_redraw('itime');
+}
+
+Irssi::statusbar_item_register('itime', '{sb $0}', 'itime');
+Irssi::statusbars_recreate_items();
+Irssi::timeout_add(5000, 'refresh_itime', undef);
diff --git a/scripts/ixmmsa.pl b/scripts/ixmmsa.pl
new file mode 100644
index 0000000..7d4e8ec
--- /dev/null
+++ b/scripts/ixmmsa.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+# ixmmsa.pl (iXMMSa - irssi XMMS announce), Version 0.3
+#
+# Copyleft (>) 2002 Kristof Korwisi <kk@manoli.im-dachgeschoss.de>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# The complete text of the GNU General Public License can be found
+# on the World Wide Web: <URL:http://www.gnu.org/licenses/gpl.html>
+
+use Xmms();
+use Xmms::Remote ();
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.2+1";
+%IRSSI = (
+ authors => 'Kristof Korwisi',
+ contact => 'kk@manoli.im-dachgeschoss.de',
+ name => 'iXMMSa',
+ description => '/xmms announces which _file_ is currently playing. E.g. Currently playing: "Kieran Halpin & Band - Mirror Town.mp3"',
+ license => 'GPL',
+ url => 'http://manoli.im-dachgeschoss.de/~kk/',
+ changed => '2006-10-27',
+ changes => 'added some comments, added $announce_message:_*-stuff',
+);
+
+Irssi::print("*****\n* $IRSSI{name} $VERSION loaded.\n* Type /xmms to announce currently played file.\n*****");
+
+sub cmd_xmms {
+
+ my ($data, $server, $witem) = @_;
+ my $xmms_remote = Xmms::Remote->new;
+
+ my $announce_message_front = "Currently playing:"; # announce message in front of the filename playing
+ my $announce_message_after = ""; # announce message after the filename playing
+
+
+ $filename= $xmms_remote->get_playlist_file($xmms_remote->get_playlist_pos);
+
+
+ $filename =~ s/.*\///g; # removes path
+ $filename =~ s/^$/Nothing's playing/; # in case there's nothing to listen to ;-)
+ $filename =~ s/[\r\n]/ /g; # remove newline characters
+
+ if ($witem && ($witem->{type} eq "CHANNEL" || $witem->{type} eq "QUERY")) {
+ $witem->command("MSG ".$witem->{name}." $announce_message_front \"$filename\" $announce_message_after");
+ } else {
+ Irssi::print("Not on active channel/query");
+ }
+}
+
+Irssi::command_bind('xmms', 'cmd_xmms');
diff --git a/scripts/joininfo.pl b/scripts/joininfo.pl
new file mode 100644
index 0000000..492fbd3
--- /dev/null
+++ b/scripts/joininfo.pl
@@ -0,0 +1,1097 @@
+###############################################################################
+#
+# Shows WHOIS: info including realname and channel names on joins to
+# channels.
+#
+# This script is based on the autorealname script, and shares a little
+# code and many ideas with that script. I use the same globals as they do,
+# but with totally different fields because their structure was not really
+# easy to adapt to a situation where more info is used on one query.
+#
+# Rewrote all that code, except for parts of request_whois and some init code
+#
+# I would like to thank Timo 'cras' Sirainen and Bastian Blank for writing
+# the autorealname script. It was a good example.
+#
+# The script contains very simple flood protection in the form that it will
+# not allow for more then $max_queued_requests per server at one time to be
+# running. It tries to be smart about netsplits, so this should be okay.
+# We have a 5-second timeout to make sure we really don't flood, ans also to
+# make sure that we don't wait indefinitely for answers that won't come.
+#
+# Themes:
+# You can change the way the WHOIS messages look using the /format command,
+# For example:
+# /FORMAT ji_whois_success %GWHOIS:%n {channick_hilight $0} \
+# is "{hilight $1}"%n on {channel $2}
+#
+# Will add a green WHOIS: to the line to make it stand out, save your
+# formatting in irssi using '/SAVE -formats'
+#
+# Add 'server: "{hilight $3}"' to the format string to also print the
+# server name (Thanks to Svein Skogen for suggesting this)
+#
+# Add 'flags: "{hilight $4}"' to the format string to also print
+# some additional flags for the user. These flags are tailored for
+# some unknown irc network but also work quite well on IRCNet and EFNet
+# after the 'idle' modifications I added to them. Thanks to
+# Francesco Rolando for providing me with the initial patch.
+#
+# Commands (/JOININFO ...)
+# INFO - Show info on and contents of the current cache of this script
+# GC - Manually run the garbage collector once
+# FORCE - Fake join of a nick to a chan (/JOININFO FORCE ichiban) use with
+# care. Useful for testing theme changes, timeouts and the garbage
+# collector on a quiet day or network. Will ignore your own nick.
+# HELP - Shows help
+#
+# Settings
+# /SET whois_expire_time # time to expire one saves record
+# # until this age has been reched no
+# # new WHOISs will be put on the server
+#
+# /SET whois_max_requests # max concurrent requests per server
+# # flood protection, keep low
+#
+# /SET whois_timeout_ms # timeout after which a whois is lost (ms)
+# # (default: 5000)
+#
+# /SET whois_gc_interval_ms # run gc ever x MS (default: 300000)
+# # Requires script reload when changed.
+#
+# /SET whois_debug # 0 = show no debug info, 1 = debug info
+#
+# /SET whois_printing_level # Level at which all non-debug output is
+# # printed, influences logging and IGNORE
+# # (default: JOINS)
+#
+# ChangeLog:
+# - Tue Jul 15 2003, pbijdens
+# Initial release version 0.5.1
+# - Thu Jul 17 2003, pbijdens
+# Version 0.5.2
+# Added garbage collection for the stored info.
+# Added /AWINFO and /AWGC commands to show info and to run the garbage
+# collector manually respectively
+# Added timeout for the putserv WHOIS making sure we do not record too many
+# jobs as BUSY.
+# - Thu Jul 17 2003, pbijdens
+# Version 0.5.3
+# Added settings (whois_...) to the irssi config so there is no need to
+# modify the script when changing them
+# - Thu Jul 17 2003, pbijdens
+# Version 0.5.5
+# Making sure the settings are reloaded when they are changed. Added a
+# signal handler for that
+# - Thu Jul 17 2003, pbijdens
+# Version 0.6.0
+# Added setting for whois_debug
+# Added theme support
+# Bugfix for servers sending 401 without 318 no need to wait for
+# timeout anymore on those
+# Added configurable printing level for the realname+channel messages.
+# use /SET whois_printing_level
+# Added /AWFORCE command (see above)
+# - Mon Jul 28 2003, pbijdens
+# Version 0.6.1
+# Various updates and bug fixes
+# Changed awforce command to strip spaces
+# - Wed Aug 13 2003, pbijdens
+# Version 0.7.0
+# Fixed typo in comment line
+# Changed /AW* commands to be /JOININFO <subcommand> and added a
+# /JOININFO HELP command. Renamed some subs to make their purpose
+# more clear.
+# - Wed Feb 2 2004, pbijdens
+# Added features for filtering channels from the list, and adding
+# support for hilighting channels in colors.
+# - Mon Mar 8 2004, pbijdens
+# Fixed bug where also on SILCNET the WHOIS queries would be run, now
+# this service is restricted to IRC networks. Thanks to Tony den Haan
+# for supplying this patch.
+# - Mon Mar 8 2004, pbijdens
+# Added support for printing the servername also in the output for those
+# who want to see it. Thanks to Svein Skogen for suggesting this and
+# sending me a patch.
+# NOTE: Requires you to add {hilight $3} to your format string manually.
+# By default the information is not diplayed.
+# - Mon Mar 8 2004, pbijdens
+# Added support for additional flags to the WHOIS output. This is stuff
+# like IrcOP, Away, Idle and more. Thanks to Francesco Rolando for
+# providing the additional patch, which I modified.
+# NOTE: Requires you to add {hilight $4} to your format string manually.
+# By default the information is not diplayed.
+# - Tue Mar 1 2005, pbijdens
+# Updated the script for compliance with a wider range of servers,
+# and removed some functionality that generally did not work, or break
+# on some servers. Been runing on 4 networks now with these patches for
+# many months, declaring stable and releasing 1.0.
+#
+################################################################################
+
+use Irssi 20011207;
+use strict;
+use vars qw($VERSION %IRSSI);
+use integer;
+
+################################################################################
+
+$VERSION = "1.0.0";
+%IRSSI = (
+ authors => "Pieter-Bas IJdens",
+ contact => "irssi-scripts\@nospam.mi4.org.uk",
+ name => "joininfo",
+ description => "Reports WHOIS information and channel list for those who join a channel",
+ license => "GPLv2 or later",
+ url => "http://pieter-bas.ijdens.com/irssi/",
+ changed => "2005-03-10"
+);
+
+################################################################################
+
+# Note that all settings below can and should be changed with /SET, see
+# /joininfo help or /set whois
+
+# The maximum acceeptable age for a cached whois record is 60 seconds
+# after this amount of time the cache record is discareded
+my $whois_maxage = 60;
+
+# The maximum number of requests queued at a time, if the queue reaches
+# a lrger size, ignore new requets until we have space left. This could
+# happen in a netjoin preceded by a very long netsplit
+my $max_queued_requests = 7;
+
+# Timeout after which a whois request is assumed not having been answered
+# by the server. In milliseconds
+my $whois_timeout = 5000;
+
+# Interval for the times at which GC takes place automatically. In milliseconds
+my $whois_gc_interval = 300000;
+
+# Debug poutput on or off
+my $whois_debug = 0;
+
+# Output level (the whois_printing_level_n is the numeric information for the
+# output level)
+my $whois_printing_level = "JOINS";
+my $whois_printing_level_n;
+
+################################################################################
+
+# Cached records per server, plus information about the amount of queued
+# reuests
+my %servers;
+
+################################################################################
+
+# Registers the theme messages with irssi so they can be changed later by the
+# user using the /FORMAT command
+sub register_messages
+{
+ Irssi::theme_register([
+ 'ji_whois_success',
+ '{channick_hilight $0} is "{hilight $1}"%n on {channel $2}',
+ 'ji_whois_list_header',
+ 'Server: {hilight $0} ($1 pending)',
+ 'ji_whois_list_nick',
+ '{channick_hilight $0} is "{hilight $1}"%n on {channel $2}',
+ 'ji_whois_list_status',
+ 'Status: $0; Record age: $1s; Server tag: $2'
+ ]);
+}
+
+################################################################################
+
+# Register the settings we use, and specify a DEFAULT for when Irssi
+# did not have them saved yet. Allows users to use /SET later.
+sub register_settings
+{
+ Irssi::settings_add_int(
+ "joininfo",
+ "whois_expire_time",
+ $whois_maxage
+ );
+ Irssi::settings_add_int(
+ "joininfo",
+ "whois_max_requests",
+ $max_queued_requests
+ );
+ Irssi::settings_add_int(
+ "joininfo",
+ "whois_timeout_ms",
+ $whois_timeout
+ );
+ Irssi::settings_add_int(
+ "joininfo",
+ "whois_gc_interval_ms",
+ $whois_gc_interval
+ );
+ Irssi::settings_add_int(
+ "joininfo",
+ "whois_debug",
+ $whois_debug
+ );
+ Irssi::settings_add_str(
+ "joininfo",
+ "whois_printing_level",
+ $whois_printing_level
+ );
+}
+
+################################################################################
+
+# Now (re-)read the settings, those saved in the config will be returned,
+# unless not present in which case the default will be returned
+# This function is called once on script start, and later is run as an
+# event handler when irssi notifies us of a change in settings.
+sub load_settings
+{
+ $whois_maxage = Irssi::settings_get_int("whois_expire_time");
+ $max_queued_requests = Irssi::settings_get_int("whois_max_requests");
+ $whois_timeout = Irssi::settings_get_int("whois_timeout_ms");
+ $whois_gc_interval = Irssi::settings_get_int("whois_gc_interval_ms");
+ $whois_debug = Irssi::settings_get_int("whois_debug");
+ $whois_printing_level = Irssi::settings_get_str("whois_printing_level");
+
+ $whois_printing_level = uc($whois_printing_level);
+ $whois_printing_level =~ s/[^A-Z]//gi;
+
+ my($definedlvl);
+ eval("\$definedlvl = defined(MSGLEVEL_" . $whois_printing_level. ");");
+
+ if (!$definedlvl)
+ {
+ Irssi::print(
+ "%RJOININFO:%n illegal /set whois_printing_level, see /help levels".
+ " for more informations. Assuming JOINS in stead of ".
+ "\"$whois_printing_level\"."
+ );
+ $whois_printing_level = "JOINS";
+ $whois_printing_level_n = MSGLEVEL_JOINS;
+ return;
+ }
+
+ eval("\$whois_printing_level_n = MSGLEVEL_" . $whois_printing_level . ";");
+
+ if ($whois_printing_level_n == 0)
+ {
+ Irssi::print(
+ "%RJOININFO:%n illegal /set whois_printing_level, see /help levels".
+ " for more informations. Assuming JOINS in stead of ".
+ "\"$whois_printing_level\"."
+ );
+ $whois_printing_level = "JOINS";
+ $whois_printing_level_n = MSGLEVEL_JOINS;
+ return;
+ }
+}
+
+################################################################################
+
+# We keep records of all nicks that ever joined a channel in our memory,
+# without ever freeing them up. This can get quite large over time, therefore
+# evere once in a while we go out and remove the garbage
+#
+# Now this function also corrects the pending counter in case strange things
+# happen on strange nets
+sub garbage_collector
+{
+ my($runtime) = time();
+
+ foreach my $tag (keys(%servers))
+ {
+ my($busy) = 0;
+ my($rec) = $servers{$tag};
+
+ foreach my $nick (keys %{$rec->{nicks}})
+ {
+ my($age) = $runtime - $rec->{nicks}->{$nick}->{record_time};
+
+ if ($rec->{nicks}->{$nick}->{busy})
+ {
+ # Re-calculate the number of pending requests
+ $busy = $busy + 1;
+
+ # we can safely delete it because 600 seconds should have
+ # caused a good oldfashioned ping timeout anyway
+ # if the server is not still going to respond after 10
+ # minutes we can crash for all I care
+ if ($age > 600)
+ {
+ Irssi::print(
+ "%RWHOIS:%n Giving up on %c$nick%n, because 600 " .
+ "seconds have passed since we first asked %c$tag%n.%N"
+ ) if ($whois_debug);
+
+ # We have one request less to process now
+ $busy = $busy - 1;
+
+ # Drop the request completely and forget all about this
+ # nick
+ delete $rec->{nicks}->{$nick};
+ }
+ }
+ elsif ($age >= 2 * $whois_maxage)
+ {
+ delete $rec->{nicks}->{$nick};
+ }
+
+ $rec->{processing} = $busy;
+ }
+ }
+}
+
+################################################################################
+
+# This is a very simple job to warp the call to the garbage collector. Used to
+# be self-scheduling, but irssi happily does that for us
+#
+# Pointless function, waste of memory, need one of those in every good
+# program, here is mine.
+sub aw_gc_scheduler
+{
+ garbage_collector();
+}
+
+################################################################################
+
+# Show information about the autowhois stuff and about who we still know
+# Basically displays the cache contents. Some stuff may still be in the cache
+# though it is already outdated, The barbage collector will take care of
+# those entries
+sub cmd_joininfo_info
+{
+ my($runtime) = time();
+
+ foreach my $tag (keys(%servers))
+ {
+ my($rec) = $servers{$tag};
+
+ Irssi::printformat(
+ MSGLEVEL_CRAP,
+ 'ji_whois_list_header',
+ $tag,
+ $rec->{processing}
+ );
+
+ foreach my $nick (keys %{$rec->{nicks}})
+ {
+ my($age) = $runtime - $rec->{nicks}->{$nick}->{record_time};
+ my($status) = "OK";
+
+ if ($rec->{nicks}->{$nick}->{busy})
+ {
+ $status = "BUSY";
+ }
+ elsif ($rec->{nicks}->{$nick}->{aborted})
+ {
+ $status = "ABORTED";
+
+ if ($rec->{nicks}->{$nick}->{known})
+ {
+ $status = $status . " but KNOWN";
+ }
+ }
+ else
+ {
+ $status = "COMPLETE";
+ }
+
+ Irssi::printformat(
+ MSGLEVEL_CRAP,
+ 'ji_whois_list_nick',
+ $nick,
+ $rec->{nicks}->{$nick}->{realname},
+ $rec->{nicks}->{$nick}->{channels},
+ $rec->{nicks}->{$nick}->{server},
+ $rec->{nicks}->{$nick}->{flags}
+ );
+ Irssi::printformat(
+ MSGLEVEL_CRAP,
+ 'ji_whois_list_status',
+ $status,
+ $age,
+ $tag
+ );
+ }
+ }
+}
+
+################################################################################
+
+# A timeout is put for this function just after the WHOIS has been sent to
+# the server. When the server does not reply, then we will mark the action as
+# aborted. If a reply still ariives later (due to lag) that is not a problem
+# as it will simply be reported then. The only thing this function makes sure
+# of is that the system is not marked busy anymore so other WHOIS requests
+# can go through
+sub server_whois_timeout
+{
+ my ($server, $nick) = @{$_[0]};
+ my $rec = $servers{$server->{tag}};
+
+ if ((defined($rec->{nicks}->{$nick}))
+ && ($rec->{nicks}->{$nick}->{busy} == 1)
+ )
+ {
+ $rec->{nicks}->{$nick}->{aborted} = 1;
+ $rec->{nicks}->{$nick}->{busy} = 0;
+
+ $rec->{processing} = $rec->{processing} - 1;
+
+ Irssi::print(
+ "%RWHOIS:%n whois timeout for nick %C$nick%n ".
+ "(still running $rec->{processing} requests)"
+ ) if ($whois_debug);
+ }
+
+ # Run once, so we remove this job
+ Irssi::timeout_remove($rec->{nicks}->{$nick}->{timeout_job});
+}
+
+################################################################################
+
+# Put a whois request on the server (for one nick only) if and only if the
+# number of outstanding rrequests on that server is not too high
+#
+# Also installs an event handler for the next related SHOIS event that the
+# server throws at us
+sub request_whois
+{
+ my ($server, $nick) = @_;
+ my $rec = $servers{$server->{tag}};
+
+ return if $server->{chat_type} ne "IRC";
+
+ if ($rec->{processing} > $max_queued_requests)
+ {
+ Irssi::print(
+ "%RWHOIS:%n Ignoring WHOIS request for %C$nick%n (too busy)%N"
+ ) if ($whois_debug);
+ record_reset($server, $nick);
+ return;
+ }
+
+ $server->redirect_event(
+ "whois",
+ 1,
+ $nick,
+ 0,
+ "redir autowhois_default",
+ {
+ "event 311" => "redir autowhois_realname",
+ "event 319" => "redir autowhois_channels",
+ "event 312" => "redir autowhois_server",
+ "event 301" => "redir autowhois_away",
+ "event 307" => "redir autowhois_identified",
+ "event 275" => "redir autowhois_ssl",
+ "event 310" => "redir autowhois_irchelp",
+ "event 313" => "redir autowhois_ircop",
+ "event 325" => "redir autowhois_ircbot",
+ "event 317" => "redir autowhois_idle",
+# "event 263" => "redir autowhois_busy",
+ "event 318" => "redir autowhois_end",
+ "event 401" => "redir autowhois_unknown",
+ "" => "event empty"
+ }
+ );
+
+ $rec->{processing} = $rec->{processing} + 1;
+
+ # This format requests additional information on $nick
+ # used to be: $server->send_raw("WHOIS $nick :$nick");
+ $server->send_raw("WHOIS $nick");
+
+ $rec->{nicks}->{$nick}->{timeout_job} = Irssi::timeout_add(
+ $whois_timeout,
+ \&server_whois_timeout,
+ [$server, $nick]
+ );
+}
+
+################################################################################
+
+# A whois record is built as and when server messages with info for a specific
+# user arrive. After the WHOIS END message has arrived for that user, we can
+# report the stored whois information with this function.
+sub report_stored_whois_info
+{
+ my ($server, $nick) = @_;
+ my $rec = $servers{$server->{tag}};
+
+ if (!defined($rec->{nicks}->{$nick}))
+ {
+ Irssi::print(
+ "%RWHOIS:%n Report called for undefined hash %C$nick%N"
+ ) if ($whois_debug);
+ return;
+ }
+
+ foreach my $channame (@{$rec->{nicks}->{$nick}->{queued_channels}})
+ {
+ my $chanrec = $server->channel_find($channame);
+
+ if ($chanrec)
+ {
+ $rec->{nicks}->{$nick}->{flags} =~ s/[ ]{1,}$//;
+
+ $chanrec->printformat(
+ $whois_printing_level_n,
+ 'ji_whois_success',
+ $nick,
+ $rec->{nicks}->{$nick}->{realname},
+ $rec->{nicks}->{$nick}->{channels},
+ $rec->{nicks}->{$nick}->{server},
+ $rec->{nicks}->{$nick}->{flags}
+ );
+ }
+ else
+ {
+ Irssi::print(
+ "%RWHOIS:%n chanrec not found for %W$channame%n :-(%N"
+ ) if ($whois_debug);
+ }
+ }
+
+ $rec->{nicks}->{$nick}->{queued_channels} = [];
+}
+
+################################################################################
+
+# Create an empty record for this nick on that server, we will gradually fill
+# out this record as and when we go along.
+sub record_reset
+{
+ my ($server, $nick) = @_;
+ my $rec = $servers{$server->{tag}};
+
+ if (defined($rec->{nicks}->{$nick}))
+ {
+ delete $rec->{nicks}->{$nick};
+ }
+
+ $rec->{nicks}->{$nick} =
+ {
+ record_time => time(),
+ queued_channels => [],
+ realname => "(unknown)",
+ channels => "(unknown)",
+ server => "(unknown)",
+ flags => "",
+ aborted => 0,
+ busy => 0,
+ known => 0,
+ timeout_job => 0
+ };
+}
+
+################################################################################
+
+# Sent when a user joins a channel we are on, whic is where we check if we
+# have the user info cached, if it is still valid, and if not we put
+# a WHOIS request on the server for this user and are done.
+sub event_join
+{
+ my ($server, $channame, $nick, $host) = @_;
+
+ return if $server->{chat_type} ne "IRC";
+
+ $channame =~ s/^://;
+ my $rec = $servers{$server->{tag}};
+
+ return if ($nick eq $server->{nick});
+
+ return if ($server->netsplit_find($nick, $host));
+
+ if (!defined($rec->{nicks}->{$nick}))
+ {
+ # If the nick has no requests joined yet, we will create a new
+ # empty record for the nick, so we can assume later it does
+ # exist
+ record_reset($server, $nick);
+ }
+
+ if (($rec->{nicks}->{$nick}->{known})
+ && ((time() - $rec->{nicks}->{$nick}->{record_time}) <= $whois_maxage)
+ )
+ {
+ # If we asked less than whois_maxage seconds ago for a WHOIS on this
+ # nick, we will not re-issue a request.
+ #
+ # NOTE: When a person (manually) joins multiple channels you are
+ # on, this may cause you not seeing all channels in the
+ # channel list, You can set this to something like 5
+ # seconds to reduce the probability of this happening
+ push @{$rec->{nicks}->{$nick}->{queued_channels}}, $channame;
+
+ report_stored_whois_info($server, $nick);
+ }
+ elsif ($rec->{nicks}->{$nick}->{busy} == 1)
+ {
+ # If we already issued a WHOIS request for this nick but did not
+ # receive a result yet, we just push this channel name on the
+ # list of channels that want a report when the result is known
+ push @{$rec->{nicks}->{$nick}->{queued_channels}}, $channame;
+ }
+ else
+ {
+ # Finally, we are not already processing this nick, and either
+ # we have no information for it, or the information we have is
+ # too old, so we send a WHOIS request to the server.
+ push @{$rec->{nicks}->{$nick}->{queued_channels}}, $channame;
+
+ $rec->{nicks}->{$nick}->{busy} = 1;
+
+ request_whois($server, $nick);
+ }
+}
+
+################################################################################
+
+# Implementation of the WFORCE <nick> command. Useful for testing purposes
+# only, for example to see if the theme changes you made are correct, if the
+# timeouts are interpreted properly, and if the garbage collector works
+sub cmd_joininfo_force
+{
+ my ($data, $server, $window) = @_;
+ $data =~ s/^[ ]{1,}//g;
+ $data =~ s/[ ]{1,}$//g;
+
+ if (!$server || !$server->{connected})
+ {
+ Irssi::print("Not connected.");
+ return;
+ }
+
+ if ($window->{type} ne "CHANNEL")
+ {
+ Irssi::print("Not a channel window.");
+ return;
+ }
+
+ event_join($server, $window->{name}, $data, "testuser\@test.example.com");
+}
+
+################################################################################
+
+# Event handler for the whois realname line returned by the server. When we
+# issue a whois request, we bind an event handler for whois info for that
+# nick.
+#
+# Does nothing, except for updating the record for that nick.
+sub event_whois_realname
+{
+ my ($server, $data) = @_;
+ my ($num, $nick, $user, $host, $empty, $realname) = split(/ +/, $data, 6);
+ $realname =~ s/^://;
+ my $rec = $servers{$server->{tag}};
+
+ $rec->{nicks}->{$nick}->{realname} = $realname;
+}
+
+################################################################################
+
+# Event handler for the whois channels line returned by the server. When we
+# issue a whois request, we bind an event handler for whois info for that
+# nick.
+#
+# Does nothing, except for updating the record for that nick.
+sub event_whois_channels
+{
+ my ($server, $data) = @_;
+ my ($num, $nick, $channels) = split(/ +/, $data, 3);
+ $channels =~ s/^://;
+ my $rec = $servers{$server->{tag}};
+
+ $channels =~ s/[ ]{1,}$//;
+ $rec->{nicks}->{$nick}->{channels} = $channels;
+}
+
+################################################################################
+
+# Event handler for the whois server line returned by the server. When we
+# issue a whois request, we bind an event handler for whois info for that
+# nick.
+#
+# Does nothing, except for updating the record for that nick.
+#
+# NOTE: In the default report the server is not repported, it is however
+# stored in the record, so if you need it, you can simply update the
+# reporting function to show it.
+sub event_whois_server
+{
+ my ($server, $data) = @_;
+ my ($num, $nick, $serverstr) = split(/ +/, $data, 3);
+ $serverstr =~ s/^://;
+ my $rec = $servers{$server->{tag}};
+
+ $serverstr =~ s/ :.*$//;
+
+ $rec->{nicks}->{$nick}->{server} = $serverstr;
+}
+
+################################################################################
+
+# This is the end of the whois request, all info available we should have
+# now, so we mark the record as know, not bust, timestamp it so we can
+# expire it later and we report back to the user on those channels waiting
+# for whois info for nick
+#
+# Note that a No Such Nick error is not always followed by a WHOIS END.
+# hyb7-based servers interpret the RFC differently from for example hyb6
+# and the IRCNet servers and will not send the WHOIS END line, but just
+# the No Such Nick error (401).
+sub event_whois_end
+{
+ my($server, $data) = @_;
+ my ($num, $nick, $serverstr) = split(/ +/, $data, 3);
+ my $rec = $servers{$server->{tag}};
+
+ $rec->{nicks}->{$nick}->{record_time} = time();
+ $rec->{nicks}->{$nick}->{known} = 1;
+ $rec->{nicks}->{$nick}->{busy} = 0;
+
+ if (!$rec->{nicks}->{$nick}->{aborted})
+ {
+ $rec->{processing} = $rec->{processing} - 1;
+ }
+
+ report_stored_whois_info($server, $nick);
+}
+
+################################################################################
+
+# Some servers (hyb7) do not send an end of whois when the nick is
+# not known, they just send a 401 unknown message. Ircnet sends both, hyb6
+# sends both, but other servers seem to interpret the RFC differently. We
+# just treat this event_whois_unknown as a 318 tag, and mark the lookup
+# aborted (which it is in some way)
+sub event_whois_unknown
+{
+ my($server, $data) = @_;
+ my ($num, $nick, $serverstr) = split(/ +/, $data, 3);
+ my $rec = $servers{$server->{tag}};
+
+ # Fill out the record with some bogus information, so when we
+ # end up reporting it, we can at least see what is going on.
+ $rec->{nicks}->{$nick}->{record_time} = time();
+ $rec->{nicks}->{$nick}->{known} = 1;
+ $rec->{nicks}->{$nick}->{busy} = 0;
+ $rec->{nicks}->{$nick}->{realname} = "(unknown)";
+ $rec->{nicks}->{$nick}->{channels} = "(unknown)";
+ $rec->{nicks}->{$nick}->{server} = "(unknown)";
+ $rec->{nicks}->{$nick}->{flags} = "(unknown)";
+
+ if (!$rec->{nicks}->{$nick}->{aborted})
+ {
+ $rec->{processing} = $rec->{processing} - 1;
+ $rec->{nicks}->{$nick}->{aborted} = 1;
+ }
+
+ report_stored_whois_info($server, $nick);
+}
+
+################################################################################
+
+# If the server is busy
+sub event_whois_busy
+{
+ my($server, $data) = @_;
+ my($num, $nick, $serverstr) = split(/ +/, $data, 3);
+ my($rec) = $servers{$server->{tag}};
+
+ Irssi::print("******************* SERVER BUSY *******************************");
+}
+
+################################################################################
+
+# No clue what this is for, maybe I should read the irssi documentation
+# (if it existed....)
+#
+# Judging from the debug output this function is never called.
+sub event_whois_default
+{
+ my($server, $nick) = @_;
+ my $rec = $servers{$server->{tag}};
+
+ Irssi::print(
+ "%RWHOIS:%n Got event_whois_default, ignoring."
+ ) if ($whois_debug);
+}
+
+################################################################################
+
+# Some chat networks support extra falgs for their users and display those
+# in WHOIS results. The following fields allow this information to be
+# stored in the channel records and to be displayed as well.
+
+sub event_whois_away
+{
+ my ($server, $data) = @_;
+ my $rec = $servers{$server->{tag}};
+ my ($num, $nick, $msg) = split(/ +/, $data, 3);
+ $msg =~ s/^://;
+ $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."Away ";
+}
+
+################################################################################
+
+sub event_whois_identified
+{
+ my ($server, $data) = @_;
+ my $rec = $servers{$server->{tag}};
+ my ($num, $nick, $msg) = split(/ +/, $data, 3);
+ $msg =~ s/^://;
+ $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."NickREG ";
+}
+
+################################################################################
+
+sub event_whois_ssl
+{
+ my ($server, $data) = @_;
+ my $rec = $servers{$server->{tag}};
+ my ($num, $nick, $msg) = split(/ +/, $data, 3);
+ $msg =~ s/^://;
+ $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."SSL ";
+}
+
+################################################################################
+
+sub event_whois_irchelp
+{
+ my ($server, $data) = @_;
+ my $rec = $servers{$server->{tag}};
+ my ($num, $nick, $msg) = split(/ +/, $data, 3);
+ $msg =~ s/^://;
+ $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."IrcHELP ";
+}
+
+################################################################################
+
+sub event_whois_ircop
+{
+ my ($server, $data) = @_;
+ my $rec = $servers{$server->{tag}};
+ my ($num, $nick, $msg) = split(/ +/, $data, 3);
+ $msg =~ s/^://;
+ $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."IrcOP ";
+}
+
+################################################################################
+
+sub event_whois_ircbot
+{
+ my ($server, $data) = @_;
+ my $rec = $servers{$server->{tag}};
+ my ($num, $nick, $msg) = split(/ +/, $data, 3);
+ $msg =~ s/^://;
+ $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."IrcBOT ";
+}
+
+################################################################################
+
+sub number_to_timestr
+{
+ my($number) = @_;
+ my ($result) = "";
+
+ # Force integer
+ $number = 1 * $number;
+
+ my($days) = $number / 86400;
+ $number = $number % 86400;
+ my($hours) = $number / 3600;
+ $number = $number % 3600;
+ my($minutes) = $number / 60;
+ $number = $number % 60;
+ my($seconds) = $number;
+
+ if ($days) { $result = $result . "${days}d"; }
+ if ($hours || $result) { $result = $result . "${hours}h"; }
+ if ($minutes || $result) { $result = $result . "${minutes}m"; }
+ $result = $result . "${seconds}s";
+
+ return $result;
+}
+
+################################################################################
+
+sub event_whois_idle
+{
+ my ($server, $data) = @_;
+ my $rec = $servers{$server->{tag}};
+ my ($num, $nick, $msg) = split(/ +/, $data, 3);
+ $msg =~ s/^://;
+
+ if ($msg =~ /^([0-9]{1,}) ([0-9]{1,}) :.*$/)
+ {
+ my($idle) = 1 * $1;
+ my($signon) = 1 * $2;
+
+ $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}
+ . "Idle=" . number_to_timestr($idle). " ";
+ }
+ elsif ($msg =~ /^([0-9]{1,}) :.*$/)
+ {
+ my($idle) = 1 * $1;
+
+ $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}
+ . "Idle=" . number_to_timestr($idle). " ";
+ }
+ else
+ {
+ $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."SameSRV ";
+ }
+}
+
+################################################################################
+
+# Initializes a server record for the autowhois. Either called when a server
+# does connect to the network, or on script load for all connected servers at
+# that time
+sub event_connected
+{
+ my($server) = @_;
+
+ $servers{$server->{tag}} = {
+ processing => 0, # waiting reply for WHOIS request
+ nicks => {} # nick => [ #chan1, #chan2, .. ]
+ };
+}
+
+################################################################################
+
+# Deletes a server record for the autowhois. We do this on disconnect
+sub event_disconnected
+{
+ my($server) = @_;
+
+ delete $servers{$server->{tag}};
+}
+
+################################################################################
+
+# Implementation of what I call the /JOININFO umbrella command. Below
+# we bind all subcommands for this command already, so all we need to
+# do is hand off the event to irssi again so it can call the right
+# implementation function for it.
+sub cmd_joininfo
+{
+ my ($data, $server, $item) = @_;
+ $data =~ s/\s+$//g;
+ Irssi::command_runsub ('joininfo', $data, $server, $item);
+}
+
+################################################################################
+
+# Shows help
+sub cmd_joininfo_help
+{
+ Irssi::print( <<EOF
+
+JOININFO FORCE <nick>
+JOININFO GC
+JOININFO INFO
+JOININFO HELP
+
+JOININFO FORCE <nick>
+ Fakes the join of a certain nick to the channel, and shows you
+ what the WHOIS line would look like.
+JOININFO GC
+ Forces running the garbage collector once
+JOININFO INFO
+ Shows the WHOIS cache as it exists. Note that records in the cache
+ may be outdated but not deleted yet by the garbage collector
+JOININFO HELP
+ This page
+
+Example:
+ JOININFO FORCE ichiban
+
+Settings:
+ Use /SET to change whois_expire_time, whois_max_requests,
+ whois_timeout_ms, whois_gc_interval_ms, whois_debug, or
+ whois_printing_level
+
+These settings:
+ Use /FORMAT to change ji_whois_success, ji_whois_list_header,
+ ji_whois_list_nick, or ji_whois_list_status
+
+Note: If you want to hilight certain channels in the output, just use
+/HILIGHT -level JOINS #channel
+
+See also: HILIGHT
+EOF
+ , MSGLEVEL_CLIENTCRAP);
+}
+
+################################################################################
+
+# Tegister messages for /FORMAT and theme support
+register_messages();
+
+# Register settings for /SET support
+register_settings();
+
+# Load the previously stored settings from the config file, will be called
+# again later each time the settings change
+load_settings();
+
+################################################################################
+
+# Mark all currently connected servers as connected
+foreach my $server (Irssi::servers())
+{
+ event_connected($server);
+}
+
+################################################################################
+
+# Add and register our signal handlers
+Irssi::signal_add(
+{ 'server connected' => \&event_connected,
+ 'server disconnected' => \&event_disconnected,
+ 'message join' => \&event_join,
+ 'redir autowhois_realname' => \&event_whois_realname,
+ 'redir autowhois_channels' => \&event_whois_channels,
+ 'redir autowhois_server' => \&event_whois_server,
+ 'redir autowhois_away' => \&event_whois_away,
+ 'redir autowhois_identified' => \&event_whois_identified,
+ 'redir autowhois_ssl' => \&event_whois_ssl,
+ 'redir autowhois_irchelp' => \&event_whois_irchelp,
+ 'redir autowhois_ircop' => \&event_whois_ircop,
+ 'redir autowhois_ircbot' => \&event_whois_ircbot,
+ 'redir autowhois_idle' => \&event_whois_idle,
+ 'redir autowhois_end' => \&event_whois_end,
+ 'redir autowhois_unknown' => \&event_whois_unknown,
+ 'redir autowhois_busy' => \&event_whois_busy,
+ 'setup changed' => \&load_settings }
+);
+
+################################################################################
+
+# Schedule the garbase collector to run every whois_gc_interval ms
+Irssi::timeout_add(
+ $whois_gc_interval,
+ \&aw_gc_scheduler,
+ 0
+);
+
+################################################################################
+
+# OLD STYLE COMMANDS ARE DISABLED AND REPLACED BY /JOININFO WITH SUB-COMMANDS
+# Bind the /AWFORCE, /AWGC and /AWINFO commands. Uncomment the next three lines
+# if you would like to keep the old-style commands
+### Irssi::command_bind("awforce", "cmd_joininfo_force");
+### Irssi::command_bind("awgc", "garbage_collector");
+### Irssi::command_bind("awinfo", "cmd_joininfo_info");
+
+Irssi::command_bind("joininfo force", \&cmd_joininfo_force);
+Irssi::command_bind("joininfo gc", \&garbage_collector);
+Irssi::command_bind("joininfo info", \&cmd_joininfo_info);
+Irssi::command_bind("joininfo help", \&cmd_joininfo_help);
+Irssi::command_bind("joininfo", \&cmd_joininfo);
+
+################################################################################
+### EOF
diff --git a/scripts/kban-referrals.pl b/scripts/kban-referrals.pl
new file mode 100644
index 0000000..2283f76
--- /dev/null
+++ b/scripts/kban-referrals.pl
@@ -0,0 +1,372 @@
+# KBan-Referrals
+#
+# A script that kickban users who post referral URLs. It can operate in paranoid mode or normal mode.
+# In paranoid mode, any user posting in his message a URL that does not match a site in the whitelist will be kickbanned.
+# In normal mode, the URL will be checked against a blacklist first, then the user will only get kickbanned
+# if his URL doesn't match a site in the whitelist and he meets some criterion that identifies referral URLs.
+#
+# Usage
+#
+# /kbanref is the command name of the script.
+# Typing '/kbanref' will only enumerate the sub-commands of the script.
+# Typing '/kbanref help' will list all the sub-commands with a short explanation for each.
+#
+use strict;
+use warnings;
+
+use vars qw($VERSION %IRSSI);
+
+use Irssi qw(command_bind signal_add signal_add_first settings_add_str settings_get_str settings_set_str);
+
+our $VERSION = '1.04';
+our %IRSSI = (authors => 'Linostar',
+ contact => 'linostar@sdf.org',
+ name => 'KickBan Referrals Script',
+ description => 'Script for kickbanning those who post referral links in a channel',
+ commands => 'kbanref',
+ license => 'New BSD');
+
+our %tickets = ();
+
+sub kbanref {
+ my ($data, $server, $witem) = @_;
+ my $mode = settings_get_str('kbanreferrals_mode');
+ my $chans = settings_get_str('kbanreferrals_channels');
+ my $whitelist = settings_get_str('kbanreferrals_whitelist');
+ my $blacklist = settings_get_str('kbanreferrals_blacklist');
+ my $stripped = '';
+ my $thelist;
+ my $subcommand = '';
+ my ($command, @args) = split(/\s+/, $data);
+ $command='' unless (defined $command);
+ $command = lc($command);
+ $_ = lc for @args; #apply lc to all elements in @args
+ $subcommand = $args[0] if ($args[0]);
+ # mode command
+ if ($command eq 'mode') {
+ $subcommand = 'get' unless ($subcommand);
+ if ($subcommand eq 'get') {
+ print('KBan-Referrals: current mode is set to ' . uc(settings_get_str('kbanreferrals_mode')) . '.');
+ }
+ elsif ($subcommand eq 'normal') {
+ settings_set_str('kbanreferrals_mode', 'normal');
+ print('KBan-Referrals: mode set to NORMAL. Whitelist and Blacklist will be used, along with a somewhat smart referral URL detection.');
+ }
+ elsif ($subcommand eq 'paranoid') {
+ settings_set_str('kbanreferrals_mode', 'paranoid');
+ print('KBan-Referrals: mode set to PARANOID. Every URL that does not match a website in the whitelist will trigger a kickban.');
+ }
+ else {
+ print('KBan-Referrals: invalid mode. Available modes are NORMAL and PARANOID.');
+ }
+ }
+ # whitelist or blacklist add command
+ elsif ($command =~ m/^(white|black)list$/ && $subcommand eq 'add') {
+ my $newlist = '';
+ my $type = substr($command, 0, 5);
+ if ($type eq 'black') {
+ $thelist = \$blacklist;
+ }
+ else {
+ $thelist = \$whitelist;
+ }
+ my @list_arr = split(/\s+/, lc($$thelist));
+ splice(@args, 0, 1);
+ foreach my $i (@args) {
+ if (grep {$i eq $_} @list_arr) {
+ print("KBan-Referrals: site $i is already in the list.");
+ }
+ else {
+ $newlist .= ' ' . $i;
+ }
+ }
+ if ($newlist && $newlist !~ m/^\s+$/) {
+ $$thelist .= $newlist;
+ print('KBan-Referrals: the following sites were added to ' . $type . 'list:');
+ print($newlist);
+ if ($type eq 'black') {
+ settings_set_str('kbanreferrals_blacklist', $$thelist);
+ }
+ else {
+ settings_set_str('kbanreferrals_whitelist', $$thelist);
+ }
+ }
+ else {
+ print('KBan-Referrals: no new sites were added to ' . $type . 'list.');
+ }
+ }
+ # whitelist or blacklist remove command
+ elsif ($command =~ m/^(white|black)list$/ && $subcommand eq 'remove') {
+ my $rmlist = '';
+ my $type = substr($command, 0, 5);
+ if ($type eq 'black') {
+ $thelist = \$blacklist;
+ }
+ else {
+ $thelist = \$whitelist;
+ }
+ my @list_arr = split(/\s+/, lc($$thelist));
+ splice(@args, 0, 1);
+ foreach my $i (@args) {
+ unless (grep {$i eq $_} @list_arr) {
+ print("KBan-Referrals: site $i is not in " . $type . 'list.');
+ }
+ else {
+ $rmlist .= ' ' . $i;
+ $$thelist =~ s/(\s|^)$i(\s|$)/ /i;
+ }
+ }
+ $$thelist =~ s/\s{2,}/ /g;
+ if ($rmlist && $rmlist !~ m/^\s+$/) {
+ print('KBan-Referrals: the following sites were removed from ' . $type . 'list:');
+ print($rmlist);
+ if ($type eq 'black') {
+ settings_set_str('kbanreferrals_blacklist', $$thelist);
+ }
+ else {
+ settings_set_str('kbanreferrals_whitelist', $$thelist);
+ }
+ }
+ else {
+ print('KBan-Referrals: no sites were removed from ' . $type . 'list.');
+ }
+ }
+ # whitelist or blacklist list command
+ elsif ($command =~ m/^(white|black)list$/ && $subcommand eq 'list') {
+ print('KBan-Referrals ' . $1 . 'list:');
+ if ($1 eq 'black') {
+ $thelist = \$blacklist;
+ }
+ else {
+ $thelist = \$whitelist;
+ }
+ foreach (split(/\s+/, $$thelist)) {
+ print($_) if ($_);
+ }
+ }
+ # whitelist or blacklist clear command
+ elsif ($command =~ m/^(white|black)list$/ && $subcommand eq 'clear') {
+ print('KBan-Referrals: ' . $1 . 'list is cleared.');
+ if ($1 eq 'black') {
+ settings_set_str('kbanreferrals_blacklist', '');
+ }
+ else {
+ settings_set_str('kbanreferrals_whitelist', '');
+ }
+ }
+ # chan add command
+ elsif ($command eq 'chan' && $subcommand eq 'add') {
+ my $newchans = '';
+ my $ch = '';
+ my @chans_arr = split(/\s+/, lc($chans));
+ splice(@args, 0, 1);
+ foreach(@args) {
+ $ch = (substr($_, 0, 1) eq '#') ? $_ : '#' . $_;
+ if (grep {$ch eq $_} @chans_arr) {
+ print("KBan-Referrals: channel $ch is already in the list.");
+ }
+ else {
+ $newchans .= ' ' . $ch;
+ }
+ }
+ if ($newchans && $newchans !~ m/^\s+$/) {
+ settings_set_str('kbanreferrals_channels', $chans . $newchans);
+ print('KBan-Referrals: the following channels were added the list:');
+ print($newchans);
+ }
+ else {
+ print('KBan-Referrals: no new channels were added to the list.');
+ }
+ }
+ # chan remove command
+ elsif ($command eq 'chan' && $subcommand eq 'remove') {
+ my $rmchans = '';
+ my $ch = '';
+ my @chans_arr = split(/\s+/, lc($chans));
+ splice(@args, 0, 1);
+ foreach (@args) {
+ $ch = (substr($_, 0, 1) eq '#') ? $_ : '#' . $_;
+ unless (grep {$ch eq $_} @chans_arr) {
+ print("KBan-Referrals: channel $ch is not in the list.");
+ next;
+ }
+ else {
+ $rmchans .= ' ' . $ch;
+ $chans =~ s/(\s|^)($ch)(\s|$)/ /i;
+ }
+ }
+ $chans =~ s/\s{2,}/ /g; #remove extra spaces
+ if ($rmchans && $rmchans !~ m/^\s+$/) {
+ settings_set_str('kbanreferrals_channels', $chans);
+ print('KBan-Referrals: the following channels were removed from the list:');
+ print($rmchans);
+ }
+ else {
+ print('KBan-Referrals: no channels were removed from the list.');
+ }
+ }
+ # chan list command
+ elsif ($command eq 'chan' && $subcommand eq 'list') {
+ print('KBan-Referrals Channel List:');
+ foreach (split(/\s+/, $chans)) {
+ print($_) if ($_);
+ }
+ }
+ # chan clear command
+ elsif ($command eq 'chan' && $subcommand eq 'clear') {
+ settings_set_str('kbanreferrals_channels', '');
+ print('KBan-Referrals: channel list cleared.');
+ }
+ # help command
+ elsif ($command eq 'help') {
+ print('KBan-Referrals Command Syntax (case insensitive):');
+ print('-------------------------------------------------');
+ print('Change KBan-Referrals mode: /KBANREF MODE [normal|paranoid]');
+ print('Add channel(s) to the list: /KBANREF CHAN ADD #channel1 [#channel2 ...]');
+ print('Remove channel(s) from the list: /KBANREF CHAN REMOVE #channel1 [#channel2 ...]');
+ print('List all channels: /KBANREF CHAN LIST');
+ print('Clear all channels from the list: /KBANREF CHAN CLEAR');
+ print('Add site(s) to blacklist or whitelist: /KBANREF BLACKLIST|WHITELIST ADD site1.com [site2.com ...]');
+ print('Remove site(s) from blacklist or whitelist: /KBANREF BLACKLIST|WHITELIST REMOVE site1.com [site2.com ...]');
+ print('List all sites in blacklist or whitelist: /KBANREF BLACKLIST|WHITELIST LIST');
+ print('Clear blacklist or whitelist: /KBANREF BLACKLIST|WHITELIST CLEAR');
+ print('Show this help message: /KBANREF HELP');
+ }
+ # invalid command
+ else {
+ print("Invalid command. Available commands are: HELP, MODE, CHAN ADD, CHAN REMOVE, CHAN LIST, CHAN CLEAR, WHITELIST ADD, WHITELIST REMOVE, WHITELIST LIST, WHITELIST CLEAR, BLACKLIST ADD, BLACKLIST REMOVE, BLACKLIST LIST, BLACKLIST CLEAR.");
+ }
+}
+
+# check if message contains a url
+sub contains_url {
+ my ($line) = @_;
+ return 1 if ($line =~ m/(http|https)(:\/\/)[a-z0-9-]+(\.[a-z0-9-])+/i);
+ return 1 if ($line =~ m/(www)(\.[a-z0-9-]+){2,}/i);
+ return 0;
+}
+
+# sub for carrying out ban & kick irc commands
+sub kb {
+ my ($server, $target, $nick, $addr) = @_;
+ $addr =~ /(\S+)@(\S+)/i;
+ $server->command("mode $target +b " . '*!*@' . "$2");
+ $server->command("kick $target $nick " . 'Referral URLs are not allowed!');
+}
+
+# sub for carrying out ban irc commands
+sub ban {
+ my ($server, $target, $nick, $addr) = @_;
+ $addr =~ /(\S+)@(\S+)/i;
+ $server->command("mode $target +b " . '*!*@' . "$2");
+}
+
+# sub for taking kickban action against url referrals
+sub kban_action {
+ my ($server, $msg, $nick, $nick_addr, $target) = @_;
+ my $mode = settings_get_str('kbanreferrals_mode');
+ my $whitelist = settings_get_str('kbanreferrals_whitelist');
+ my $blacklist = settings_get_str('kbanreferrals_blacklist');
+ my $chans = settings_get_str('kbanreferrals_channels');
+ my @chans_arr = split(/\s+/, lc($chans));
+ $mode = 'normal' unless ($mode eq 'paranoid');
+ # add a high ticket value to users who post messages without urls so they don't get punished
+ my $con_url=contains_url($msg);
+ $tickets{ $nick . $target } += 10 if
+ (exists($tickets{ $nick . $target }) &&
+ (grep {$target eq $_} @chans_arr) && !$con_url );
+ # otherwise, start the real investigation
+ if ((grep {$target eq $_} @chans_arr) && $con_url) {
+ # paranoid mode
+ if ($mode =~ m/^paranoid$/i) {
+ my $bad = 1;
+ foreach (split(/\s+/, $whitelist)) {
+ if ($msg =~ m/$_/i) {
+ $bad = 0;
+ last;
+ }
+ }
+ kb($server, $target, $nick, $nick_addr) if ($bad);
+ }
+ # normal mode
+ elsif ($mode =~ m/^normal$/i) {
+ # if it is in the blacklist, always ban and stop here
+ my $stop = 0;
+ foreach (split(/\s+/, $blacklist)) {
+ if ($msg =~ m/$_/i) {
+ kb($server, $target, $nick, $nick_addr);
+ $stop = 1;
+ last;
+ }
+ }
+ if (!$stop) {
+ # otherwise, if it is in the whitelist, don't ban and stop here
+ foreach (split(/\s+/, $whitelist)) {
+ if ($msg =~ m/$_/i) {
+ $stop = 1;
+ last;
+ }
+ }
+ }
+ if (!$stop) {
+ # here lies the supposedly smart method to detect url referral posters
+ my $culprit = 0;
+ $culprit = 1 if ($msg =~ m/[\/\?&]ref=/i);
+ kb($server, $target, $nick, $nick_addr) if ($culprit);
+ $tickets{ $nick . $target } += 1 if (exists($tickets{ $nick . $target }) && !$culprit);
+ }
+ }
+ }
+}
+
+# this and 'increase_ticket' are used to distinguish users who join, post a url, and leave
+sub ticket_start {
+ my ($server, $channel, $nick, $nick_addr) = @_;
+ my $chans = settings_get_str('kbanreferrals_channels');
+ my @chans_arr = split(/\s+/, lc($chans));
+ if (grep {$channel eq $_} @chans_arr) {
+ $tickets{ $nick . $channel } = 1;
+ }
+}
+
+sub increase_ticket {
+ my ($server, $channel, $nick, $nick_addr, $reason) = @_;
+ my $chans = settings_get_str('kbanreferrals_channels');
+ my @chans_arr = split(/\s+/, lc($chans));
+ if (exists($tickets{ $nick . $channel }) && (grep {$channel eq $_} @chans_arr)) {
+ # if the poor bastard only posted one sole message containing a url before leaving
+ # then it's probably a referral url, so ban him/her
+ if ($tickets{ $nick . $channel } == 2) {
+ ban($server, $channel, $nick, $nick_addr);
+ }
+ delete $tickets{ $nick . $channel };
+ }
+}
+
+settings_add_str('kbanreferrals', 'kbanreferrals_mode' => 'normal');
+settings_add_str('kbanreferrals', 'kbanreferrals_channels' => '');
+settings_add_str('kbanreferrals', 'kbanreferrals_blacklist' => '');
+settings_add_str('kbanreferrals', 'kbanreferrals_whitelist' => 'pastebin.com');
+signal_add('message public', 'kban_action');
+signal_add('message join', 'ticket_start');
+signal_add('message part', 'increase_ticket');
+command_bind(kbanref => \&kbanref);
+command_bind('kbanref mode', \&kbanref);
+command_bind('kbanref help', \&kbanref);
+command_bind('kbanref chan', \&kbanref);
+command_bind('kbanref chan add', \&kbanref);
+command_bind('kbanref chan remove', \&kbanref);
+command_bind('kbanref chan list', \&kbanref);
+command_bind('kbanref chan clear', \&kbanref);
+command_bind('kbanref whitelist', \&kbanref);
+command_bind('kbanref whitelist add', \&kbanref);
+command_bind('kbanref whitelist remove', \&kbanref);
+command_bind('kbanref whitelist list', \&kbanref);
+command_bind('kbanref whitelist clear', \&kbanref);
+command_bind('kbanref blacklist', \&kbanref);
+command_bind('kbanref blacklist add', \&kbanref);
+command_bind('kbanref blacklist remove', \&kbanref);
+command_bind('kbanref blacklist list', \&kbanref);
+command_bind('kbanref blacklist clear', \&kbanref);
+
+# vim:set ts=2 sw=2 expandtab:
diff --git a/scripts/kblamehost.pl b/scripts/kblamehost.pl
new file mode 100644
index 0000000..3cd626c
--- /dev/null
+++ b/scripts/kblamehost.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.0.2";
+%IRSSI = (
+ authors => 'Filippo \'godog\' Giunchedi',
+ contact => 'filippo\@esaurito.net',
+ name => 'kblamehost',
+ description => 'Kicks (and bans) people with >= 4 dots in theirs hostname',
+ license => 'GNU GPLv2 or later',
+ url => 'http://esaurito.net',
+);
+
+# TODO
+# add ban support
+
+# all settings are space-separated
+Irssi::settings_add_str('misc','kblamehost_channels',''); # channels with kicklamehost enabled
+Irssi::settings_add_str('misc','kblamehost_exclude',''); # regexps with hostnames excluded
+Irssi::settings_add_str('misc','kblamehost_dots','4'); # dots >= an host will be marked as lame
+Irssi::settings_add_str('misc','kblamehost_kickmsg','Lame host detected, change it please!'); # on-kick message
+Irssi::settings_add_str('misc','kblamehost_ban','0'); # should we ban that lame host?
+
+sub event_join
+{
+ my ($channel, $nicksList) = @_;
+ my @nicks = @{$nicksList};
+ my $server = $channel->{'server'};
+ my $channelName = $channel->{name};
+ my $channel_enabled = 0;
+ my @channels = split(/ /,Irssi::settings_get_str('kblamehost_channels'));
+ my @excludes = split(/ /,Irssi::settings_get_str('kblamehost_exclude'));
+
+ foreach (@channels)
+ {
+ $channel_enabled = 1 if($_ eq $channelName);
+ }
+
+ foreach (@nicks)
+ {
+ my $hostname = substr($_->{host},index($_->{host},'@')+1);
+ my @dots = split(/\./,$hostname); # yes i know, it's the number on fields in
+ # hostname, but array counts from 0 so element's count is number of dots
+ my $is_friend = 0;
+
+ foreach my $exclude (@excludes)
+ {
+ $is_friend = 1 if ($hostname =~ $exclude);
+ }
+
+ if( $#dots >= Irssi::settings_get_str('kblamehost_dots') && $channel_enabled == 1 && $is_friend == 0)
+ {
+ # Irssi::print("lamehost ($hostname) by $_->{nick} detected on $channelName, kicking...");
+ $server->command("kick $channelName $_->{nick} "
+ .Irssi::settings_get_str('kblamehost_kickmsg'));
+ $server->command("ban $channelName $_->{nick}") if ( Irssi::settings_get_str('kblamehost_ban') );
+ }
+ }
+}
+
+Irssi::signal_add_last("massjoin", "event_join");
diff --git a/scripts/keepnick.pl b/scripts/keepnick.pl
new file mode 100644
index 0000000..5eb40f2
--- /dev/null
+++ b/scripts/keepnick.pl
@@ -0,0 +1,387 @@
+#
+# Copyright (C) 2001-2021 by Peder Stray <peder.stray@gmail.com>
+#
+
+use strict;
+use Irssi 20011118.1727;
+use Irssi::Irc;
+
+use vars qw{$VERSION %IRSSI};
+($VERSION) = '$Revision: 1.19.1 $' =~ / (\d+(\.\d+)+) /;
+%IRSSI = (
+ name => 'keepnick',
+ authors => 'Peder Stray',
+ contact => 'peder.stray@gmail.com',
+ url => 'https://github.com/pstray/irssi-keepnick',
+ license => 'GPL',
+ description => 'Try to get your nick back when it becomes available.',
+ );
+
+my(%keepnick); # nicks we want to keep
+my(%getnick); # nicks we are currently waiting for
+my(%inactive); # inactive chatnets
+my(%manual); # manual nickchanges
+
+sub change_nick {
+ my($server,$nick) = @_;
+ $server->redirect_event('keepnick nick', 1, ":$nick", -1, undef,
+ {
+ "event nick" => "redir keepnick nick",
+ "" => "event empty",
+ });
+ $server->send_raw("NICK :$nick");
+}
+
+sub check_nick {
+ my($server,$net,$nick);
+
+ %getnick = (); # clear out any old entries
+
+ for $net (keys %keepnick) {
+ next if $inactive{$net};
+ $server = Irssi::server_find_chatnet($net);
+ next unless $server;
+ next if lc $server->{nick} eq lc $keepnick{$net};
+
+ $getnick{$net} = $keepnick{$net};
+ }
+
+ for $net (keys %getnick) {
+ $server = Irssi::server_find_chatnet($net);
+ next unless $server;
+ next unless ref($server) eq 'Irssi::Irc::Server'; # this only work on IRC
+ $nick = $getnick{$net};
+ if (lc $server->{nick} eq lc $nick) {
+ delete $getnick{$net};
+ next;
+ }
+ $server->redirect_event('keepnick ison', 1, '', -1, undef,
+ { "event 303" => "redir keepnick ison" });
+ $server->send_raw("ISON :$nick");
+ }
+}
+
+sub load_nicks {
+ my($file) = Irssi::get_irssi_dir."/keepnick";
+ my($count) = 0;
+ local(*CONF);
+
+ %keepnick = ();
+ open CONF, "<", $file;
+ while (<CONF>) {
+ my($net,$nick) = split;
+ if ($net && $nick) {
+ $keepnick{lc $net} = $nick;
+ $count++;
+ }
+ }
+ close CONF;
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
+ "Loaded $count nicks from $file");
+}
+
+sub save_nicks {
+ my($auto) = @_;
+ my($file) = Irssi::get_irssi_dir."/keepnick";
+ my($count) = 0;
+ local(*CONF);
+
+ return if $auto && !Irssi::settings_get_bool('keepnick_autosave');
+
+ open CONF, ">", $file;
+ for my $net (sort keys %keepnick) {
+ print CONF "$net\t$keepnick{$net}\n";
+ $count++;
+ }
+ close CONF;
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
+ "Saved $count nicks to $file")
+ unless $auto;
+}
+
+sub server_printformat {
+ my($server,$level,$format,@params) = @_;
+ my($emitted) = 0;
+ for my $win (Irssi::windows) {
+ for my $item ($win->items) {
+ next unless ref $item;
+ if ($item->{server}{chatnet} eq $server->{chatnet}) {
+ $item->printformat($level,$format,@params);
+ $emitted++;
+ last;
+ }
+ }
+ }
+ $server->printformat(undef,$level,$format,@params)
+ unless $emitted;
+}
+
+# if anyone changes their nick, check if we want their old one.
+sub sig_message_nick {
+ my($server,$newnick,$oldnick) = @_;
+ my($chatnet) = lc $server->{chatnet};
+ if (lc $oldnick eq lc $getnick{$chatnet}) {
+ change_nick($server, $getnick{$chatnet});
+ }
+}
+
+# if we change our nick, check it to see if we wanted it and if so
+# remove it from the list.
+sub sig_message_own_nick {
+ my($server,$newnick,$oldnick) = @_;
+ my($chatnet) = lc $server->{chatnet};
+ if (lc $newnick eq lc $keepnick{$chatnet}) {
+ delete $getnick{$chatnet};
+ if ($inactive{$chatnet}) {
+ delete $inactive{$chatnet};
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_unhold',
+ $newnick, $chatnet);
+ }
+ } elsif (lc $oldnick eq lc $keepnick{$chatnet} &&
+ lc $newnick eq lc $manual{$chatnet}) {
+ $inactive{$chatnet} = 1;
+ delete $getnick{$chatnet};
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_hold',
+ $oldnick, $chatnet);
+ }
+}
+
+sub sig_message_own_nick_block {
+ my($server,$new,$old,$addr) = @_;
+ Irssi::signal_stop();
+ if (Irssi::settings_get_bool('keepnick_quiet')) {
+ Irssi::printformat(MSGLEVEL_NICKS | MSGLEVEL_NO_ACT,
+ 'keepnick_got_nick', $new, $server->{chatnet});
+ } else {
+ server_printformat($server, MSGLEVEL_NICKS | MSGLEVEL_NO_ACT,
+ 'keepnick_got_nick', $new, $server->{chatnet});
+ }
+}
+
+# if anyone quits, check if we want their nick.
+sub sig_message_quit {
+ my($server,$nick) = @_;
+ my($chatnet) = lc $server->{chatnet};
+ if (lc $nick eq lc $getnick{$chatnet}) {
+ change_nick($server, $getnick{$chatnet});
+ }
+}
+
+sub sig_redir_keepnick_ison {
+ my($server,$text) = @_;
+ my $nick = $getnick{lc $server->{chatnet}};
+ change_nick($server, $nick)
+ unless $text =~ /:\Q$nick\E\s?$/i;
+}
+
+sub sig_redir_keepnick_nick {
+ my($server,$args,$nick,$addr) = @_;
+ Irssi::signal_add_first('message own_nick', 'sig_message_own_nick_block');
+ Irssi::signal_emit('event nick', @_);
+ Irssi::signal_remove('message own_nick', 'sig_message_own_nick_block');
+}
+
+# main setup is reread, so let us do it too
+sub sig_setup_reread {
+ load_nicks;
+}
+
+# main config is saved, and so we should save too
+sub sig_setup_save {
+ my($mainconf,$auto) = @_;
+ save_nicks($auto);
+}
+
+# Usage: /KEEPNICK [-net <chatnet>] [<nick>]
+sub cmd_keepnick {
+ my(@params) = split " ", shift;
+ my($server) = @_;
+ my($chatnet,$nick,@opts);
+
+ # parse named parameters from the parameterlist
+ while (@params) {
+ my($param) = shift @params;
+ if ($param =~ /^-(chat|irc)?net$/i) {
+ $chatnet = shift @params;
+ } elsif ($param =~ /^-/) {
+ Irssi::print("Unknown parameter $param");
+ } else {
+ push @opts, $param;
+ }
+ }
+ $nick = shift @opts;
+
+ # check if the ircnet specified (if any) is valid, and if so get the
+ # server for it
+ if ($chatnet) {
+ my($cn) = Irssi::chatnet_find($chatnet);
+ unless ($cn) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
+ "Unknown chat network: $chatnet");
+ return;
+ }
+ $chatnet = $cn->{name};
+ $server = Irssi::server_find_chatnet($chatnet);
+ }
+
+ # if we need a server, check if the one we got is connected.
+ unless ($server || ($nick && $chatnet)) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
+ "Not connected to server");
+ return;
+ }
+
+ # lets get the chatnet, and the nick we want
+ $chatnet ||= $server->{chatnet};
+ $nick ||= $server->{nick};
+
+ # check that we really have a chatnet
+ unless ($chatnet) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
+ "Unable to find server network, maybe you forgot /server add before connecting?");
+ return;
+ }
+
+ if ($inactive{lc $chatnet}) {
+ delete $inactive{lc $chatnet};
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_unhold',
+ $nick, $chatnet);
+ }
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_add', $nick,
+ $chatnet);
+
+ $keepnick{lc $chatnet} = $nick;
+
+ save_nicks(1);
+ check_nick();
+}
+
+# Usage: /UNKEEPNICK [<chatnet>]
+sub cmd_unkeepnick {
+ my($chatnet,$server) = @_;
+
+ # check if the ircnet specified (if any) is valid, and if so get the
+ # server for it
+ if ($chatnet) {
+ my($cn) = Irssi::chatnet_find($chatnet);
+ unless ($cn) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
+ "Unknown chat network: $chatnet");
+ return;
+ }
+ $chatnet = $cn->{name};
+ } else {
+ $chatnet = $server->{chatnet};
+ }
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_remove',
+ $keepnick{lc $chatnet}, $chatnet);
+
+ delete $keepnick{lc $chatnet};
+ delete $getnick{lc $chatnet};
+
+ save_nicks(1);
+}
+
+# Usage: /LISTNICK
+sub cmd_listnick {
+ my(@nets) = sort keys %keepnick;
+ my $net;
+ if (@nets) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_list_header');
+ for (@nets) {
+ $net = Irssi::chatnet_find($_);
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_list_line',
+ $keepnick{$_},
+ $net ? $net->{name} : ">$_<",
+ $inactive{$_}?'inactive':'active');
+ }
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_list_footer');
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_list_empty');
+ }
+}
+
+sub cmd_nick {
+ my($data,$server) = @_;
+ my($nick) = split " ", $data;
+ return unless $server;
+ $manual{lc $server->{chatnet}} = $nick;
+}
+
+Irssi::settings_add_bool('keepnick', 'keepnick_autosave', 1);
+Irssi::settings_add_bool('keepnick', 'keepnick_quiet', 0);
+
+Irssi::theme_register(
+[
+ 'keepnick_crap',
+ '{line_start}{hilight Keepnick:} $0',
+
+ 'keepnick_add',
+ '{line_start}{hilight Keepnick:} Now keeping {nick $0} on [$1]',
+
+ 'keepnick_remove',
+ '{line_start}{hilight Keepnick:} Stopped trying to keep {nick $0} on [$1]',
+
+ 'keepnick_hold',
+ '{line_start}{hilight Keepnick:} Nickkeeping deactivated on [$1]',
+
+ 'keepnick_unhold',
+ '{line_start}{hilight Keepnick:} Nickkeeping reactivated on [$1]',
+
+ 'keepnick_list_empty',
+ '{line_start}{hilight Keepnick:} No nicks in keep list',
+
+ 'keepnick_list_header',
+ '',
+
+ 'keepnick_list_line',
+ '{line_start}{hilight Keepnick:} Keeping {nick $0} in [$1] ($2)',
+
+ 'keepnick_list_footer',
+ '',
+
+ 'keepnick_got_nick',
+ '{hilight Keepnick:} Nickstealer left [$1], got {nick $0} back',
+
+]);
+
+Irssi::signal_add('message quit', 'sig_message_quit');
+Irssi::signal_add('message nick', 'sig_message_nick');
+Irssi::signal_add('message own_nick', 'sig_message_own_nick');
+
+Irssi::signal_add('redir keepnick ison', 'sig_redir_keepnick_ison');
+Irssi::signal_add('redir keepnick nick', 'sig_redir_keepnick_nick');
+
+Irssi::signal_add('setup saved', 'sig_setup_save');
+Irssi::signal_add('setup reread', 'sig_setup_reread');
+
+Irssi::command_bind("keepnick", "cmd_keepnick");
+Irssi::command_bind("unkeepnick", "cmd_unkeepnick");
+Irssi::command_bind("listnick", "cmd_listnick");
+Irssi::command_bind("nick", "cmd_nick");
+
+Irssi::timeout_add(12000, 'check_nick', '');
+
+Irssi::Irc::Server::redirect_register('keepnick ison', 0, 0,
+ undef,
+ {
+ "event 303" => -1,
+ },
+ undef );
+
+Irssi::Irc::Server::redirect_register('keepnick nick', 0, 0,
+ undef,
+ {
+ "event nick" => 0,
+ "event 432" => -1, # ERR_ERRONEUSNICKNAME
+ "event 433" => -1, # ERR_NICKNAMEINUSE
+ "event 437" => -1, # ERR_UNAVAILRESOURCE
+ "event 484" => -1, # ERR_RESTRICTED
+ },
+ undef );
+
+load_nicks;
diff --git a/scripts/kenny.pl b/scripts/kenny.pl
new file mode 100644
index 0000000..0ad85d5
--- /dev/null
+++ b/scripts/kenny.pl
@@ -0,0 +1,92 @@
+# (c) 2002 by Gerfried Fuchs <alfie@channel.debian.de>
+
+use Irssi qw(command_bind command signal_add_last signal_stop settings_get_bool settings_add_bool);
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '2.3.1';
+
+%IRSSI = (
+ 'authors' => 'Gerfried Fuchs',
+ 'contact' => 'alfie@channel.debian.de',
+ 'name' => 'kenny speech',
+ 'description' => 'autodekennyfies /kenny, adds /kenny, /dekenny. Based on Jan-Pieter Cornets signature version',
+ 'license' => 'BSD',
+ 'url' => 'http://alfie.ist.org/projects/irssi/scripts/kenny.pl',
+ 'changed' => '2002-06-13',
+);
+
+# Maintainer & original Author: Gerfried Fuchs <alfie@channel.debian.de>
+# Based on signature kenny from: Jan-Pieter Cornet <johnpc@xs4all.nl>
+# Autodekenny-suggestion: BC-bd <bd@bc-bd.org>
+
+# Sugguestions from darix: Add <$nick> to [kenny] line patch
+
+# This script offers you /kenny and /dekenny which both do the kenny-filter
+# magic on the argument you give it. Despite it's name *both* do kenny/dekenny
+# the argument; the difference is that /kenny writes it to the channel/query
+# but /dekenny only to your screen.
+
+# Version-History:
+# ================
+# 2.3.1 -- fixed autodekenny in channels for people != yourself
+#
+# 2.3.0 -- fixed kenny in querys
+# fixed dekenny in status window
+#
+# 2.2.3 -- fixed pattern matching for autokenny string ("\w" != "a-z" :/)
+#
+# 2.2.2 -- first version available to track history from...
+
+# TODO List
+# ... currently empty
+
+
+sub KennyIt {
+ ($_)=@_;my($p,$f);$p=3-2*/[^\W\dmpf_]/i;s.[a-z]{$p}.vec($f=join('',$p-1?chr(
+ sub{$_[0]*9+$_[1]*3+$_[2] }->(map {/p|f/i+/f/i}split//,$&)+97):('m','p','f')
+ [map{((ord$&)%32-1)/$_%3}(9, 3,1)]),5,1)='`'lt$&;$f.eig;return ($_);
+};
+
+
+sub cmd_kenny {
+ my ($msg, undef, $channel) = @_;
+ $channel->command("msg $channel->{'name'} ".KennyIt($msg));
+}
+
+
+sub cmd_dekenny {
+ my ($msg, undef, $channel) = @_;
+
+ if ($channel) {
+ $channel->print('[kenny] '.KennyIt($msg), MSGLEVEL_CRAP);
+ } else {
+ Irssi::print('[kenny] '.KennyIt($msg), MSGLEVEL_CRAP);
+ }
+}
+
+
+sub sig_kenny {
+ my ($server, $msg, $nick, $address, $target) = @_;
+ if ($msg=~m/^[^a-z]*[mfp]{3}(?:[^a-z]|[mfp]{3})+$/i) {
+ $target=$nick if $target eq "";
+
+ # the address may _never_ be emtpy, if it is its own_public
+ $nick=$server->{'nick'} if $address eq "";
+
+ $server->window_item_find($target)->print("[kenny] <$nick> " .
+ KennyIt($msg), MSGLEVEL_CRAP);
+ signal_stop if not settings_get_bool('show_kenny_too');
+ }
+}
+
+
+command_bind('kenny', 'cmd_kenny');
+command_bind('dekenny', 'cmd_dekenny');
+
+signal_add_last('message own_public', 'sig_kenny');
+signal_add_last('message public', 'sig_kenny');
+signal_add_last('message own_private', 'sig_kenny');
+signal_add_last('message private', 'sig_kenny');
+
+settings_add_bool('lookandfeel', 'show_kenny_too', 0);
diff --git a/scripts/kernel.pl b/scripts/kernel.pl
new file mode 100644
index 0000000..435a068
--- /dev/null
+++ b/scripts/kernel.pl
@@ -0,0 +1,37 @@
+# Fetches the version(s) of the latest Linux kernel(s).
+
+# /kernel
+
+use strict;
+use Irssi;
+use LWP::Simple;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '0.10';
+%IRSSI = (
+ authors => 'Johan "Ion" Kiviniemi',
+ contact => 'ion at hassers.org',
+ name => 'Kernel',
+ description => 'Fetches the version(s) of the latest Linux kernel(s).',
+ license => 'Public Domain',
+ url => 'http://scripts.irssi.org/',
+ changed => '2018-03-11',
+);
+
+sub wget {
+ my $con =get("https://www.kernel.org/finger_banner");
+ return $con;
+}
+
+sub get_version {
+ my @version;
+ if (my $finger = wget()) {
+ # The magic of the regexps :)
+ @version = $finger =~ /:\s*(\S+)\s*$/gm;
+ # Modify this to do whatever you want.
+ Irssi::print("@version");
+ }
+}
+
+Irssi::command_bind('kernel_version', 'get_version');
diff --git a/scripts/kicks.pl b/scripts/kicks.pl
new file mode 100644
index 0000000..76e87ea
--- /dev/null
+++ b/scripts/kicks.pl
@@ -0,0 +1,253 @@
+#!/usr/bin/perl -w
+# various kick and ban commands
+# by c0ffee
+# - http://www.penguin-breeder.org/irssi/
+
+#<scriptinfo>
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi 20020120;
+$VERSION = "0.27";
+%IRSSI = (
+ authors => "c0ffee",
+ contact => "c0ffee\@penguin-breeder.org",
+ name => "Various kick and ban commands",
+ description => "Enhances /k /kb and /kn with some nice options.",
+ license => "Public Domain",
+ url => "http://www.penguin-breeder.org/irssi/",
+ changed => "2017-03-31",
+);
+#</scriptinfo>
+
+my %kickreasons = (
+ default => ["random kick victim",
+ "no",
+ "are you stupid?",
+ "i don't like you, go away!",
+ "oh, fsck off",
+ "waste other ppls time, elsewhere",
+ "get out and STAY OUT",
+ "don't come back",
+ "no thanks",
+ "on popular demand, you are now leaving the channel",
+ "\$N",
+ "*void*",
+ "/part is the command you're looking for",
+ "this is the irssi of borg. your mIRC will be assimilated. resistance is futile.",
+ "Autokick! mwahahahah!"
+ ],
+ none => [""],
+ topic => ["\$topic"],
+);
+
+
+# fine tune the script for different chatnets
+# cmdline_k regular expr that matches a correct cmdline for /k
+# req_chan 0/1 whether the channel is always part of the cmdline
+# num_nicks number of nicks ... (-1 = inf)
+# start_with_dash 0/1 whether the normal cmdline may start with a dash
+# match_chn matches channels
+# match_n match nicks
+# match_reason matches reasons
+# default_reason reason to give as "no reason"
+my %cfg = (
+ IRC => {
+ cmdline_k => '\s*([!#+&][^\x0\a\n\r ]*)\s+[-\[\]\\\\\`{}\w_|^\'~]+(,[-\[\]\\\\\`{}\w_|^\'~]+)*\s+\S.*',
+ req_chan => 0,
+ num_nicks => 3, # actually, /k takes more, but
+ # normal irc servers only take
+ # three in a row
+ start_with_dash => 1,
+ match_chn => '([!#+&][^\x0\a\n\r ]*)\s',
+ match_n => '(?:^|\s+)([-\[\]\\\\\`{}\w_|^\'~]+(?:,[-\[\]\\\\\`{}\w_|^\']+)*)',
+ match_reason => '^\s*[!#+&][^\x0\a\n\r ]*\s+[-\[\]\\\\\`{}\w_|^\'~]+(?:,[-\[\]\\\\\`{}\w_|^\'~]+)*\s+(\S.*)$',
+ default_reason => '$N'
+ },
+
+ SILC => {
+ cmdline_k => '\s*[^\x0-\x20\*\?,@!]+\s+[^\x0-\x20\*\?,@!]+\s+\S.*',
+ req_chan => 1,
+ num_nicks => 1,
+ start_with_dash => 0,
+ match_chn => '\s*([^\x0-\x20\*\?,@!]+)\s+[^\x0-\x20\*\?,@!]+(?:,[^\x0-\x20\*\?,@!]+)*',
+ match_n => '\s*(?:[^\x0-\x20\*\?,@!]+\s+)?([^\x0-\x20\*\?,@!]+(?:,[^\x0-\x20\*\?,@!]+)*)',
+ match_reason => '\s*[^\x0-\x20\*\?,@!]+\s+[^\x0-\x20\*\?,@!]+(?:,[^\x0-\x20\*\?,@!]+)*\s+(\S.*)',
+ default_reason => '$N'
+ }
+);
+
+sub initialize {
+
+ my $conf_file = Irssi::settings_get_str("kicks_configuration");
+ $conf_file =~ s/~/$ENV{HOME}/;
+ my ($basedir) = $conf_file =~ /^(.*\/).*?/;
+
+ if (-f $conf_file) {
+ open CONF, '<', $conf_file;
+
+ my $line=0;
+
+ while (<CONF>) {
+ $line++;
+
+ next if /^\s*#/;
+
+ chomp;
+ my ($key, $reasons) = /^(\S+)\s+(.+)\s*$/ or next;
+
+ if ($reasons =~ /\`([^\s]+).*?\`/) {
+ $kickreasons{$key} = "$reasons";
+ Irssi::print("Added executable $1 as $key...");
+ next;
+ }
+
+ $reasons =~ s/^"(.*)"$/$1/;
+ $reasons =~ s/~/$ENV{HOME}/;
+ $reasons =~ s/^([^\/])/$basedir$1/;
+
+ if (-f $reasons) {
+
+ $kickreasons{$key} = [];
+
+ open REASON, '<', $reasons;
+
+ while (<REASON>) {
+ chomp;
+ push @{$kickreasons{$key}}, $_;
+ }
+
+ close REASON;
+ Irssi::print("Loaded $reasons as $key...");
+ } else {
+ Irssi::print("can't parse config line $line...");
+ }
+ }
+ close CONF;
+ } else {
+ Irssi::print("Could not find configuration file for kicks...");
+ Irssi::print("... use /set kicks_configuration <file>");
+ }
+}
+
+
+sub get_a_reason {
+ my ($topic) = @_;
+
+
+ return "" if not defined $kickreasons{$topic};
+
+ $_ = eval $kickreasons{$topic}, chomp, s/[\n\t]+/ /mg, return $_
+ if ref($kickreasons{$topic}) ne "ARRAY";
+
+ return $kickreasons{$topic}[rand @{$kickreasons{$topic}}];
+
+}
+
+sub cmd_realkick {
+ my ($data, $server, $channel, $cmd) = @_;
+ my $reasons = "default";
+
+ return if not $server
+ or not defined $cfg{$server->{chat_type}}
+ or not $channel
+ or $data =~ /^$cfg{$server->{chat_type}}{cmdline_k}$/;
+
+ Irssi::signal_stop();
+
+ # let's see whether some options where supplied
+ my $default = Irssi::settings_get_str("default_kick_options");
+ $data = "$default $data" if not $default =~ /^\s*$/;
+ my @opts = split /\s+/, $data;
+ my $opt;
+ my $fail=0;
+
+ while (($opt) = (shift @opts) =~ /^\s*-(\S+)/) {
+
+ $data =~ s/^\s*--\s+//, last if $opt eq "-";
+
+ $data =~ s/^\s*-$opt\s+//,
+ $reasons = lc $opt,
+ next if defined $kickreasons{lc $opt};
+
+ last if $cfg{$server->{chat_type}}{start_with_dash};
+
+ Irssi::print("Unknown option -$opt");
+ $fail = 1;
+
+ }
+
+ return if $fail;
+
+ my $chn = "";
+ ($chn) = $data =~ /^$cfg{$server->{chat_type}}{match_chn}/;
+
+ if ($cfg{$server->{chat_type}}{req_chan} && ($chn eq "")) {
+ Irssi::print "Not joined to any channel";
+ return;
+ }
+
+ # do we need to add a channel?
+ if ($chn eq "") {
+ Irssi::print("Not joined to any channel"), return
+ if $channel->{type} ne "CHANNEL";
+ $chn = $channel->{name};
+
+ $data = "$chn $data";
+ }
+
+ # is a reason already supplied?
+ my $reason;
+ $reason = get_a_reason($reasons)
+ if not (($reason) = $data =~ /$cfg{$server->{chat_type}}{match_reason}/);
+
+ $reason = $cfg{$server->{chat_type}}{default_reason}
+ if $reason =~ /^\s*$/;
+
+ my @nicks = split /,/, ($data =~ /$cfg{$server->{chat_type}}{match_n}/)[0];
+ my $num_nicks = $cfg{$server->{chat_type}}{num_nicks};
+ $num_nicks = @nicks if $num_nicks <= 0;
+
+ my @commands;
+ undef @commands;
+
+ while (@nicks) {
+ my $tmp = ($chn ne "" ? "$chn " : "") .
+ join ",", (splice @nicks,0,$num_nicks);
+ $tmp =~ s/([;\\\$])/\\$1/g;
+ push @commands, "$tmp $reason";
+ }
+
+ foreach (@commands) {
+ if ($_ =~ /^$cfg{$server->{chat_type}}{cmdline_k}$/) {
+ s/\s+$//;
+ $channel->command("EVAL $cmd $_");
+ } else {
+ Irssi::print("BUG: generated invalid $cmd command: $_");
+ }
+ }
+}
+
+sub cmd_kick {
+ my ($data, $server, $channel) = @_;
+
+ cmd_realkick $data, $server, $channel, "KICK";
+
+}
+
+sub cmd_kickban {
+ my ($data, $server, $channel) = @_;
+
+ cmd_realkick $data, $server, $channel, "KICKBAN";
+
+}
+
+Irssi::settings_add_str("misc", "default_kick_options", "");
+Irssi::settings_add_str("misc", "kicks_configuration",
+ Irssi::get_irssi_dir() . "/kicks.conf");
+
+Irssi::command_bind("kick", "cmd_kick");
+Irssi::command_bind("kickban", "cmd_kickban");
+
+initialize();
+
diff --git a/scripts/kill_fake_gets.pl b/scripts/kill_fake_gets.pl
new file mode 100644
index 0000000..0eefb40
--- /dev/null
+++ b/scripts/kill_fake_gets.pl
@@ -0,0 +1,131 @@
+
+#
+# Variables:
+# /set kill_fake_gets_timeout X - if there is no tranfer in X minutes the get
+# is closed
+#
+# Changes:
+# 1.1 (2003.02.11)
+# Hmm. The previous official version didn't worket at all (forgot to
+# uncomment one line) and notbody told me that. Means nobody is using this
+# script...
+# Anyway, this should be fixed. And now it closes stalled gets as well.
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.1";
+%IRSSI = (
+ authors => "Piotr 'Cvbge' Krukowiecki",
+ name => 'kill_fake_gets',
+ description => 'When new send arrives checks if there are old identical '.
+ 'sends (ie from the same nick on the same server and with the same '.
+ 'filename) and closes them',
+ license => 'Public Domain',
+ changed => '2003.02.11',
+ url => 'http://pingu.ii.uj.edu.pl/~piotr/irssi/'
+);
+
+my $debug = 0; # set this to 1 to enable A LOT OF debug messages
+
+sub pd {
+ return if (not $debug);
+ my $dcc = @_[0];
+ Irssi::print("SDC '$dcc->{type}' from '$dcc->{nick}' on '$dcc->{servertag}' arg '$dcc->{arg}'");
+ Irssi::print("SDC created '$dcc->{created}' addr '$dcc->{addr}' port '$dcc->{port}'");
+ Irssi::print("SDC starttime '$dcc->{starttime}' transfd '$dcc->{transfd}'");
+ Irssi::print("SDC size '$dcc->{size}' skipped '$dcc->{skipped}'");
+}
+
+sub sig_dcc_connected {
+ my $dcc = @_[0];
+ return if ($dcc->{'type'} ne 'GET');
+ Irssi::print("SDC: dcc get connected") if ($debug);
+ pd($dcc);
+ foreach (Irssi::Irc::dccs()) {
+ pd($_);
+ if ($_->{'type'} eq 'GET' and
+ $_->{'nick'} eq $dcc->{'nick'} and
+ $_->{'servertag'} eq $dcc->{'servertag'} and
+ $_->{'arg'} eq $dcc->{'arg'} and
+ $_->{'created'} ne $dcc->{'created'} and
+ $_->{'starttime'} ne $dcc->{'starttime'} and
+ $_->{'port'} ne $dcc->{'port'}) {
+ Irssi::print("SDC: Destroying") if ($debug);
+ $_->destroy();
+ }
+ }
+}
+
+my %gets;
+
+sub sig_dcc_destroyed {
+ my $dcc = @_[0];
+ return if ($dcc->{'type'} ne 'GET');
+
+ Irssi::print('SDC: the get was destroyed:') if ($debug); pd($dcc);
+
+ # no record - the script must have been loaded less than 1 minute ago
+ if (not exists $gets{$dcc->{'servertag'}} or
+ not exists $gets{$dcc->{'servertag'}}{$dcc->{'nick'}} or
+ not exists $gets{$dcc->{'servertag'}}{$dcc->{'nick'}}{$dcc->{'arg'}}) {
+ Irssi::print('SDC: The record for this get does not exists') if ($debug);
+ return;
+ }
+
+ delete $gets{$dcc->{'servertag'}}{$dcc->{'nick'}}{$dcc->{'arg'}};
+ Irssi::print('SDC: record destroyed') if ($debug);
+}
+
+
+
+sub check_speed {
+ my $time = time();
+ my $timeout = 60 * Irssi::settings_get_int('kill_fake_gets_timeout');
+ foreach (Irssi::Irc::dccs()) {
+ next if ($_->{'type'} ne 'GET');
+ next if (not $_->{'starttime'}); # transfer not yet started
+
+ Irssi::print('SDC: checking get:') if ($debug); pd($_);
+ # no such record - just loaded the script
+ if (not exists $gets{$_->{'servertag'}} or
+ not exists $gets{$_->{'servertag'}}{$_->{'nick'}} or
+ not exists $gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}) {
+ $gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'time'} = $time;
+ $gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'transfd'} = $_->{'transfd'};
+ Irssi::print("Adding as new get: '$time', '$_->{transfd}'") if ($debug);
+ next;
+ }
+
+ # the transfer is in progress
+ if ($_->{'transfd'} != $gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'transfd'}) {
+ Irssi::print('SDC: the transfer is in progress (change '.
+ ($_->{'transfd'} - $gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'transfd'})
+ .' bytes)') if ($debug);
+ $gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'time'} = $time;
+ $gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'transfd'} = $_->{'transfd'};
+ next;
+ }
+
+ Irssi::print('SDC: transfer stalled') if ($debug);
+ # transfer stalled
+ if ($time - $gets{$_->{'servertag'}}{$_->{'nick'}}{$_->{'arg'}}{'time'}
+ > $timeout) {
+ Irssi::print('SDC: closing this GET') if ($debug);
+ my $server = Irssi::server_find_tag($_->{'servertag'});
+ if (!$server) {
+ Irssi::print('SDC: error: could not find server $_->{servertag}') if ($debug);
+ next;
+ }
+ $server->command("DCC CLOSE GET $_->{nick} $_->{arg}");
+ }
+ }
+}
+
+# After this many minutes of no data the get is closed
+Irssi::settings_add_int('misc', 'kill_fake_gets_timeout', 2);
+
+Irssi::signal_add_first('dcc connected', 'sig_dcc_connected');
+Irssi::signal_add_last('dcc destroyed', 'sig_dcc_destroyed');
+my $timeout_tag = Irssi::timeout_add(60*1000, 'check_speed', undef);
diff --git a/scripts/kline_warning.pl b/scripts/kline_warning.pl
new file mode 100644
index 0000000..4437581
--- /dev/null
+++ b/scripts/kline_warning.pl
@@ -0,0 +1,147 @@
+#!/usr/bin/perl -w
+
+## Bugreports and Licence disclaimer.
+#
+# For bugreports and other improvements contact Geert Hauwaerts <geert@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+##
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.08";
+
+%IRSSI = (
+ authors => 'Geert Hauwaerts',
+ contact => 'geert@irssi.org',
+ name => 'kline_warning.pl',
+ description => 'This script shows a warning in the statuswindow if somebody preforms a /KlINE or /UNKLINE.',
+ license => 'GNU General Public License',
+ url => 'http://irssi.hauwaerts.be/kline_warning.pl',
+ changed => 'Wed Sep 17 23:00:11 CEST 2003',
+);
+
+## Comments and remarks.
+#
+# This script uses settings, by default the servernotice will be stripped out.
+# If you still want to be able to see the servernotice use /SET or /TOGGLE
+# to switch it on or off.
+#
+# Setting: show_kline_snote
+#
+##
+
+Irssi::theme_register([
+ 'kline_added', '%_Warning%_: %R>>%n %_$0%_ added a K-Line for %_$1%_ on $2',
+ 'tkline_added', '%_Warning%_: %R>>%n %_$0%_ added a temporary K-Line ($1) for %_$2%_ on $3',
+ 'expired', '%_Warning%_: %R>>%n Temporary K-Line for %_$0%_ expired on $1',
+ 'remove', '%_Warning%_: %R>>%n %_$0%_ removed the K-Line for %_$1%_ on $2',
+ 'kline_warning_loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.'
+]);
+
+sub kline_warning {
+
+ my ($dest, $text) = @_;
+
+ return if (($text !~ /^NOTICE/));
+
+ # Type IRCd: Hybrid7
+ # Homepage: http://www.ircd-hybrid.com/
+ # Needed flags: +s
+ if ($text =~ /Notice -- (.*)!.*@.*{.*} added K-Line for \[(.*)\] \[.*\]/) {
+ print_warning_kline($1, $2, $dest->{tag});
+ } elsif ($text =~ /Notice -- \*\*\* Received K-Line for \[(.*)\] \[.*\], from (.*)!.*@.* on .*/) {
+ print_warning_kline($2, $1, $dest->{tag});
+ } elsif ($text =~ /Added K-Line \[.*@.*\]/) {
+ Irssi::signal_stop();
+ } elsif ($text =~ /Notice -- (.*)!.*@.*{.*} added temporary (.*). K-Line for \[(.*)\] \[.*\]/) {
+ print_warning_tkline($1, $2, $3, $dest->{tag});
+ } elsif ($text =~ /Added temporary .*. K-Line \[.*@.*\]/) {
+ Irssi::signal_stop();
+ } elsif ($text =~ /Notice -- Temporary K-line for \[(.*)\] expired/) {
+ print_warning_expired($1, $dest->{tag});
+ } elsif ($text =~ /Notice -- (.*)!.*@.*{.*} has removed the K-Line for: \[(.*)\]/) {
+ print_warning_unkline($1, $2, $dest->{tag});
+ } elsif ($text =~ /K-Line for \[(.*)\] is removed/) {
+ Irssi::signal_stop();
+ }
+}
+
+sub print_warning_kline {
+
+ my ($nick, $host, $network) = @_;
+ my $signalstop;
+
+ $signalstop = Irssi::settings_get_bool('show_kline_snote');
+
+ if ($signalstop == 0) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'kline_added', $nick, $host, $network);
+ Irssi::signal_stop();
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'kline_added', $nick, $host, $network);
+ }
+}
+
+sub print_warning_tkline {
+
+ my ($nick, $duration, $host, $network) = @_;
+ my $signalstop;
+
+ $signalstop = Irssi::settings_get_bool('show_kline_snote');
+
+ if ($signalstop == 0) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'tkline_added', $nick, $duration, $host, $network);
+ Irssi::signal_stop();
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'tkline_added', $nick, $duration, $host, $network);
+ }
+}
+
+sub print_warning_expired {
+
+ my ($host, $network) = @_;
+ my $signalstop;
+
+ $signalstop = Irssi::settings_get_bool('show_kline_snote');
+
+ if ($signalstop == 0) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'expired', $host, $network);
+ Irssi::signal_stop();
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'expired', $host, $network);
+ }
+}
+
+sub print_warning_unkline {
+
+ my ($nick, $host , $network) = @_;
+ my $signalstop;
+
+ $signalstop = Irssi::settings_get_bool('show_kline_snote');
+
+ if ($signalstop == 0) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'remove', $nick, $host, $network);
+ Irssi::signal_stop();
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'remove', $nick, $host, $network);
+ }
+}
+
+Irssi::signal_add_first('server event', 'kline_warning');
+Irssi::settings_add_bool('warning', 'show_kline_snote' => 0);
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'kline_warning_loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
diff --git a/scripts/l33tmusic.pl b/scripts/l33tmusic.pl
new file mode 100644
index 0000000..0595782
--- /dev/null
+++ b/scripts/l33tmusic.pl
@@ -0,0 +1,283 @@
+use strict;
+use Irssi;
+use Irssi::TextUI;
+use vars qw($VERSION %IRSSI);
+use Xmms;
+use Xmms::Remote ();
+
+#changed to recommended version system with onedigit.twodigits, sorry :)
+$VERSION = '2.01';
+%IRSSI = (
+ authors => 'Mikachu',
+ contact => 'Mikachu @ quakenet|freenode|arcnet|oftc',
+ description => 'A script to show playing xmms song in channel or in a statusbar, and also control xmms. Be sure to read through the script to see all features.',
+ name => 'l33t xmms music showing script',
+ license => 'GPL',
+ modules => 'Bundle::Xmms',
+ sbitems => 'l33tmusic'
+);
+
+#Stuff i've added recently that i can remember:
+#
+#fixed the -c parameter, now you can do stuff like
+#/l33tmusic -c / jump_to_timestr 1:24 to jump around
+#and /l33tmusic -c / pause to pause, and /l33tmusic
+#-c /echo get_playlist_pos to echo the position :)
+#
+#only answers to /ctcp music if xmms is actually on
+#(if someone /ctcp music nick 2 it will show your current+2
+#song in playlist as currently playing instead of saying
+#that it is the second next song, oh well :)
+#
+#some stuff now take a numerical argument as an offset
+#to the current position in the playlist
+#
+#Stuff i've added that i can't remember:
+#
+#if you expected to find something here you weren't thinking
+#look below for stuff
+
+#this function from nickcolor.pl
+my @colors = qw/2 3 4 5 6 7 9 10 11 12 13/;
+sub simple_hash {
+ my ($string) = @_;
+ chomp $string;
+ my @chars = split //, $string;
+ my $counter;
+
+ foreach my $char (@chars) {
+ $counter += ord $char;
+ }
+
+ $counter = $colors[$counter % 11];
+
+ return $counter;
+}
+
+sub getvars {
+ if ($_[0] =~ "songinfo") {
+ my ($position, $title, $time, $status, $filename);
+ my $xmmscontrol = Xmms::Remote->new;
+ my $wantedpos = $_[0];
+ $wantedpos =~ s/songinfo //;
+ unless ($wantedpos =~ /^-?\d+$/ && (( $wantedpos + $xmmscontrol->get_playlist_pos <= $xmmscontrol->get_playlist_length-1 && $wantedpos >= 0) || 0-$wantedpos <= $xmmscontrol->get_playlist_pos && $wantedpos <= 0) ) {
+ $wantedpos = 0;
+ }
+ my $wantedpos = $xmmscontrol->get_playlist_pos + $wantedpos;
+ $title = $xmmscontrol->get_playlist_title($wantedpos);
+ my $seconds = ($xmmscontrol->get_output_time/1000)%60;
+ my $tmp = length($seconds);
+ if($tmp == "1") {
+ $seconds = "0" . $seconds;
+ }
+ $position = int($xmmscontrol->get_output_time/60000) . ":" . $seconds;
+ $time = $xmmscontrol->get_playlist_timestr($wantedpos);
+ if ($xmmscontrol->is_playing) {
+ if ($xmmscontrol->is_paused) {
+ $status = "Paused";
+ } else {
+ $status = "Playing";
+ }
+ } else {
+ $status = "Stopped";
+ }
+ $filename = $xmmscontrol->get_playlist_file($wantedpos);
+
+ $title =~ s/[\r\n]/ /g;
+ $filename =~ s/[\r\n]/ /g;
+
+ return($position, $title, $time, $status, $filename);
+ } elsif ($_[0] =~ "filename") {
+ my $xmmscontrol = Xmms::Remote->new;
+ my $wantedpos = $_[0];
+ $wantedpos =~ s/filename //;
+ unless ($wantedpos =~ /^-?\d+$/ && (( $wantedpos + $xmmscontrol->get_playlist_pos <= $xmmscontrol->get_playlist_length-1 && $wantedpos >= 0) || 0-$wantedpos <= $xmmscontrol->get_playlist_pos && $wantedpos <= 0) ) {
+ $wantedpos = 0;
+ }
+ $wantedpos = $xmmscontrol->get_playlist_pos + $wantedpos;
+ $filename = $xmmscontrol->get_playlist_file($wantedpos);
+ $filename =~ s/[\r\n]/ /g;
+ return($filename);
+ }
+}
+
+sub ctcp_info {
+ if (Irssi::settings_get_bool('l33tctcp_enabled') && Xmms::Remote->new->is_running) {
+ my ($server, $msg, $nick, $address, $channel) = @_;
+ my ($p, $n, $t, $s) = getvars("songinfo $msg");
+ my $reply = Irssi::settings_get_str('l33tctcpreply');
+ $reply =~ s/(\$\w+)/$1/eeg;
+ $server->command("^notice $nick $reply");
+ Irssi::statusbar_items_redraw('l33tmusic');
+ }
+}
+
+sub triggersend {
+ my $trigger = Irssi::settings_get_str('l33ttrigger');
+ if ($_[1] =~ /^$trigger/) {
+ if (Irssi::settings_get_bool('l33ttrigger_enabled')) {
+ $_[1] =~ s/$trigger //g;
+ $_[1] = getvars("filename $_[1]");
+ $_[0]->command("DCC SEND $_[2] \"$filename\"");
+ } else {
+ $_[0]->command("^notice $_[2] Trigger currently disabled");
+ }
+ }
+}
+
+sub themainthingie {
+ if (Xmms::Remote->new->is_running) {
+ my ($msg, $server, $nick, $address, $channel) = @_;
+ my $command;
+ my ($p, $n, $t, $s, $f) = getvars("songinfo 0");
+ #The -m switch will echo the info in the status window,
+ #I have this bound to meta-q :), takes a numerical argument
+ #same as the -s switch
+ if ($msg =~ "^-m") {
+ $msg =~ s/^-m //;
+ my ($p, $n, $t, $s, $f) = getvars("songinfo " . $msg);
+ print CLIENTCRAP "" . simple_hash("$n") . "$n ($p / $t)";
+ $command = "";
+ #This allows a fully customized message, to be used in
+ #aliases, since it's not fun to write the full thing every
+ #time
+ } elsif ($msg =~ "^-e") {
+ $msg =~ s/^\-e //;
+ $command = "$msg";
+ #The -c switch is now fixed mostly, it seems that you
+ #can do whatever you want, and if it happens to match
+ #a proper command such as jump_to_timestr and you pass
+ #the right parameter, it works, otherwise i made it not
+ #crash anymore, weee :)
+ } elsif ($msg =~ "^-c") {
+ $msg =~ s/^\-c //;
+ my $thingie;
+ my ($msg, $reply, $param) = split(/ /, "$msg", 3);
+ if ($param) {
+ return unless eval {
+ $thingie = Xmms::Remote->new->$reply($param);
+ }
+ } else {
+ return unless eval {
+ $thingie = Xmms::Remote->new->$reply;
+ }
+ }
+ if ($thingie) {
+ $command = "$msg $thingie";
+ }
+ #The -f switch has been removed, please use
+ #/l33tmusic -e /colme or /colsay from the
+ #ascii.pl script to get better functionality
+
+ #This switch will send the currently playing song to
+ #the nick on the command line, takes a numerical
+ #argument like the -m switch
+ } elsif ($msg =~ "^-s") {
+ $msg =~ s/^-s //;
+ (my $friend, $msg) = split " ", $msg;
+ $friend =~ s/ //;
+ my ($p, $n, $t, $s, $f) = getvars("songinfo " . $msg);
+ $server->command("dcc send $friend \"$f\"");
+ #If a string was given, put it in front of the info, and
+ #anything after a # after the info. If nothing is in front
+ #of the #, throw in the string from the settings.
+ } elsif ($msg) {
+ my $msg2;
+ $msg =~ s/(\$\w+)/$1/eeg;
+ ($msg, $msg2) = split "#", $msg;
+ if ($msg =~ /^$/) {
+ $msg = Irssi::settings_get_str('l33tstringplaying');
+ }
+ $command = "me $msg $n ($p / $t) $msg2";
+ #Just go with the defaults
+ } else {
+ if ( $s eq "Playing" ) {
+ $command = Irssi::settings_get_str('l33tstringplaying');
+ $command = Irssi::settings_get_str('l33tstringaction') . " $command " . Irssi::settings_get_str('l33tstringsongformat');
+ } else {
+ $command = "echo Xmms is $s";
+ }
+ }
+ $command =~ s/(\$\w+)/$1/eeg;
+ $command =~ s/\s+/ /g;
+ if ($command) {
+ Irssi::active_win()->command("$command");
+ }
+ }else {
+ Irssi::active_win()->command("echo Xmms isn't currently running");
+ }
+}
+
+sub checkformpg123 {
+ my ($msg, $server, $witem) = @_;
+ if ($msg =~ /^Playing( MPEG stream from )?/) {
+ $msg =~ s/Playing MPEG stream from //;
+ $msg =~ s/Playing //;
+ $msg =~ s/%20/ /g;
+ $msg =~ s/\.(mp3|ogg)( \.\.\.)?//i;
+ $msg =~ s/_/ /g;
+ $msg =~ s/oc remix//i;
+ $msg = Irssi::settings_get_str('l33tstringaction') . " " . Irssi::settings_get_str('l33tstringplayingmpg123') . " $msg";
+ Irssi::signal_stop();
+ Irssi::signal_remove('send text', 'checkformpg123');
+ Irssi::signal_emit('send command', $msg, $server, $witem);
+ Irssi::signal_add('send text', 'checkformpg123');
+ }
+
+}
+
+my $statusbar_item;
+my $refresh_tag;
+my $scrollpos=0;
+sub refresh_statusbar {
+ my ($p, $no, $t, $s, $f) = getvars("songinfo 0");
+ my $width=Irssi::active_win()->{width};
+ my $n;
+ my $others = Irssi::settings_get_str('l33tstatusbar');
+ $others =~ s/\%.//g;
+ $others =~ s/\$n//g;
+ $others =~ s/(\$\w+)/$1/eeg;
+ my $maxlength=$width - length($others);
+ if (length($no) > $maxlength) {
+ my $middlethingie = Irssi::settings_get_str('l33tmiddlethingie');
+ $no = "$no $middlethingie";
+ $n=substr(substr($no, $scrollpos, length($no)) . substr($no, 0, $scrollpos), 0, $maxlength);
+ $scrollpos++;
+ $scrollpos=0 if ($scrollpos + 1 > length($no));
+ } else {
+ $n = $no;
+ }
+ $n =~ s/\%/\%\%/g;
+ $statusbar_item = Irssi::settings_get_str('l33tstatusbar');
+ $statusbar_item =~ s/(\$\w+)/$1/eeg;
+ Irssi::statusbar_items_redraw('l33tmusic');
+}
+
+sub l33tmusic_statusbar {
+ my ($item, $get_size_only) = @_;
+ $item->default_handler($get_size_only, "$statusbar_item", undef, 1);
+}
+
+
+Irssi::signal_add('send text', 'checkformpg123');
+Irssi::command_bind('l33tmusic', 'themainthingie');
+Irssi::settings_add_str('infopipe', 'l33tstringaction', '/me');
+Irssi::settings_add_str('infopipe', 'l33tstringplayingmpg123', 'is listening to');
+Irssi::settings_add_str('infopipe', 'l33tstringplaying', 'is listening to');
+Irssi::settings_add_str('infopipe', 'l33tstatusbar', '$n ($p / $t)');
+Irssi::settings_add_str('infopipe', 'l33tstatusbarrefresh', '500');
+Irssi::settings_add_str('infopipe', 'l33tmiddlethingie', '*** ');
+Irssi::settings_add_str('infopipe', 'l33tstringsongformat', '$n ($p / $t)');
+Irssi::settings_add_str('infopipe', 'l33tctcpreply', 'I\'m listening to $n ($p / $t) Status: $s');
+Irssi::settings_add_str('infopipe', 'l33ttrigger', '¡yourtriggerhere');
+Irssi::settings_add_bool('infopipe', 'l33ttrigger_enabled', 0);
+Irssi::settings_add_bool('infopipe', 'l33tctcp_enabled', 0);
+Irssi::settings_add_bool('infopipe', 'l33twarning_read', 0);
+Irssi::signal_add("ctcp msg music", "ctcp_info");
+Irssi::signal_add_last("message public", "triggersend");
+Irssi::statusbar_item_register('l33tmusic', undef, 'l33tmusic_statusbar');
+$refresh_tag=Irssi::timeout_add(Irssi::settings_get_str('l33tstatusbarrefresh'), 'refresh_statusbar', undef);
+unless (Irssi::settings_get_bool('l33twarning_read')) {
+ print CLIENTCRAP "Type /set l33t to see all available settings. To remove this message, please type /set l33twarning_read on. Type /set l33t to list all options.";
+ print CLIENTCRAP "If you want statusbar, add \'l33tmusic = { placement = \"top\"; items = { l33tmusic = { }; }; };\' to your config file, above \'topic = {\', and do a /reload.";
+}
diff --git a/scripts/lastspoke.pl b/scripts/lastspoke.pl
new file mode 100644
index 0000000..32c55f3
--- /dev/null
+++ b/scripts/lastspoke.pl
@@ -0,0 +1,210 @@
+#!/usr/bin/perl -w
+#
+# LastSpoke.pl
+#
+# irssi script
+#
+# This script, when loaded into irssi, will monitor and remember everyones
+# last action on one or more channels specified in the lastspoke_channels
+# setting
+#
+# [settings]
+# lastspoke_channels
+# - Should contain a list of channels that lastspoke should monitor
+# this list can be in any format as long as theres full channelnames
+# in it. For example:
+# "#foo,#bar,#baz" is correct
+# "#foo#bar#baz" is correct
+# "#foo #bar #baz" is correct
+#
+# Triggers on !lastspoke <nick>, !seen <nick> and !lastseen <nick>
+#
+use strict;
+use utf8;
+use Encode qw/decode encode/;
+use Irssi;
+use Irssi::Irc;
+use CPAN::Meta::YAML;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.4";
+%IRSSI = (
+ authors => 'Sander Smeenk',
+ contact => 'irssi@freshdot.net',
+ name => 'lastspoke',
+ description => 'Remembers what people said last on what channels',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.freshdot.net/',
+ modules => 'CPAN::Meta::YAML',
+);
+
+# Storage for the data.
+my %lasthash;
+
+my $filename=Irssi::get_irssi_dir().'/lastspoke.yaml';
+
+# Calculates the difference between two unix times and returns
+# a string like '15d 23h 42m 15s ago.'
+sub calcDiff {
+ my ($when) = @_;
+
+ my $diff = (time() - $when);
+ my $day = int($diff / 86400); $diff -= ($day * 86400);
+ my $hrs = int($diff / 3600); $diff -= ($hrs * 3600);
+ my $min = int($diff / 60); $diff -= ($min * 60);
+ my $sec = $diff;
+
+ return "${day}d ${hrs}h ${min}m ${sec}s ago.";
+}
+
+# Hook for nick changes
+sub on_nick {
+ my ($server, $new, $old, $address) = @_;
+
+ my $allowedChans = lc(Irssi::settings_get_str("lastspoke_channels")) || "(null)";
+ my @cl=split(/,/,$server->get_channels());
+ my $ok=0;
+ foreach (@cl) {
+ $ok += index($allowedChans, $_) >= 0;
+ }
+ if ( $ok >= 0) {
+ $lasthash{lc($old)}{'last'} = time();
+ $lasthash{lc($old)}{'words'} = "$old changed nick to $new";
+ $lasthash{lc($new)}{'last'} = time();
+ $lasthash{lc($new)}{'words'} = "$new changed nick from $old";
+ }
+}
+
+# Hook for people quitting
+sub on_quit {
+ my ($server, $nick, $address, $reason) = @_;
+
+ my $allowedChans = lc(Irssi::settings_get_str("lastspoke_channels")) || "(null)";
+ my @cl=split(/,/,$server->get_channels());
+ my $ok=0;
+ foreach (@cl) {
+ $ok += index($allowedChans, $_) >= 0;
+ }
+ if ( $ok >= 0) {
+ $lasthash{lc($nick)}{'last'} = time();
+ if (! $reason) {
+ $lasthash{lc($nick)}{'words'} = "$nick quit IRC with no reason";
+ } else {
+ $lasthash{lc($nick)}{'words'} = "$nick quit IRC stating '$reason'";
+ }
+ }
+}
+
+# Hook for people joining
+sub on_join {
+ my ($server, $channel, $nick, $address) = @_;
+
+ my $allowedChans = lc(Irssi::settings_get_str("lastspoke_channels")) || "(null)";
+ if (index($allowedChans, $channel) >= 0) {
+ $lasthash{lc($nick)}{'last'} = time();
+ $lasthash{lc($nick)}{'words'} = "$nick joined $channel";
+ }
+}
+
+# Hook for people parting
+sub on_part {
+ my ($server, $channel, $nick, $address, $reason) = @_;
+
+ my $allowedChans = lc(Irssi::settings_get_str("lastspoke_channels")) || "(null)";
+ if (index($allowedChans, $channel) >= 0) {
+ $lasthash{lc($nick)}{'last'} = time();
+ if (! $reason) {
+ $lasthash{lc($nick)}{'words'} = "$nick left from $channel with no reason";
+ } else {
+ $lasthash{lc($nick)}{'words'} = "$nick left from $channel stating '$reason'";
+ }
+ }
+}
+
+# Hook for public messages.
+# Only act on channels we are supposed to act on (settings_get_str)
+sub on_public {
+ my ($server, $msg, $nick, $addr, $target) = @_;
+ utf8::decode($msg);
+
+ $target = $nick if ( ! $target );
+ $nick = $server->{'nick'} if ($nick =~ /^#/);
+ $target = lc($target);
+
+ my $allowedChans = lc(Irssi::settings_get_str("lastspoke_channels")) || "(null)";
+
+ # Debug
+ # Irssi::active_win()->print("Server: $server");
+ # Irssi::active_win()->print("Msg : $msg");
+ # Irssi::active_win()->print("Nick : $nick");
+ # Irssi::active_win()->print("Addr : $addr");
+ # Irssi::active_win()->print("Target: $target");
+ # /Debug
+
+ if (index($allowedChans, $target) >= 0) {
+ if ( ($msg =~ /^!lastspoke /) || ($msg =~ /^!seen /) || ($msg =~ /^!lastseen /)) {
+ my @parts = split(/ /,$msg);
+
+ $lasthash{lc($nick)}{'last'} = time();
+ $lasthash{lc($nick)}{'words'} = "$nick last queried information about " . $parts[1] . " on $target";
+
+ if (exists $lasthash{lc($parts[1])}) {
+ $server->command("MSG $target " .
+ to_term_enc($lasthash{lc($parts[1])}{'words'}) .
+ " " . calcDiff($lasthash{lc($parts[1])}{'last'}));
+ } else {
+ $server->command("MSG $target I don't know anything about " . $parts[1]);
+ }
+ } else {
+ $lasthash{lc($nick)}{'last'} = time();
+ $lasthash{lc($nick)}{'words'} = "$nick last said '$msg' on $target";
+ }
+ }
+}
+
+# encode the words to term_charset
+sub to_term_enc {
+ my ($words)= @_;
+ my $charset= Irssi::settings_get_str('term_charset');
+ return encode($charset, $words);
+}
+
+# write the memory to disk
+sub save {
+ my $fa;
+ open($fa, '>:utf8', $filename);
+ my $yml = CPAN::Meta::YAML->new( \%lasthash );
+ print $fa $yml->write_string();
+ close($fa);
+}
+
+# read form the disk to memory
+sub load {
+ my $fi;
+ if (-e $filename) {
+ local $/;
+ open($fi, '<:utf8', $filename);
+ my $s= <$fi>;
+ my $yml= CPAN::Meta::YAML->read_string($s);
+ %lasthash = %{ $yml->[0] };
+ close($fi);
+ }
+}
+
+# hook for unload, /quit
+sub UNLOAD {
+ save();
+}
+
+# Put hooks on events
+Irssi::signal_add_last("message public", "on_public");
+Irssi::signal_add_last("message own_public", "on_public");
+Irssi::signal_add_last("message part", "on_part");
+Irssi::signal_add_last("message join", "on_join");
+Irssi::signal_add_last("message quit", "on_quit");
+Irssi::signal_add_last("message nick", "on_nick");
+
+# Add setting
+Irssi::settings_add_str("lastspoke", "lastspoke_channels", '%s');
+
+load();
diff --git a/scripts/len.pl b/scripts/len.pl
new file mode 100644
index 0000000..fbcc759
--- /dev/null
+++ b/scripts/len.pl
@@ -0,0 +1,374 @@
+# $Id: len.pl 4 2006-03-11 18:30:09Z ch $
+
+use Irssi 20020324;
+use 5.005_62;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.0.0';
+#$VERSION = '1.0.0 SVN ($LastChangedRevision: 4 $)';
+%IRSSI = (
+ authors => 'Clemens Heidinger',
+ changed => '$LastChangedDate: 2006-03-11 19:30:09 +0100 (Sat, 11 Mar 2006) $',
+ commands => 'len',
+ contact => 'heidinger@dau.pl',
+ description => 'If you try to get a nick with 11 characters but only ' .
+ '9 are allowed, this script will prevent the ' .
+ 'nickchange. The same for too long topics, kickmsgs, ' .
+ 'partmsgs and quitmsgs.',
+ license => 'BSD',
+ name => 'len',
+ );
+
+################################################################################
+# #
+# CHANGELOG #
+# #
+# 2006-03-11 release 1.0.0 #
+# No big changes. As the script is stable for quite a while, #
+# this is the 1.0.0 release. #
+# #
+# 2005-01-28 release 0.4.0 #
+# Splitted up 005 event messages will cause no trouble anymore #
+# #
+# 2004-04-26 release 0.3.2 #
+# minor changes #
+# #
+# 2003-01-18 release 0.3.1 #
+# - revised help-message #
+# - minor changes #
+# #
+# 2003-01-18 release 0.3.0 #
+# %data-hash moved to extern file specified in setting #
+# len_data_file #
+# #
+# 2002-10-02 release 0.2.1 #
+# Changed output format of /len #
+# #
+# 2002-09-27 release 0.2.0 #
+# Added command /len with a table containing the values for #
+# NICKLEN etc. and tips if these values haven't been received #
+# from the server yet #
+# #
+# 2002-09-26 release 0.1.0 #
+# initial release #
+# #
+################################################################################
+
+################################################################################
+# Register commands
+################################################################################
+
+Irssi::command_bind('len', \&command_len);
+
+################################################################################
+# Register settings
+################################################################################
+
+# String
+Irssi::settings_add_str('misc', 'len_data_file', "$ENV{HOME}/.len");
+
+################################################################################
+# Register signals
+################################################################################
+
+Irssi::signal_add_first('command kick', \&signal_command_kick);
+Irssi::signal_add_first('command nick', \&signal_command_nick);
+Irssi::signal_add_first('command part', \&signal_command_part);
+Irssi::signal_add_first('command quit', \&signal_command_quit);
+Irssi::signal_add_first('command topic', \&signal_command_topic);
+Irssi::signal_add_last('event 005', \&signal_event_005);
+
+################################################################################
+# Register themes
+################################################################################
+
+Irssi::theme_register(['len_print', '[$0] {line_start} $1']);
+
+################################################################################
+# Global Variables
+################################################################################
+
+# Put values of the settings in %option-hash
+
+our %option;
+
+# Most IRC-Server send a message containing the values for NICKLEN, TOPICLEN
+# and KICKLEN.
+# Well, some server do not send this message. Get these values from %data-hash
+# stored in file specified in setting len_data_file.
+
+our %data;
+
+################################################################################
+# Code run once at start
+################################################################################
+
+print CLIENTCRAP "len.pl $VERSION loaded. For further information type %9/len%9";
+
+################################################################################
+# Subroutines (commands)
+################################################################################
+
+sub command_len {
+ my ($data, $server, $witem) = @_;
+ my $output;
+
+ unless ($server and defined($server)) {
+ print_out("First connect to a server...");
+ return;
+ }
+
+ read_file();
+
+ my $kicklen = sprintf "%-8s", $data{$server->{tag}}{kicklen};
+ my $nicklen = sprintf "%-8s", $data{$server->{tag}}{nicklen};
+ my $partlen = sprintf "%-8s", $data{$server->{tag}}{partlen};
+ my $quitlen = sprintf "%-8s", $data{$server->{tag}}{quitlen};
+ my $topiclen = sprintf "%-9s", $data{$server->{tag}}{topiclen};
+
+ $output = &fix(<<" END");
+ |=========|=================|
+ | | max. characters |
+ |=========|=================|
+ | kickmsg | $kicklen |
+ |---------|-----------------|
+ | nick | $nicklen |
+ |---------|-----------------|
+ | partmsg | $partlen |
+ |---------|-----------------|
+ | quitmsg | $quitlen |
+ |---------|-----------------|
+ | topic | $topiclen |
+ |---------|-----------------|
+ END
+
+ unless ($kicklen =~ /\d/ &&
+ $nicklen =~ /\d/ &&
+ $partlen =~ /\d/ &&
+ $quitlen =~ /\d/ &&
+ $topiclen =~ /\d/)
+ {
+ $output .= &fix(<<" END");
+
+ Obviously there are some values missing.
+ When you connect to a server most send you a message (numeric 005)
+ with the proper values for the maximal nick length, topic length etc.
+ If you loaded this script after connecting to "$server->{tag}"
+ you should reconnect.
+ If this doesn't help, the server is not sending the message with these
+ values.
+ The following alternatives remain:
+ * Use another server of the same network and cross your fingers
+ that it'll send the message.
+ * Find out the values and adjust the data hash in the file
+ specified in the setting len_data_file.
+ The file might look like this:
+
+ %{ \$data{$server->{tag}} } = (
+ 'kicklen' => <value>,
+ 'nicklen' => <value>,
+ 'partlen' => <value>,
+ 'quitlen' => <value>,
+ 'topiclen' => <value>,
+ );
+
+ %{ \$data{someOtherNetwork} } = (
+ 'kicklen' => 160,
+ 'nicklen' => 9,
+ 'partlen' => 160,
+ 'quitlen' => 160,
+ 'topiclen' => 160,
+ );
+ END
+ }
+
+ foreach my $line (split /\n/, $output) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'len_print', $server->{tag}, $line);
+ }
+}
+
+################################################################################
+# Subroutines (signals)
+################################################################################
+
+sub signal_command_kick {
+ my ($command, $server, $witem) = @_;
+
+ return unless ($server and defined($server));
+
+ read_file();
+
+ # Syntax for /kick:
+ # KICK [<channel>] <nicks> [<reason>]
+ # We want to isolate <reason> to know how long it is
+
+ # delete [<channel>] <nicks>
+ $command =~ s/^\s* # Start of String and optional some whitespace
+ (?: # Grouping
+ \#\S+ # This is <channel>
+ )? # End of Grouping, <channel> is optional
+ [ ]? # Maybe a single space
+ \S+ # Everything not whitespace. These are the nicks.
+ [ ]? # Maybe a single space
+ //x; # Delete everything
+
+ # The rest of $command is the kickmsg
+ my $kickmsg = $command;
+
+ my $len = length($kickmsg);
+ my $maxlen = $data{$server->{tag}}{kicklen};
+
+ if ($maxlen > 0 && $len > $maxlen) {
+ print_out("kickmsg too long! ($len/$maxlen)");
+ Irssi::signal_stop();
+ }
+}
+
+sub signal_command_nick {
+ my ($nick, $server, $witem) = @_;
+
+ return unless ($server and defined($server));
+
+ read_file();
+
+ my $len = length($nick);
+ my $maxlen = $data{$server->{tag}}{nicklen};
+
+ if ($maxlen > 0 && $len > $maxlen) {
+ print_out("Nick too long! ($len/$maxlen)");
+ Irssi::signal_stop();
+ }
+}
+
+sub signal_command_part {
+ my ($command, $server, $witem) = @_;
+
+ return unless ($server and defined($server));
+
+ read_file();
+
+ # Syntax for /part:
+ # PART [<channels>] [<message>]
+ # So we want to get rid of the channels to isolate the partmsg
+
+ # Delete [<channels>]
+ $command =~ s/^#\S+ //;
+
+ # The rest of $command is the partmsg
+ my $partmsg = $command;
+
+ my $len = length($partmsg);
+ my $maxlen = $data{$server->{tag}}{partlen};
+
+ if ($maxlen > 0 && $len > $maxlen) {
+ print_out("partmsg too long! ($len/$maxlen)");
+ Irssi::signal_stop();
+ }
+}
+
+sub signal_command_quit {
+ my ($quitmsg, $server, $witem) = @_;
+
+ return unless ($server and defined($server));
+
+ read_file();
+
+ my $len = length($quitmsg);
+ my $maxlen = $data{$server->{tag}}{quitlen};
+
+ if ($maxlen > 0 && $len > $maxlen) {
+ print_out("quitmsg too long! ($len/$maxlen)");
+ Irssi::signal_stop();
+ }
+}
+
+sub signal_command_topic {
+ my ($command, $server, $witem) = @_;
+
+ return unless ($server and defined($server));
+
+ read_file();
+
+ # Syntax for /topic:
+ # TOPIC [-delete] [<channel>] [<topic>]
+ # We want to isolate <reason> to know how long it is
+
+ # Delete <channel>
+ $command =~ s/^#\S+ //;
+
+ # The rest of $command is the topic
+ my $topic = $command;
+
+ my $len = length($topic);
+ my $maxlen = $data{$server->{tag}}{topiclen};
+
+ if ($maxlen > 0 && $len > $maxlen) {
+ print_out("Topic too long! ($len/$maxlen)");
+ Irssi::signal_stop();
+ }
+}
+
+# Most server send this message containig the values for NICKLEN etc. on
+# connect (event 005).
+
+sub signal_event_005 {
+ my ($server, $string) = @_;
+
+ if ($string =~ /KICKLEN=(\d+)/) {
+ $data{$server->{tag}}{kicklen} = $1;
+ $data{$server->{tag}}{partlen} = $1;
+ $data{$server->{tag}}{quitlen} = $1;
+ }
+ if ($string =~ /NICKLEN=(\d+)/) {
+ $data{$server->{tag}}{nicklen} = $1;
+ }
+ if ($string =~ /TOPICLEN=(\d+)/) {
+ $data{$server->{tag}}{topiclen} = $1;
+ }
+}
+
+################################################################################
+# Helper subroutines
+################################################################################
+
+sub fix {
+ my $string = shift;
+ $string =~ s/^\t+//gm;
+ return $string;
+}
+
+sub print_err {
+ my $text = shift;
+
+ print CLIENTCRAP '%Rlen.pl error%n: ' . $text;
+}
+
+sub print_out {
+ my $text = shift;
+
+ print CLIENTCRAP '%9len.pl%9: ' . $text;
+}
+
+sub read_file {
+ set_settings();
+
+ my $file = $option{len_data_file};
+
+ unless (-e $file && -r $file) {
+ return;
+ }
+ unless (my $return = do $file) {
+ if ($@) {
+ print_err("parsing $file failed: $@");
+ }
+ unless (defined($return)) {
+ print_err("'do $file' failed");
+ }
+ }
+}
+
+sub set_settings {
+ # String
+ $option{len_data_file} = Irssi::settings_get_str('len_data_file');
+}
diff --git a/scripts/leodict.pl b/scripts/leodict.pl
new file mode 100644
index 0000000..8b1fd8a
--- /dev/null
+++ b/scripts/leodict.pl
@@ -0,0 +1,435 @@
+#!/usr/bin/perl
+#
+# by Stefan "Tommie" Tomanek
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '20220104';
+%IRSSI = (
+ authors => 'Stefan \'tommie\' Tomanek, bw1',
+ contact => 'bw1@aol.at',
+ name => 'leodict',
+ description => 'translates via dict.leo.org',
+ license => 'GPLv2',
+ url => 'http://irssi.org/scripts/',
+ modules => 'Mojo::UserAgent Encode JSON::PP Mojo::DOM Getopt::Long POSIX',
+ commands => "leodict",
+ selfcheckcmd=> 'leodict -chec',
+);
+use vars qw($forked);
+use utf8;
+use Encode;
+use Irssi 20020324;
+use JSON::PP;
+use Mojo::DOM;
+use Getopt::Long qw(GetOptionsFromString);
+use Mojo::UserAgent;
+use POSIX;
+
+# global
+my %gresult;
+my $lang;
+my $dlang= 'englisch-deutsch/';
+my $help;
+my $browse;
+my $paste;
+my $word;
+my $dir;
+my $ddir= '';
+my $check;
+
+# for fork
+my $ftext;
+my %fresult;
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub show_help() {
+ my $help = "LeoDict $VERSION
+SYNOPSIS
+ /leodict [OPTION] <word> [OPTION]
+ searches dict.leo.org for appropiate translations
+DESCRIPTION
+ -p
+ paste the translations to the current channel or query
+ The number of translations is limited by the setting
+ 'leodict_paste_max_translations'
+ -b
+ open dict.leo.org in your web browser (uses openurl.pl)
+
+ -from from German
+ -to to German
+ -both from and to German
+ -en English
+ -fr French
+ -es Spanish
+ -it Italian
+ -zh Chinese
+ -ru Russian
+ -pt Portuguese
+ -pl Polish
+ -chec selfcheck
+SETTINGS
+ 'leodict_default_options'
+ example: -it -from
+ 'leodict_paste_max_translations'
+ 'leodict_paste_beautify'
+ 'leodict_http_proxy_address'
+ example: 127.0.0.1
+ defaults to none, meaning no proxy will be used for requests.
+ despite the name, does not have to be http proxy.
+ 'leodict_http_proxy_port'
+ example: 9050
+ defaults to 0, but must be changed if proxy address is not none.
+ 'leodict_http_proxy_type'
+ supported: socks, https, http
+";
+ my $text='';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP draw_box($IRSSI{name}, $text, "help", 1);
+}
+
+sub parser {
+ my %ignore=(
+ 'Suchwort' => 1,
+ 'Beispiele' => 1,
+ 'Orthographisch ähnliche Wörter' => 1,
+ 'Aus dem Umfeld der Suche' => 1,
+ 'Forumsdiskussionen, die den Suchbegriff enthalten' =>1,
+ #'Substantive'
+ #'Verben'
+ #'Adjektive / Adverbien'
+ #'Phrasen'
+ );
+ %fresult=();
+
+ # tables
+ unless (defined $ftext) {
+ %fresult=('Error'=>[['no data']]);
+ return;
+ }
+ my $dom = Mojo::DOM->new($ftext);
+ foreach my $tbl ( $dom->find('table')->each ) {
+
+ # head
+ my $thead =$tbl->at('thead');
+ next unless (defined $thead );
+ my $headname = $thead->descendant_nodes->last->to_string;
+ next if (exists $ignore{ $headname } );
+
+
+ # rows
+ my @rows=();
+ foreach my $row ( $tbl->find('tr')->each) {
+
+ # colums
+ my @columns=();
+ foreach my $col ( $row->find('td')->each ) {
+ my $co = $col->to_string;
+ $co =~ s/<.*?>//sg;
+ if ( length($co) >2 ) {
+ push(@columns ,$co);
+ }
+ }
+ if ( scalar(@columns) > 0 ) {
+ push(@rows, [@columns]);
+ }
+ }
+ $fresult{ $headname } = [ @rows ];
+ }
+}
+
+sub get_page ($) {
+ my ($url) = @_;
+ #return get('http://dict.leo.org/?search='.$word.'&relink=off');
+ my $ua = Mojo::UserAgent->new;
+
+ # Add proxy to Mojo if needed
+ my $proxy_addr = Irssi::settings_get_str('leodict_http_proxy_address');
+ my $proxy_port = Irssi::settings_get_int('leodict_http_proxy_port');
+ my $proxy_type = Irssi::settings_get_str('leodict_http_proxy_type');
+ if ($proxy_addr ne 'none') {
+ # Socks proxy
+ if ($proxy_type eq 'socks' || $proxy_type eq 'https') {
+ $ua->proxy->http("$proxy_type://$proxy_addr:$proxy_port")->https("$proxy_type://$proxy_addr:$proxy_port");
+ }
+ # Must be http proxy
+ else {
+ $ua->proxy->http("$proxy_type://$proxy_addr:$proxy_port");
+ }
+ }
+
+ my $res;
+ eval {
+ $res=$ua->get($url)->result;
+ };
+ if (defined $res && $res->is_success) {
+ $ftext = $res->body;
+ utf8::decode($ftext);
+ } else {
+ $ftext=undef;
+ }
+}
+
+sub call_openurl ($) {
+ my ($url) = @_;
+ no strict "refs";
+ # check for a loaded openurl
+ if (defined &{ "Irssi::Script::openurl::launch_url" } ) {
+ &{ "Irssi::Script::openurl::launch_url" }($url);
+ } else {
+ print CLIENTCRAP "%R>>%n Please install openurl.pl";
+ }
+}
+
+sub translate ($$$) {
+ my ($url, $target, $server) = @_;
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ if ($forked) {
+ print CLIENTCRAP "%R>>%n Please wait until your earlier request has been finished.";
+ return;
+ }
+
+ # Validate proxy if needed
+ my $proxy_addr = Irssi::settings_get_str('leodict_http_proxy_address');
+ my $proxy_port = Irssi::settings_get_int('leodict_http_proxy_port');
+ my $proxy_type = Irssi::settings_get_str('leodict_http_proxy_type');
+ if ($proxy_addr ne 'none') {
+ if ($proxy_type ne 'socks' && $proxy_type ne 'https' && $proxy_type ne 'http') {
+ print CLIENTCRAP "%R>>%n Invalid proxy type: $proxy_type.";
+ return;
+ }
+ if ($proxy_port eq 0) {
+ print CLIENTCRAP "%R>>%n Please specify a proxy port.";
+ return;
+ }
+ }
+
+ my $pid = fork();
+ $forked = 1;
+ if ($pid > 0) {
+ print CLIENTCRAP "%R>>%n Please wait..." unless $target;
+ close $wh;
+ Irssi::pidwait_add($pid);
+ my $pipetag;
+ my @args = ($rh, \$pipetag, $target, $server);
+ $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
+ } else {
+ get_page($url);
+ parser();
+ print($wh encode_json(\%fresult));
+ close($wh);
+ POSIX::_exit(1);
+ }
+}
+
+sub one_site {
+ my ($site, $cat) = @_;
+ my @res;
+ foreach my $r ( @{$gresult{$cat}} ) {
+ push @res,$r->[$site];
+ }
+ return [@res];
+}
+
+sub pipe_input ($) {
+ my ($rh, $pipetag, $target, $tag) = @{$_[0]};
+ $forked = 0;
+ local $\;
+ my $res=<$rh>;
+ close $rh;
+ return if (length($res) <5);
+ %gresult = %{decode_json( $res )};
+ Irssi::input_remove($$pipetag);
+
+ if ($target eq '') {
+ show_translations(\%gresult, $word);
+ } else {
+ my $server = Irssi::server_find_tag($tag);
+ my $witem = $server->window_item_find($target);
+ paste_translations(\%gresult, $word, $witem) if $witem;
+ }
+}
+
+sub show_translations($$) {
+ my %trans = %{$_[0]};
+ my $word = $_[1];
+ self_check(\%trans) if ( defined $check );
+ if (%trans) {
+ my $text;
+ foreach my $k (keys %trans) {
+ $text .= "== $k ==\n";
+ foreach (@{ $trans{$k} }) {
+ $text .= "%U".$_->[0]."%U \n";
+ $text .= " `-> ".$_->[1]."\n";
+ }
+ }
+ my $term_charset= Irssi::settings_get_str('term_charset');
+ if ('UTF-8' ne $term_charset) {
+ $text= encode($term_charset, $text);
+ }
+ print CLIENTCRAP draw_box('LeoDict', $text, $word, 1);
+ } else {
+ print CLIENTCRAP "%R>>>%n No translations found (".$word.").";
+ }
+}
+
+sub paste_translations ($$) {
+ my ($trans, $word, $target) = @_;
+ return unless ($target->{type} eq "CHANNEL" || $target->{type} eq "QUERY");
+ if (%{ $trans }) {
+ my $text;
+ my $beauty = Irssi::settings_get_bool('leodict_paste_beautify');
+ my $max = Irssi::settings_get_int('leodict_paste_max_translations');
+ foreach my $k (keys %{ $trans }) {
+ $text .= "== $k ==\n";
+ my $i = 0;
+ foreach (@{ $trans->{$k}}) {
+ if ($i < $max || $max == 0) {
+ if ($beauty) {
+ $text .= $_->[0]." \n";
+ $text .= " `-> ".$_->[1]."\n";
+ } else {
+ $text .= $_->[0].' => '.$_->[1]."\n";
+ }
+ $i++;
+ } else {
+ $text .= '...'."\n";
+ last;
+ }
+ }
+ }
+ my $msg = $text;
+ $msg = draw_box('LeoDict', $text, $word, 0) if $beauty;
+ $target->command('MSG '.$target->{name}. ' '.$_) foreach (split(/\n/, $msg));
+ }
+}
+
+#https://dict.leo.org/englisch-deutsch/word
+#https://dict.leo.org/franz%C3%B6sisch-deutsch/word
+#https://dict.leo.org/spanisch-deutsch/word
+#https://dict.leo.org/italienisch-deutsch/word
+#https://dict.leo.org/chinesisch-deutsch/word
+#https://dict.leo.org/russisch-deutsch/word
+#https://dict.leo.org/portugiesisch-deutsch/word
+#https://dict.leo.org/polnisch-deutsch/word
+#https://dict.leo.org/polnisch-deutsch/word?side=left pl -> de
+#https://dict.leo.org/polnisch-deutsch/word?side=right pl <- de
+my %options = (
+ "from" => sub {$dir= '?side=right';},
+ "to" => sub {$dir= '?side=left';},
+ "both" => sub {$dir= '';},
+ "en" => sub {$lang = 'englisch-deutsch/'; },
+ "fr" => sub {$lang = 'franz%C3%B6sisch-deutsch/'; },
+ "es" => sub {$lang = 'spanisch-deutsch/'; },
+ "it" => sub {$lang = 'italienisch-deutsch/'; },
+ "zh" => sub {$lang = 'chinesisch-deutsch/'; },
+ "ru" => sub {$lang = 'russisch-deutsch/'; },
+ "pt" => sub {$lang = 'portugiesisch-deutsch/'; },
+ "pl" => sub {$lang = 'polnisch-deutsch/'; },
+ "h" => \$help,
+ "b" => \$browse,
+ "p" => \$paste,
+ "chec" => \$check,
+);
+
+sub cmd_leodict ($$$) {
+ my ($args, $server, $witem) = @_;
+ utf8::decode($args);
+ my $burl = "https://dict.leo.org/";
+ my $url;
+
+ $lang= $dlang;
+ $dir= $ddir;
+ undef $help;
+ undef $browse;
+ undef $paste;
+ undef $check;
+
+ my ($ret, $arg) = GetOptionsFromString($args, %options);
+
+ $word= $arg->[0];
+ $url=$burl.$lang.$word.$dir;
+
+ if (defined $help) {
+ show_help();
+ return();
+ }
+ if (defined $browse) {
+ call_openurl($url);
+ return();
+ }
+
+ if (defined $paste) {
+ #paste_translations($_, $witem) if $witem;
+ return unless defined $witem;
+ return unless defined $server;
+ translate($url, $witem->{name}, $witem->{server}->{tag});
+ } elsif (defined $check) {
+ $url=$burl.'englisch-deutsch/'.'tree'.$dir;
+ translate($url,'', '');
+ } else {
+ #show_translations($_);
+ translate($url,'', '');
+ }
+}
+
+sub self_check {
+ my ( $tr ) =@_;
+ my $s='ok';
+ Irssi::print("selfcheck: categorys ".scalar( keys %$tr ));
+ my $count=0;
+ foreach my $n ( keys %$tr ) {
+ Irssi::print("selfcheck: category $n ".scalar( @{$tr->{$n}} ));
+ $count +=scalar( @{$tr->{$n}} );
+ }
+ Irssi::print("selfcheck: results $count");
+ if ( scalar( keys %$tr ) <4 ) {
+ $s='Error: categorys ('.scalar( keys %$tr ).')';
+ } elsif ( $count < 35 ) {
+ $s="Error: results ($count)";
+ }
+ Irssi::print("selfcheck: $s");
+ my $schs = exists $Irssi::Script::{'selfcheckhelperscript::'};
+ Irssi::command("selfcheckhelperscript $s") if ( $schs );
+}
+
+sub sig_setup_changed {
+ my $args =Irssi::settings_get_str('leodict_default_options');
+ my ($ret, $arg) = GetOptionsFromString($args, %options);
+ $dlang=$lang;
+ $ddir=$dir;
+}
+
+Irssi::signal_add('setup changed', 'sig_setup_changed');
+
+Irssi::command_bind('leodict', 'cmd_leodict');
+
+Irssi::command_set_options('leodict', join(" ",keys %options));
+
+Irssi::settings_add_str($IRSSI{'name'}, 'leodict_default_options', '-en -both');
+Irssi::settings_add_int($IRSSI{'name'}, 'leodict_paste_max_translations', 2);
+Irssi::settings_add_bool($IRSSI{'name'}, 'leodict_paste_beautify', 1);
+Irssi::settings_add_str($IRSSI{'name'}, 'leodict_http_proxy_address', 'none');
+Irssi::settings_add_int($IRSSI{'name'}, 'leodict_http_proxy_port', 0);
+Irssi::settings_add_str($IRSSI{'name'}, 'leodict_http_proxy_type', 'none');
+
+sig_setup_changed();
+
+print CLIENTCRAP "%B>>%n ".$IRSSI{name}." ".$VERSION." loaded: /leodict -h for help";
+
+# vim:set ts=8 sw=4:
diff --git a/scripts/licq.pl b/scripts/licq.pl
new file mode 100644
index 0000000..2f747fe
--- /dev/null
+++ b/scripts/licq.pl
@@ -0,0 +1,66 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.5";
+%IRSSI = (
+ authors => "Jari Matilainen",
+ contact => "jmn98015\@student.mdh.se",
+ name => "licq",
+ description => "Licq statusbar thingy",
+ sbitems => "licq",
+ license => "Public Domain",
+ url => "http://jari.cjb.net,http://irssi.org,http://scripts.irssi.de",
+);
+
+use Irssi::TextUI;
+
+my $result;
+my $refresh_tag;
+my $rdir = "$ENV{'HOME'}/.licq/users/";
+
+sub licq {
+ my ($item,$get_size_only) = @_;
+ $result = 0;
+ if(-e $rdir) {
+ opendir(DIR, $rdir);
+
+ while ( $_ = readdir(DIR) ) {
+ next if(($_ eq ".") or ($_ eq ".."));
+
+ my $filename = "$rdir" . "$_";
+ if(-e $filename) {
+ open(FILE, "<", $filename);
+ $_ = "";
+ $_ = <FILE> until /NewMessages/;
+ my @total = split / /, $_;
+ if(defined $total[2]) {
+ $result += $total[2];
+ }
+ }
+ }
+ }
+
+ closedir(DIR);
+
+ $item->default_handler($get_size_only, undef, $result, 1);
+}
+
+sub refresh_licq {
+ Irssi::statusbar_items_redraw('licq');
+}
+
+sub init_licq {
+ my $time = Irssi::settings_get_int('licq_refresh_time');
+ $rdir = Irssi::settings_get_str('licq_path');
+ Irssi::timeout_remove($refresh_tag) if ($refresh_tag);
+ $refresh_tag = Irssi::timeout_add($time*1000, 'refresh_licq', undef);
+}
+
+Irssi::settings_add_int('LICQ','licq_refresh_time',10);
+Irssi::settings_add_str('LICQ','licq_path',$rdir);
+Irssi::statusbar_item_register('licq', '{sb ICQ: $0-}', 'licq');
+
+init_licq();
+Irssi::signal_add('setup changed','init_licq');
+refresh_licq();
+
+# EOF
diff --git a/scripts/linkchan.pl b/scripts/linkchan.pl
new file mode 100644
index 0000000..34fb619
--- /dev/null
+++ b/scripts/linkchan.pl
@@ -0,0 +1,488 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.5";
+%IRSSI =
+(
+ authors => 'Marcin \'Qrczak\' Kowalczyk',
+ contact => 'qrczak@knm.org.pl',
+ name => 'LinkChan',
+ description => 'Link several channels on serveral networks',
+ license => 'GNU GPL',
+ url => 'http://qrnik.knm.org.pl/~qrczak/irssi/linkchan.pl',
+);
+
+our %links;
+our $lock_own = 0;
+
+our $config = Irssi::get_irssi_dir . "/linkchan.cfg";
+
+Irssi::command_bind "link", sub
+{
+ my ($args, $server, $target) = @_;
+ Irssi::command_runsub "link", $args, $server, $target;
+};
+
+Irssi::command_bind "link add", sub
+{
+ my ($args, $server, $target) = @_;
+ unless ($args =~ m|^ *([^ /]+)/([^ ]+) +([^ /]+)/([^ ]+) *$|)
+ {
+ print CLIENTERROR "Usage: /link add <chatnet1>/<channel1> <chatnet2>/<channel2>";
+ return;
+ }
+ my ($chatnet1, $channel1, $chatnet2, $channel2) =
+ (lc $1, lc $2, lc $3, lc $4);
+ foreach my $link ([$chatnet1, $channel1], [$chatnet2, $channel2])
+ {
+ my ($chat1, $chan1) = @{$link};
+ if ($links{$chat1}{$chan1})
+ {
+ my ($chat2, $chan2) = @{$links{$chat1}{$chan1}};
+ print CLIENTERROR "Channel $chat1/$chan1 is already linked to $chat2/$chan2";
+ return;
+ }
+ }
+ $links{$chatnet1}{$channel1} = [$chatnet2, $channel2];
+ $links{$chatnet2}{$channel2} = [$chatnet1, $channel1];
+ print CLIENTNOTICE "Added link: $chatnet1/$channel1 <-> $chatnet2/$channel2";
+};
+
+Irssi::command_bind "link remove", sub
+{
+ my ($args, $server, $target) = @_;
+ unless ($args =~ m|^ *([^ /]+)/([^ ]+) *$|)
+ {
+ print CLIENTERROR "Usage: /link remove <chatnet>/<channel>";
+ return;
+ }
+ my ($chatnet1, $channel1) = (lc $1, lc $2);
+ unless ($links{$chatnet1}{$channel1})
+ {
+ print CLIENTERROR "Channel $chatnet1/$channel1 was not linked";
+ return;
+ }
+ my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}};
+ delete $links{$chatnet1}{$channel1};
+ delete $links{$chatnet2}{$channel2};
+ print CLIENTNOTICE "Removed link: $chatnet1/$channel1 <-> $chatnet2/$channel2";
+};
+
+Irssi::command_bind "link list", sub
+{
+ my ($args, $server, $target) = @_;
+ unless ($args =~ /^ *$/)
+ {
+ print CLIENTNOTICE "Usage: /link list";
+ return;
+ }
+ print CLIENTNOTICE "The following pairs of channels are linked:";
+ my %shown = ();
+ foreach my $chatnet1 (sort keys %links)
+ {
+ foreach my $channel1 (sort keys %{$links{$chatnet1}})
+ {
+ next if $shown{$chatnet1}{$channel1};
+ my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}};
+ print CLIENTNOTICE "$chatnet1/$channel1 <-> $chatnet2/$channel2";
+ $shown{$chatnet2}{$channel2} = 1;
+ }
+ }
+};
+
+sub save_config()
+{
+ open CONFIG, ">", $config;
+ foreach my $chatnet1 (keys %links)
+ {
+ foreach my $channel1 (keys %{$links{$chatnet1}})
+ {
+ my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}};
+ print CONFIG "$chatnet1/$channel1 $chatnet2/$channel2\n";
+ }
+ }
+ close CONFIG;
+}
+
+Irssi::signal_add "setup saved", sub
+{
+ my ($main_config, $auto) = @_;
+ save_config unless $auto;
+};
+
+sub load_config()
+{
+ %links = ();
+ open CONFIG, "<", $config or return;
+ while (<CONFIG>)
+ {
+ chomp;
+ next if /^ *$/ || /^#/;
+ unless (m|^ *([^ /]+)/([^ ]+) +([^ /]+)/([^ ]+) *$|)
+ {
+ print CLIENTERROR "Syntax error in $config: $_";
+ return;
+ }
+ my ($chatnet1, $channel1, $chatnet2, $channel2) =
+ (lc $1, lc $2, lc $3, lc $4);
+ $links{$chatnet1}{$channel1} = [$chatnet2, $channel2];
+ }
+}
+
+Irssi::signal_add "setup reread", \&load_config;
+
+sub message($$)
+{
+ my ($chan, $msg) = @_;
+ $lock_own = 1;
+ $chan->{server}->command("msg $chan->{name} $msg");
+ $lock_own = 0;
+}
+
+sub special_message($$)
+{
+ my ($chan, $msg) = @_;
+ message $chan, "-!- $msg";
+}
+
+sub special_message_for($$$)
+{
+ my ($chan, $nick, $msg) = @_;
+ message $chan,
+ (defined $nick ? "$nick: " : "") .
+ "-!- $msg";
+}
+
+sub channel_context($$)
+{
+ my ($server1, $channel1) = @_;
+ my $chatnet1 = lc $server1->{chatnet};
+ my $chan1 = $server1->channel_find($channel1) or return undef;
+ my $other = $links{$chatnet1}{lc $channel1} or return undef;
+ my ($chatnet2, $channel2) = @{$other};
+ my $server2 = Irssi::server_find_chatnet($chatnet2) or return;
+ my $chan2 = $server2->channel_find($channel2) or return;
+ return {
+ chatnet1 => $chatnet1,
+ server1 => $server1,
+ channel1 => $channel1,
+ chan1 => $chan1,
+ chatnet2 => $chatnet2,
+ server2 => $server2,
+ channel2 => $channel2,
+ chan2 => $chan2,
+ };
+}
+
+sub channel_contexts_with_nick($$)
+{
+ my ($server1, $nick1) = @_;
+ my $chatnet1 = lc $server1->{chatnet};
+ return () unless $links{$chatnet1};
+ my @contexts = ();
+ foreach my $channel1 (keys %{$links{$chatnet1}})
+ {
+ my $chan1 = $server1->channel_find($channel1) or next;
+ next unless $chan1->nick_find($nick1);
+ my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}};
+ my $server2 = Irssi::server_find_chatnet($chatnet2) or next;
+ my $chan2 = $server2->channel_find($channel2) or next;
+ push @contexts, {
+ chatnet1 => $chatnet1,
+ server1 => $server1,
+ channel1 => $channel1,
+ chan1 => $chan1,
+ chatnet2 => $chatnet2,
+ server2 => $server2,
+ channel2 => $channel2,
+ chan2 => $chan2,
+ };
+ }
+ return @contexts;
+}
+
+sub must_be_op($$)
+{
+ my ($context, $nick) = @_;
+ unless (defined $nick ?
+ $context->{chan1}->nick_find($nick)->{op} :
+ $context->{chan1}->{chanop})
+ {
+ special_message_for $context->{chan1}, $nick,
+ "You're not channel operator in $context->{channel1}";
+ return 0;
+ }
+ unless ($context->{chan2}->{chanop})
+ {
+ special_message_for $context->{chan1}, $nick,
+ "Sorry, I'm not channel operator in $context->{channel2}";
+ return 0;
+ }
+ return 1;
+}
+
+sub change_mode($$$)
+{
+ my ($context, $nick, $mode) = @_;
+ return unless must_be_op($context, $nick);
+ special_message $context->{chan2},
+ "mode/$context->{channel2} [$mode] by $nick"
+ if defined $nick;
+ $context->{server2}->command("mode $context->{channel2} $mode");
+}
+
+sub change_perms($$$$$$)
+{
+ my ($command, $dir, $mode, $context, $nick, $args) = @_;
+ my @nicks = split ' ', $args;
+ unless (@nicks)
+ {
+ special_message_for $context->{chan1}, $nick,
+ "Usage: \\$command <nicks>";
+ return;
+ }
+ change_mode $context, $nick, $dir . $mode x @nicks . " @nicks";
+}
+
+sub names($$$)
+{
+ my ($context, $nick, $args) = @_;
+ my @nicks = $context->{chan2}->nicks();
+ my @ops = grep {$_->{op}} @nicks;
+ my @voices = grep {!$_->{op} && $_->{voice}} @nicks;
+ my @normal = grep {!$_->{op} && !$_->{voice}} @nicks;
+ my @list = (
+ map ({['@', $_]} sort {lc $a cmp lc $b} map {$_->{nick}} @ops),
+ map ({['+', $_]} sort {lc $a cmp lc $b} map {$_->{nick}} @voices),
+ map ({[' ', $_]} sort {lc $a cmp lc $b} map {$_->{nick}} @normal));
+ my $max_width = 62 - length $context->{server1}->{nick};
+ my $rows = 1;
+ my @column_widths;
+ while ($rows < @list)
+ {
+ @column_widths = ();
+ my $width = 0;
+ my $i = 0;
+ while ($i < @list)
+ {
+ my $column_width = 0;
+ foreach my $j ($i .. $i+$rows-1)
+ {
+ last if $j >= @list;
+ my $len = length $list[$j][1];
+ $column_width = $len if $column_width < $len;
+ }
+ push @column_widths, $column_width;
+ $width += $column_width + 4;
+ $i += $rows;
+ }
+ last if $width - 1 <= $max_width;
+ ++$rows;
+ }
+ my @output;
+ foreach my $i (0..$#list)
+ {
+ $output[$i % $rows] .=
+ sprintf "[%s%*s] ",
+ $list[$i][0], -$column_widths[int ($i / $rows)], $list[$i][1];
+ }
+ foreach my $row (@output)
+ {
+ chop $row;
+ message $context->{chan1}, $row;
+ }
+}
+
+my %commands =
+(
+ mode => sub
+ {
+ my ($context, $nick, $args) = @_;
+ unless ($args =~ /^ +\* +(.*)$/ ||
+ $args =~ /^ +\Q$context->{channel2}\E +(.*)$/)
+ {
+ special_message_for $context->{chan1}, $nick,
+ "Usage: \\mode * <mode> [<mode parameters>]";
+ return;
+ }
+ change_mode $context, $nick, $1;
+ },
+ op => sub {&change_perms('op', '+', 'o', @_)},
+ deop => sub {&change_perms('deop', '-', 'o', @_)},
+ voice => sub {&change_perms('voice', '+', 'v', @_)},
+ devoice => sub {&change_perms('devoice', '-', 'v', @_)},
+ kick => sub
+ {
+ my ($context, $nick, $args) = @_;
+ unless ($args =~ /^ +([^ ]+)(| .*)$/)
+ {
+ special_message_for $context->{chan1}, $nick,
+ "Usage: \\kick <nicks> [<reason>]";
+ return;
+ }
+ my ($nicks, $reason) = ($1, $2);
+ $reason = $reason =~ /^ ?$/ ? " $nick" : " <$nick>$reason"
+ if defined $nick;
+ return unless must_be_op($context, $nick);
+ $context->{server2}->command("kick $context->{channel2} $nicks$reason");
+ },
+ names => \&names,
+);
+
+sub run_command($$$$)
+{
+ my ($context, $nick, $command, $args) = @_;
+ my $func = $commands{lc $command};
+ unless ($func)
+ {
+ special_message_for $context->{chan1}, $nick,
+ "Unknown command: $command";
+ return;
+ }
+ $func->($context, $nick, $args);
+}
+
+Irssi::signal_add "message public", sub
+{
+ my ($server1, $msg, $nick, $address, $channel1) = @_;
+ my $context = channel_context($server1, $channel1) or return;
+ if ($msg =~ /^\\([^ ]+)(| .*)$/)
+ {
+ Irssi::signal_continue @_;
+ run_command $context, $nick, $1, $2;
+ }
+ elsif ($msg =~ /^<.[^ ]+> /)
+ {
+ print CLIENTERROR
+ "Warning! Channels $context->{chatnet1}/$context->{channel1} " .
+ "and $context->{chatnet2}/$context->{channel2} are linked twice.";
+ Irssi::command "beep";
+ }
+ else
+ {
+ my $nk = $context->{chan1}->nick_find($nick);
+ my $perm = $nk->{op} ? '@' : $nk->{voice} ? '+' : ' ';
+ message $context->{chan2}, "<$perm$nick> $msg";
+ }
+};
+
+Irssi::signal_add "message own_public", sub
+{
+ my ($server1, $msg, $channel1) = @_;
+ return if $lock_own;
+ my $context = channel_context($server1, $channel1) or return;
+ if ($msg !~ s/^\\ // && $msg =~ /^\\([^ ]+)(| .*)$/)
+ {
+ Irssi::signal_continue @_;
+ run_command $context, undef, $1, $2;
+ }
+ else
+ {
+ message $context->{chan2}, $msg;
+ }
+};
+
+Irssi::signal_add "message irc action", sub
+{
+ my ($server1, $msg, $nick, $address, $channel1) = @_;
+ my $context = channel_context($server1, $channel1) or return;
+ message $context->{chan2}, " * $nick $msg";
+};
+
+Irssi::signal_add "message irc own_action", sub
+{
+ my ($server1, $msg, $channel1) = @_;
+ return if $lock_own;
+ my $context = channel_context($server1, $channel1) or return;
+ $lock_own = 1;
+ $context->{server2}->command("action $context->{channel2} $msg");
+ $lock_own = 0;
+};
+
+Irssi::signal_add "message join", sub
+{
+ my ($server1, $channel1, $nick, $address) = @_;
+ my $context = channel_context($server1, $channel1) or return;
+ special_message $context->{chan2},
+ "$nick [$address] has joined $channel1";
+};
+
+Irssi::signal_add "message part", sub
+{
+ my ($server1, $channel1, $nick, $address, $reason) = @_;
+ my $context = channel_context($server1, $channel1) or return;
+ special_message $context->{chan2},
+ "$nick [$address] has left $context->{channel1} [$reason]";
+};
+
+Irssi::signal_add "message quit", sub
+{
+ my ($server1, $nick, $address, $reason) = @_;
+ foreach my $context (channel_contexts_with_nick($server1, $nick))
+ {
+ special_message $context->{chan2},
+ "$nick [$address] has quit [$reason]";
+ }
+};
+
+Irssi::signal_add "message topic", sub
+{
+ my ($server1, $channel1, $topic, $nick, $address) = @_;
+ return if $nick eq $server1->{nick};
+ my $context = channel_context($server1, $channel1) or return;
+ if ($topic eq "")
+ {
+ special_message $context->{chan2},
+ "Topic unset by $nick on $context->{channel1}";
+ $context->{server2}->command("topic -delete $context->{channel2}");
+ }
+ else
+ {
+ special_message $context->{chan2},
+ "$nick changed the topic of $context->{channel1} to: $topic";
+ $context->{server2}->command("topic $context->{channel2} $topic");
+ }
+};
+
+Irssi::signal_add "message nick", sub
+{
+ my ($server1, $newnick, $oldnick, $address) = @_;
+ foreach my $context (channel_contexts_with_nick($server1, $newnick))
+ {
+ special_message $context->{chan2},
+ "$oldnick is now known as $newnick";
+ }
+};
+
+Irssi::signal_add "message own_nick", sub
+{
+ my ($server1, $newnick, $oldnick, $address) = @_;
+ foreach my $context (channel_contexts_with_nick($server1, $newnick))
+ {
+ next if $context->{chatnet1} eq $context->{chatnet2};
+ special_message $context->{chan2},
+ "$oldnick is now known as $newnick";
+ }
+};
+
+Irssi::signal_add "message kick", sub
+{
+ my ($server1, $channel1, $nick, $kicker, $address, $reason) = @_;
+ my $context = channel_context($server1, $channel1) or return;
+ special_message $context->{chan2},
+ "$nick was kicked from $context->{channel1} " .
+ "by $kicker [$reason]";
+};
+
+Irssi::signal_add "event mode", sub
+{
+ my ($server1, $data, $nick) = @_;
+ $data =~ /^([^ ]*) (.*)$/ or return;
+ my ($channel1, $mode) = ($1, $2);
+ my $context = channel_context($server1, $channel1) or return;
+ special_message $context->{chan2},
+ "mode/$context->{channel1} [$mode] by $nick";
+};
+
+load_config;
+
diff --git a/scripts/listen.pl b/scripts/listen.pl
new file mode 100644
index 0000000..0a07a46
--- /dev/null
+++ b/scripts/listen.pl
@@ -0,0 +1,163 @@
+use strict;
+use Irssi;
+use Irssi::Irc;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.3";
+%IRSSI = (
+ authors => "Csaba Nagy",
+ contact => "lordpyre\@negerno.hu",
+ name => "listen",
+ description => "A simple mp3 display script that will display what mp3 you are playing in which software (mpg123, xmms, mp3blaster, etc) to your active channel or to a query window.",
+ license => "GNU GPLv2 or later",
+ changed => "2019-02-22"
+);
+
+# Usage: 1, load the script
+# 2, personalize the settings
+# - listen_use_action -> if "on" the script will issue an action
+# to let otherones know what you are listening to
+# if "off" it will use a simple msg
+# - listen_prefix -> the output of the script will look like:
+# '/me $listen_prefix $listen_tagorder' if the
+# mp3file has idtags. otherwise the output will be:
+# '/me $listen_prefix $mp3filename'
+# - listen_tagorder -> the perfect order of the tags? ;)
+# for example: '%ARTIST (%ALBUM) - %TITLE (%PLAYER)'
+# you can specify: %TITLE, %ALBUM, %ARTIST, %GENRE,
+# %COMMENT, %PLAYER
+# 3, use /listen
+# 4, have phun =)
+#
+# Programs needed:
+# - lsof - ftp://vic.cc.purdue.edu/pub/tools/unix/lsof
+# - id3 - http://frantica.lly.org/~rcw/id3/
+# LordPyre
+
+
+# list of supported mp3 players
+# if you would like to use the script with other players, just type these
+# name into the list below... it will probably work :)
+my @mp3players=("mpg123", "mpg321", "xmms", "mp3blaster", "alsaplayer", "audacious");
+my ($mp3player, $mp3file);
+my @line;
+my %idtag;
+
+################## PLZ DON'T CHANGE ANYTHING BELOW THIS LINE ##################
+# or do it on your own risk!!
+
+sub default_values {
+ $mp3player="nope";
+ $mp3file="nope";
+ %idtag=("Title", "Unknown Title",
+ "Album", "Unknown Album",
+ "Artist", "Unknown Artist",
+ "Genre", "Unknown Genre",
+ "Comment","No Comment");
+}
+
+sub getmp3filename {
+ open(CSOCS, "-|", $_[0]);
+ GECMO: while (<CSOCS>) {
+ chop;
+ (@line) = split(/\s/,$_);
+ # we check wheter the mp3file returned by lsof has been opened
+ # with a known mp3player or not
+ HMM: foreach my $w (@mp3players) {
+ # if yes we save it, and leave
+ if ($w =~ /^$line[0]/) {
+ $mp3player=$w;
+ last HMM;
+ }
+ }
+ # if we have found one player 'turned on', we don't have to
+ # check the other results of lsof, so we can leave
+ if ($mp3player ne "nope") {
+ $_ =~ m#(/.*)$#;
+ $mp3file=$1;
+ last GECMO;
+ }
+ }
+ close(CSOCS);
+}
+
+sub getmp3proces {
+ # most of the players put the file into the memory at first,
+ # let's try to catch it there, first
+ getmp3filename("lsof -d mem | grep -i .mp3");
+ # if we didn't find anything there, we check the fds for mp3s
+ if ($mp3player eq "nope") {
+ getmp3filename("lsof -d 1-15 | grep -i \\.mp3");
+ }
+
+ # hmm are we listening to anything?
+ if ($mp3player eq "nope") {
+ Irssi::print("Hmm are you listening to anything? (possibly not supported mp3player)");
+ return 0;
+ }
+
+ # the only problem can happen to us, if the string we got from lsof
+ # isn't a real mp3file (this may happen for example if there are \x20
+ # chars in the filename). so let's check it!
+ if (!(-e $mp3file && -r $mp3file)) {
+ Irssi::print("Damn! Nonexistent filename. (maybe spaces in it?)");
+ return 0;
+ }
+ return 1;
+}
+
+sub getmp3idtags {
+ # getting the idtags from file
+ open(ID3GECMO, '-|', 'id3', '-R', $mp3file);
+ while (<ID3GECMO>) {
+ chop;
+ foreach my $kulcs (keys %idtag) {
+ if ($_=~ /^$kulcs/) {
+ s/^$kulcs://; s/\s*$//; s/^\s*//;
+ if ($_) { $idtag{$kulcs}=$_; }
+ }
+ }
+ }
+ close(ID3GECMO);
+}
+
+sub do_listen {
+ #setting up variables
+ my ($data, $server, $witem) = @_;
+ default_values();
+ if (!getmp3proces()) { return };
+ getmp3idtags();
+ my $outtext;
+
+ # if there's no usable idtag in the mp3 we use the filename
+ if (($idtag{"Artist"} eq "Unknow Artist") && ($idtag{"Title"} eq "Unknown Title")) {
+ $outtext=$mp3file;
+ } else {
+ # if the file is tagged we parse over the tagorder
+ $outtext=Irssi::settings_get_str("listen_tagorder");
+ foreach my $w (keys %idtag) {
+ $outtext=~s/%$w/$idtag{$w}/i;
+ }
+ $outtext=~s/%player/$mp3player/i;
+ }
+
+ my $prefix=Irssi::settings_get_str("listen_prefix");
+
+ if (Irssi::settings_get_bool("listen_use_action")) {
+ $outtext="ME ".$prefix." ".$outtext;
+ } else {
+ $outtext="MSG ".$witem->{name}." ".$prefix." ".$outtext;
+ }
+ # let's write the result to everyone
+ if ($witem && ($witem->{type} eq "CHANNEL" || $witem->{type} eq "QUERY")) {
+ $witem->command($outtext);
+ }
+}
+
+# setting irssi enviroments
+Irssi::command_bind("listen", "do_listen");
+Irssi::settings_add_bool("listen","listen_use_action",1);
+Irssi::settings_add_str("listen","listen_prefix","is listening to");
+Irssi::settings_add_str("listen","listen_tagorder","%ARTIST (%ALBUM) - %TITLE (%PLAYER)");
+
+print CLIENTCRAP "%B>>%n ".$IRSSI{name}." v".$VERSION." loaded... (command: /listen)";
diff --git a/scripts/loadavg.pl b/scripts/loadavg.pl
new file mode 100644
index 0000000..44e7ac4
--- /dev/null
+++ b/scripts/loadavg.pl
@@ -0,0 +1,47 @@
+# system load average statusbar item
+# using vm.loadavg mib or /proc/loadavg
+#
+# /statusbar window add loadavg
+# /set loadavg_refresh
+
+use strict;
+use Irssi;
+use Irssi::TextUI;
+use vars qw($VERSION %IRSSI);
+
+$VERSION="0.4";
+%IRSSI = (
+ authors => 'aki',
+ contact => 'aki@evilbsd.info',
+ name => 'loadavg',
+ description => 'display a loadavg statusbar item using vm.loadavg mib or /proc/loadavg',
+ sbitems => 'loadavg',
+ license => 'public domain',
+);
+
+my ($timeout, $lavg);
+
+sub reload { Irssi::statusbar_items_redraw('loadavg'); }
+
+sub setup {
+ my $time = Irssi::settings_get_int('loadavg_refresh');
+ Irssi::timeout_remove($timeout);
+ $timeout = Irssi::timeout_add($time, 'reload' , undef);
+}
+
+sub show {
+ my ($item, $get_size_only) = @_;
+ get(); chomp $lavg;
+ $item->default_handler($get_size_only, "{sb ".$lavg."}", undef, 1);
+}
+
+sub get {
+ if ($^O eq 'freebsd' || $^O eq 'netbsd' || $^O eq 'openbsd' ) {
+ $lavg=`sysctl vm.loadavg|cut -d" " -f3-5`;
+ } elsif ($^O eq 'linux') { $lavg=`cat /proc/loadavg|cut -d" " -f1-3`; }
+}
+
+Irssi::statusbar_item_register('loadavg', '$0', 'show');
+Irssi::settings_add_int('misc', 'loadavg_refresh', 15000);
+Irssi::signal_add('setup changed', 'setup');
+$timeout = Irssi::timeout_add(Irssi::settings_get_int('loadavg_refresh'), 'reload' , undef);
diff --git a/scripts/localize.pl b/scripts/localize.pl
new file mode 100644
index 0000000..b836c92
--- /dev/null
+++ b/scripts/localize.pl
@@ -0,0 +1,1642 @@
+#!/usr/bin/perl
+#
+#
+# By Stefan 'tommie' Tomanek, stefan@kann-nix.org
+#
+#
+# This script works fine on DFN (german universities) and T-Oline sites
+#
+# 01.03.2002
+# *Changed to GPL
+#
+# 15.03.2002
+# *Now works on QUERIES as well
+#
+# 24.04.2002
+# *the nick does not have to be on the channel
+# *switched to /WHO
+#
+# 27.04.2002
+# *localization of hosts (/localize @hostname)
+#
+# 29.04.2002
+# *tweaked Design
+# *added channel statistics
+#
+# 04.05.2002
+# *added alternate database (IP Atlas)
+#
+# 05.05.2002
+# *the script is now able to use both databases simultaniously
+# */set localize_use_<database> to enable or disable them
+#
+# 10.05.2002
+# *non-blocking IO via fork()
+#
+# 13.05.2002
+# *finally improved forking and background localizing
+# *now using XML
+#
+# 26.05.2002
+# *Implemented auto-localize
+#
+# 28.05.2002
+# *major updates
+# *fixed race conditions
+#
+# 30.05.2002
+# *finally rendered traceroute support usefull
+#
+# 31.05.2002
+# *moved database to this file
+#
+# 03.07.2002
+# *switched to Data::Dumper
+#
+# 25.11.2014
+# Added utrace.de as a localizer
+# http://www.utrace.de/
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "2017040101";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "localize",
+ description => "Localizes users using traceroute, the localizer database or IP-Atlas",
+ license => "GPLv2",
+ url => "",
+ changed => "$VERSION",
+ modules => "Data::Dumper LWP::UserAgent HTML::Entities",
+ commands => "localize"
+);
+
+use Irssi 20020324;
+use LWP::UserAgent;
+use HTML::Entities;
+use Data::Dumper;
+use POSIX;
+use Socket;
+
+use vars qw(%queries %cache %ipdb $procs @tracer $debug);
+$debug = 0;
+$procs = 0;
+
+
+# host regexps for trace_host
+#
+
+@tracer = (
+ { provider => 'tonline',
+ regexp => [ '.*?-.*?\.(.*?)(\.DE|)\.net\.dtag\.de', ]
+ },
+ { provider => 'uunet',
+ regexp => [ '.*?-\d+-\d+\..*?\.(.*?)\d?\.uunet\.de', ]
+ },
+ { provider => 'kpnqwest',
+ regexp => [ '.*?-.*?\.(\w?)\.de\.kpnqwest\.net', ]
+ },
+ { provider => 'ewetel',
+ regexp => [ '.*?-.*?-.*?\.rt8\.(.*?)\.ewetel\.net',
+ '(.*?)[0-9]*-.*?\.ewetel\.net',
+ 'so\d+-\d+-\d+-bbrt\d+\.(.*?)\.ewe-ip-backbone\.de']
+ },
+ { provider => 'arcor',
+ regexp => [ '((?!dsl)\w+)-\d+-\d+-\d+-\d+\.arcor-ip\.net',
+ '.*?-(.*?)-.*?\d*\.arcor-online\.net']
+ },
+ { provider => 'mediaways',
+ regexp => ['.*-(.*)-de.*-.*-.*-.*\..*\.mediaways.net', ]
+ },
+ { provider => 'mobilcom',
+ regexp => ['.*\.(.*?)[0-9]+-.\.mcbone\.net',]
+ },
+ { provider => 'vianetworks',
+ regexp => ['\w+\.(.*?)\.revmap\.vianetworks\.de',
+ 'rt\d{3}(.*?)\.de\.vianw\.net',]
+ },
+ { provider => 'mfnx',
+ regexp => ['.+-\d+-\d+-\d+\..+\.(.*?)[0-9]+\.de\.mfnx\.net',]
+ },
+ { provider => 'colt',
+ regexp => ['.+-.*\..+\.(.*?)\.DE.COLT-ISC.NET',
+ '.+\.((?!dsl)(?!host)\w+)\.de\.colt\.net',
+ '..\d\.(\w+)\.de\.colt\.net',]
+ },
+ { provider => 'telia',
+ regexp => ['(.*?)-.+-.+-.+\.telia.net',]
+ },
+ { provider => 'hansanet',
+ regexp => ['.*\.(.*?)-[0-9]+\.hansenet\.net',]
+ },
+ { provider => 'isis',
+ regexp => ['isis-gw-(.*?)[0-9]\.de\.cw\.net', ]
+ },
+ { provider => 'cable & wireless',
+ regexp => ['.*-\d+-\d+-\d+-.*?-(.*?)\d+\.de\.cw\.net',
+ '.*?-.*?-(.*?)\d+\.de\.cw\.net']
+ },
+ { provider => 'NEFkom',
+ regexp => ['nefkom-gw-(.*?)\.de\.cw\.net',]
+ },
+ { provider => 'eastlink',
+ regexp => ['.*?-.*?-.*?-.*?-(.*?)\.eastlink.de',]
+ },
+ { provider => 'alternet',
+ regexp => ['.*\.(.*?)\d?\.de\.alter\.net',]
+ },
+ { provider => 'CompleTel',
+ regexp => ['.+-.+-.+-.+\.(.*)\.ipcenta\.de',]
+ },
+ { provider => 'mediascape',
+ regexp => ['.+\..+\.(.*?)\.mediascape\.net',]
+ },
+ { provider => 'schlund',
+ regexp => ['gw-prtr-[0-9]+-.+\.(.+)[0-9]+\.schlund.net',]
+ },
+ { provider => 'bisping',
+ regexp => ['(.*?)-gw-pmx[0-9]*\.bisping\.net',]
+ },
+ { provider => 'gatel',
+ regexp => ['ser[0-3]+-[0-3]+\.(.*?)[0-3]+\.de\.gatel\.net',]
+ },
+ { provider => 'qsc',
+ regexp => ['rqsc-(.*?)-de[0-9]+-.+[0-9]+-[0-9]+-[0-9]+\.nw\.mediaways\.net',
+ 'bsn\d+\.(.*?)\.qdsl-home\.de',
+ 'bsn\d+\.(.*?)\.qsc\.de',
+ 'core1\.(.*?)\.qsc\.de']
+ },
+ { provider => 'dfn',
+ regexp => ['.r-(.*?)[0-9]+\.g-win.dfn.de',
+ '.*\.uni-(.*?)\.de',
+ '.*\.fh-(.*?)\.de',
+ '.*\.tu-(.*?)\.de',
+ '.*\.fu-(.*?)\.de',]
+ },
+ { provider => 'mops.net',
+ regexp => ['.*?\.core\d\.(.*?)\.mops\.net',]
+ },
+ { provider => 'schule.de',
+ regexp => ['.*\.(.*?)\..*?\.Schule\.DE',]
+ },
+ { provider => 'belwue',
+ regexp => ['(?:.*?-)?(.*?)\d+\.BelWue\.DE',]
+ },
+ { provider => 'lambdanet',
+ regexp => ['.*?\.(.*?)\.de\.lambdanet\.net',]
+ }
+);
+
+%ipdb = (
+ # For utrace.de API documentation, see http://en.utrace.de/api.php
+ d1utrace=>{ name=>'utrace',
+ active=>1,
+ url=>'http://xml.utrace.de/?query=',
+ city=>'<region>(.*?)<\/region>',
+ province=>'<org>(.*?)<\/org>',
+ country=>'<countrycode>(.*?)<\/countrycode>',
+ provider=>'<isp>(.*?)<\/isp>',
+ failure=>'request-limit-exceeded|Host not found'},
+ d2ipatlas=> { name=>'IP-Atlas',
+ active=>0,
+ url=>'http://www.xpenguin.com/plot.php?address=',
+ city=>'is located in (.*?),',
+ province=>'is located in.*, (.*?) \(state\),',
+ country=>'is located in.*, (.*?)\. ',
+ failure=>'cannot be located|does not resolve' },
+ d3netgeo => { name=>'NetGeo',
+ active=>0,
+ url=>'http://netgeo.caida.org/perl/netgeo.cgi?target=',
+ city=>'CITY:\ *(\w+)<br>',
+ province=>'STATE:.*?, (.*?) \(state\)<br>',
+ country=>'COUNTRY:\ *(\w+)<br>',
+ failure=> "SHOULD NOT"},
+);
+
+sub draw_box ($$$) {
+ my ($title, $text, $footer) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ return $box;
+}
+
+sub show_help() {
+ my $help="Localize $VERSION
+/localize <nickname>
+ Try to localize the user 'nickname'
+/localize @<hostname>
+ Try to localize the host
+/localize <#channel>
+ Create a tree of the people inside the channel
+/localize -s
+ Save the localize cache and settings
+/localize -r
+ Reload the localize cache from file
+/localize -c
+ Clear the cache
+/localize -sc
+ Shows the current content of the cache
+/localize -h
+ Display this help
+";
+ my $text = "";
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP draw_box("Localize", $text, "Help");
+}
+
+sub get ($) {
+ my ($url) = @_;
+ my $ua = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1,timeout => 30);
+ $ua->agent('Irssi');
+ my $request = HTTP::Request->new('GET', $url);
+ my $response = $ua->request($request);
+ if ($response->is_success()) {
+ return $response->content();
+ } else {
+ return undef;
+ }
+}
+
+sub parse_page ($$) {
+ my ($page, $item) = @_;
+ my %empty;
+ my (%location);
+ $_ = $page;
+ my $regexp = $item->{failure};
+ return(%location) if /$regexp/;
+ foreach my $key ('city', 'province', 'country') {
+ $location{$key} = '';
+ my $regexp = $item->{$key};
+ if (/$regexp/) {
+ $location{$key} = $1;
+ } else {
+ return(%empty);
+ }
+ }
+ if (defined $item->{provider}) {
+ if (/$item->{provider}/) {
+ $location{provider} = $1;
+ }
+ }
+ $location{map} = $item->{name} if (%location);
+ return (%location);
+}
+
+sub trace_host ($) {
+ my ($host) = @_;
+ my $cmd = Irssi::settings_get_str('localize_trace_cmd');
+ local *F;
+ my $pid = open(F, '-|', $cmd.' '.$host.' 2>/dev/null');
+ my $loc_host;
+ my $provider;
+ my $hops = 0;
+ my $maxhops = Irssi::settings_get_int('localize_trace_distance');
+ $_ = $host;
+ while (defined $_) {
+ print $_ if $debug;
+ $hops++;
+ if (/\*/) {
+ kill 15, $pid;
+ close(F);
+ return([$loc_host, $provider]) if ($hops < $maxhops && $hops >= 0);
+ return([undef, undef]);
+ } else {
+ foreach my $traced (@tracer) {
+ foreach my $regexp (@{$traced->{regexp}}) {
+ if (/[0-9]+ $regexp /i) {
+ $loc_host = $1;
+ $provider = $traced->{provider};
+ print $regexp if $debug;
+ print "$loc_host <-> $provider" if $debug;
+ $hops = 0;
+ last;
+ }
+ }
+ }
+ }
+ $_ = <F>;
+ }
+ close(F);
+ if ( ($hops < $maxhops) && ($hops >= 0)) {
+ if ($debug) {
+ print $loc_host."-".$provider foreach (1..10);
+ }
+ return([$loc_host, $provider]);
+ } else {
+ print $hops." -> ".$maxhops if $debug;
+ }
+ return([undef, undef]);
+}
+
+sub localize($$) {
+ my ($nicks, $query) = @_;
+ if (Irssi::settings_get_bool('localize_background')) {
+ bg_fetch($nicks, $query);
+ } else {
+ fg_fetch($nicks, $query);
+ }
+}
+
+sub fg_fetch ($$) {
+ my ($nicks, $query) = @_;
+ my $data = create_output(@{$nicks});
+ my $auto = $queries{$query}->[0]{auto};
+ remove_request($query);
+ process_input($query, $auto, $data);
+}
+
+sub bg_fetch ($$) {
+ my ($nicks, $query) = @_;
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ my $pid = fork();
+ $procs++;
+ if ($pid > 0) {
+ close $wh;
+ my $size = scalar(@{$nicks});
+ my $auto = $queries{$query}->[0]{auto};
+ remove_request($query);
+ unless ($auto ne '') {
+ print CLIENTCRAP '%R>>%n Localizing '.$size.' host(s) in background [pid '.$pid.']...' if Irssi::settings_get_bool('localize_show_message');
+ }
+ Irssi::pidwait_add($pid);
+ my $pipetag;
+ my @args = ($rh, $query, $auto, \$pipetag);
+ $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
+ } else {
+ my $data = create_output(@{$nicks});
+ eval {
+ print($wh $data);
+ close($wh)
+ };
+ POSIX::_exit(1);
+ }
+}
+
+
+sub create_output(@) {
+ my (@nicks) = @_;
+ my @new_db;
+ my @stuff;
+ my @data;
+ my $i = 0;
+ foreach (@nicks) {
+ my $nick = $$_[0];
+ my $host = $$_[1];
+ my (%location);
+ if (defined $cache{$host}) {
+ %location = %{$cache{$host}};
+ $location{$_} = $location{$_} foreach (keys %location);
+ $location{'map'} .= " (cached)";
+ } else {
+ if (Irssi::settings_get_bool('localize_use_traceroute')) {
+ unless (%location) {
+ my ($sign, $provider) = @{ trace_host($host) };
+ print "\n\n>>>>".$sign if $debug;
+ %location = kfz2location($sign) if $sign;
+ $location{map} = 'traceroute' if (%location);
+ $location{provider} = $provider if (%location);
+ }
+ }
+ if (Irssi::settings_get_bool('localize_use_databases')) {
+ unless (%location) {
+ foreach (sort keys(%ipdb)) {
+ my $item = $ipdb{$_};
+ next unless $item->{active};
+ #my $ip = gethostbyname($host);
+ #next unless $ip;
+ my $url = $item->{url}.$host; #inet_ntoa($ip);
+ my $text = get($url);
+ %location = parse_page($text, $item);
+ }
+ }
+ }
+ if (Irssi::settings_get_bool('localize_get_coordinates')) {
+ if (%location) {
+ my $city = $location{city};
+ my $ua = LWP::UserAgent->new(env_proxy=>1, keep_alive=>1, timeout=>30);
+ my $data = $ua->get('http://www.astro.com/atlas/horoscope/?expr='.$city)->content();
+ foreach (split /\n/, $data) {
+ decode_entities($_);
+ if (/^<li><a href="\/cgi\/ade\.cgi\?&(?:.*?)">(.*?)<\/a>, (?:.*?): <b>(\d+)n(\d+)<\/b>, <b>(\d+)e(\d+)<\/b>/i) {
+ $location{latitude} = "$2.$3";
+ $location{longitude} = "$4.$5";
+ last;
+ }
+ }
+ }
+ }
+ }
+ $location{'nick'} = $nick if (%location);
+ $location{'host'} = $host if (%location);
+ #$location{$_} = $location{$_} foreach (keys %location);
+ push @stuff, \%location;
+ $i++;
+ }
+ my %foo = ("nicks" => \@stuff);
+ my $dumper = Data::Dumper->new([\%foo]);
+ $dumper->Purity(1)->Deepcopy(1);
+ my $data = $dumper->Dump;
+ return($data);
+}
+
+sub pipe_input ($$$$) {
+ my ($rh, $query, $auto, $pipetag) = @{$_[0]};
+ my @lines = <$rh>;
+ close($rh);
+ Irssi::input_remove($$pipetag);
+ my $text = join("", @lines);
+ process_input($query, $auto, $text);
+}
+
+sub process_input($$$) {
+ my ($query, $auto, $text) = @_;
+ my $channel_prefix = '^(\#|\+|\!)';
+ my %stuff;
+ $procs--;
+ no strict;
+ %stuff = %{ eval "$text" };
+ return(0) unless (%stuff);
+ my @items = @{$stuff{nicks}};
+ my %channel;
+ foreach (@items) {
+ my %location = %{$_};
+ if (not %location) {
+ unless ($query =~ /$channel_prefix/) {
+ print CLIENTCRAP '%R>>%n Unable to localize '.$query if ($auto eq '');
+ }
+ } else {
+ my $nocache = Irssi::settings_get_str('localize_ipatlas_nocache');
+ add_to_cache(%location) unless ($location{'map'} eq 'IP-Atlas' && $location{'host'} =~ /$nocache/);
+
+ $location{$_} = $location{$_} foreach (keys %location);
+ my $nick = $location{'nick'};
+ if ($query =~ /$channel_prefix/) {
+ push @{ $channel{$location{"country"}}{$location{"province"}}{$location{"city"}} }, [$nick, $location{"map"}];
+ } else {
+ if ($auto eq '') {
+ show_location(%location);
+ } else {
+ auto_localize($auto, %location);
+ }
+ }
+ #remove_request($query);
+ }
+ }
+ if ($query =~ /$channel_prefix/) {
+ show_cities($query, %channel);
+ }
+}
+
+sub add_to_cache (%) {
+ my (%location) = @_;
+ my $host = $location{'host'};
+ return if defined $cache{$host};
+ foreach (keys %location) {
+ next if ($_ eq 'nick' || $_ eq 'host');
+ $cache{$host}{$_} = $location{$_};
+ }
+}
+
+sub save_cache {
+ my $filename = Irssi::settings_get_str('localize_cache_filename');
+ my $data = Dumper(\%cache);
+ local *F;
+ open(F, '>',$filename);
+ print(F $data);
+ close(F);
+ print CLIENTCRAP "%R>>%n localize cache (".scalar(keys(%cache))." entries/".length($data)." bytes) saved to ".$filename;
+}
+
+sub load_cache {
+ no strict;
+ my $filename = Irssi::settings_get_str('localize_cache_filename');
+ my (%new_cache, $text);
+ local *F;
+ open F, "<",$filename || return;
+ $text .= $_ foreach (<F>);
+ close(F);
+ eval { %new_cache = %{ eval "$text" }; };
+ foreach (keys %new_cache) {
+ $cache{$_} = $new_cache{$_} unless defined $cache{$_};
+ }
+ print CLIENTCRAP "%R>>%n localize cache (".scalar(keys %new_cache)." hosts) loaded";
+}
+
+sub clear_cache {
+ foreach (keys(%cache)) {
+ delete $cache{$_};
+ }
+ print CLIENTCRAP "%R>>%n localize cache cleared";
+}
+
+sub show_location (%) {
+ my (%location) = @_;
+ my $query = Irssi::query_find($location{"nick"});
+ my $output = \&Irssi::print;
+ $output = sub { $query->print(@_); } if ($query);
+ my $text = "";
+ my $headline = '%R,--[%n%9%ULocation of '.$location{"nick"}." (".$location{"host"}.")%U%9%R]%n";
+ foreach ('Country', 'Province', 'City', 'Provider') {
+ my $fill = ' 'x(9-length($_));
+ $text .= '%B'.$fill.$_.':%n '.$location{lc $_}."\n" if defined $location{lc $_};
+ }
+ #$text .= $location{latitude}."/".$location{longitude};
+ &$output(draw_box('Location of '.$location{nick}.' ('.$location{host}.')', $text, $location{map}), MSGLEVEL_CLIENTCRAP);
+ show_map($location{latitude}, $location{longitude}, $location{nick}) if Irssi::settings_get_bool('localize_xplanet_show_map');
+}
+
+sub show_map ($$$) {
+ my ($lat, $long, $nick) = @_;
+ return unless defined $lat && defined $long;
+ my $cmd = Irssi::settings_get_str('localize_xplanet_cmd');
+ my $file = Irssi::settings_get_str('localize_xplanet_temp_file');
+ local *F;
+ open F, '>',$file;
+ print F $lat.' '.$long.' "'.$nick.'"';
+ close F;
+ system("$cmd -markerf $file &");
+}
+
+sub show_cities ($%) {
+ my ($channel, %cities) = @_;
+ print CLIENTCRAP "%R,---[%n%9%U".$channel."%U%9%R]%n";
+ foreach (sort keys %cities) {
+ print CLIENTCRAP "%R+-+[%n".$_."%R]%n";
+ print CLIENTCRAP "%R| | %n";
+ my $n_provs = scalar( keys %{$cities{$_}});
+ foreach my $province (sort keys %{$cities{$_}}) {
+ my $cp = '|';
+ $cp = ' ' if ($n_provs == 1);
+ print CLIENTCRAP "%R| +-+%n"."%R[%n".$province."%R]%n";
+ my $n_cities = scalar(keys %{$cities{$_}{$province}});
+ foreach my $city (sort keys %{$cities{$_}{$province}}) {
+ my $cc = '|';
+ $cc = ' ' if ($n_cities == 1);
+ print CLIENTCRAP "%R| $cp +-+%n"."%R[%n".$city."%R]%n";
+ my $n_nicks = scalar(@{$cities{$_}{$province}{$city}});
+ foreach my $nick (sort @{$cities{$_}{$province}{$city}}) {
+ my $cn = '|`';
+ $cn = '`-' if ($n_nicks == 1);
+ print CLIENTCRAP "%R| $cp $cc $cn-----%n%B[%n".$nick->[0]."%B]%n";
+ $n_nicks--;
+ }
+ $n_cities--;
+ }
+ print CLIENTCRAP "%R| $cp ";
+ $n_provs--;
+ }
+ #print CLIENTCRAP "%R| ";
+ }
+ print CLIENTCRAP "%R`----->%n";
+}
+
+
+sub cmd_localize ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @names = split(/ /, $args);
+ foreach (@names) {
+ if ( substr($_, 0, 1) eq '@' ) {
+ my $ip = substr(lc($_), 1);
+ new_request($server, $ip, 2, '');
+ localize([[$ip, $ip]], $ip);
+ } elsif ($_ eq '-h') {
+ show_help();
+ } elsif ($_ eq '-c') {
+ clear_cache();
+ } elsif ($_ eq '-s') {
+ save_cache();
+ } elsif ($_ eq '-r') {
+ load_cache();
+ } elsif ($_ eq '-sc') {
+ show_cache(@names);
+ return();
+ } else {
+ new_request($server, lc($_), 0, '');
+ }
+ }
+}
+
+sub show_cache (@) {
+ my (@params) = @_;
+ unless (defined $params[1] && $params[1] eq '-i_am_insane') {
+ my $entries = scalar(keys(%cache));
+ print CLIENTCRAP '%R>>%n There are '.$entries.' saved locations in the cache. If you really want to display them all, type /localize -sc -i_am_insane';
+ } else {
+ my $text = "";
+ foreach my $key (sort keys %cache) {
+ my %item = %{$cache{$key}};
+ $item{$_} = $item{$_} foreach (keys %item);
+ my $string .= $key;
+ foreach ('country', 'province', 'city', 'map') {
+ $string .= ' | '.$item{$_};
+ }
+ $text .= $string."\n";
+ }
+ print CLIENTCRAP draw_box("Localize Cache", $text, "cache listing");
+ }
+}
+
+sub process_reply ($$$$) {
+ my ($server, $args, $sender, $address) = @_;
+ if ($args =~ /^(.*?) (.*?) (.*?) (.*?) (.*?) (.*?) (.*?)/) {
+ if (defined $queries{lc $6} && scalar(@{$queries{lc $6}}) > 0) {
+ foreach (@{$queries{lc $6}}) {
+ my %query = %{$_};
+ next unless ($query{status} <2);
+ Irssi::signal_stop();
+ push @{${$_}{buffer}},[$6, $4];
+ ${$_}{status} = 1;
+ }
+ } elsif (defined $queries{lc $2} && scalar(@{$queries{lc $2}}) > 0) {
+ foreach (@{$queries{lc $2}}) {
+ my %query = %{$_};
+ next unless ($query{status} <2);
+ Irssi::signal_stop();
+ push @{${$_}{buffer}},[$6, $4];
+ ${$_}{status} = 1;
+ }
+ }
+ } elsif ($args =~ /^(.*?) (.*?) :End of (|\/)WHO list\./) {
+ my ($self, $target) = ($1, $2);
+ return unless (defined $queries{lc $target} && scalar(@{$queries{lc $target}}) > 0);
+ my $needed = 0;
+ foreach (@{$queries{lc $target}}) {
+ my %query = %{$_};
+ $needed = 1 if $query{status} < 2;
+ next unless ($query{status} == 1);
+ if ($query{status} == 1) {
+ Irssi::signal_stop;
+ $query{status} = 2;
+ localize \@{$query{buffer}}, $target;
+ delete $query{buffer};
+ return();
+ }
+ }
+ if ($needed) {
+ Irssi::signal_stop;
+ unless ($queries{lc $target}[0]{auto} ne '') {
+ print CLIENTCRAP '%R>>%n No such nick '.$target;
+ }
+ remove_request($target);
+ }
+ }
+}
+
+sub event_message_join ($$$$) {
+ my ($server, $channel, $nick, $address) = @_;
+ return() unless Irssi::settings_get_bool('localize_auto_localize_on_join');
+ my $maxreq = Irssi::settings_get_int('localize_auto_localize_maxrequests');
+ my $channels = Irssi::settings_get_str('localize_auto_localize_channel_list');
+ if ($channel =~ /$channels/i) {
+ $address =~ /(.*)@(.*)/;
+ my $host = $2;
+ if ($procs < $maxreq) {
+ new_request($server, $nick, 2, lc($channel));
+ localize([[lc($nick), $host]], lc($nick));
+ } else {
+ #Irssi::print "%R>>%n Too many processes running";
+ }
+ }
+}
+
+sub event_query_created($$) {
+ my ($query, $auto) = @_;
+ my $nick = $query->{name};
+ my $server = $query->{server};
+ my $maxreq = Irssi::settings_get_int('localize_auto_localize_maxrequests');
+ return(0) unless (scalar(keys %queries) < $maxreq && Irssi::settings_get_bool('localize_auto_localize_on_query'));
+ $nick = substr($nick, 1) if (substr($nick, 0, 1) eq '=');
+ new_request($server, $nick, 0, lc($query->{name}));
+}
+
+sub auto_localize ($%) {
+ my ($auto, %location) = @_;
+ my $nick = lc($location{'nick'});
+ my $channel = Irssi::window_item_find($auto);
+ $channel->printformat(MSGLEVEL_CLIENTCRAP, 'auto_localize', $nick, $location{host}, $location{'city'}, $location{'province'}, $location{'country'}, $location{'map'}) if defined $channel;
+}
+
+sub new_request ($$$$) {
+ my ($server, $nick, $status, $auto) = @_;
+ return unless ref $server;
+ # 0 nothing done
+ # 1 started to fetch hosts
+ # 2 all hosts fetched
+ push(@{$queries{lc $nick}}, {status => $status, auto=>$auto});
+ $server->command('who '.lc($nick)) if $status == 0;
+}
+
+sub remove_request ($) {
+ my ($nick) = @_;
+ shift @{$queries{$nick}};
+ delete $queries{$nick} if scalar(@{$queries{$nick}}) == 0;
+}
+
+# Yes, I know tat this i huge
+sub kfz2location($) {
+ my %trans = (
+ "rklh"=> "RE",
+ "wstk"=> "Wk",
+ "essn"=> "E",
+ "stgt"=> "S",
+ "ffm" => "F",
+ "mnz" => "MZ",
+ "fra" => "F",
+ "esn" => "E",
+ "dtm" => "DO",
+ "kln" => "K",
+ "dus" => "D",
+ "mue" => "M",
+ "mnch"=> "M",
+ "brln"=> "B",
+ "hmb" => "HH",
+ "brmn"=> "HB",
+ "hmbg"=> "HH",
+ "han" => "H",
+ "kiel"=> "KI",
+ "lpz" => "L",
+ "bln" => "B",
+ "ber" => "B",
+ "mch" => "M",
+ "erf" => "EF",
+ "mdb" => "MD",
+ "nbg" => "N",
+ "hnv" => "H",
+ "dui" => "DU",
+ "mnhm" => "MA",
+ "mhm" => "MA",
+ "flf" => "FL",
+ "lwhf" => "LU",
+ "wue" => "WÜ",
+ "frnk" => "F",
+ "dsdf" => "D",
+ "sgt" => "S",
+ "aug" => "A",
+ "mch" => "M",
+ "ddn" => "DD",
+ "drs" => "DD",
+ "jen" => "J",
+ "che" => "C",
+ "nuremberg" => "N",
+ "weingarten" => "RV",
+ "munich" => "M",
+ "muc" => "M",
+ "goe" => "GÖ",
+ "obhs" => "OB",
+ "dus" => "D",
+ );
+
+ my %province = (
+ 1=>'Baden-Württemberg',
+ 2=>'Bayern',
+ 3=>'Berlin',
+ 4=>'Brandenburg',
+ 5=>'Bremen',
+ 6=>'Hamburg',
+ 7=>'Hessen',
+ 8=>'Mecklenburg-Vorpommern',
+ 9=>'Niedersachsen',
+ 10=>'Nordrhein-Westfalen',
+ 11=>'Rheinland-Pfalz',
+ 12=>'Saarland',
+ 13=>'Sachsen',
+ 14=>'Sachsen-Anhalt',
+ 15=>'Thüringen',
+ 16=>'Schleswig-Holstein'
+ );
+
+ my %added = (
+ "PLA"=>{city=>"Plattling", province=>2},
+ );
+ my %de_kfz = (
+ "A"=>{city=>"Augsburg", province=>2},
+ "AA"=>{city=>"Ostalbkreis", province=>1},
+ "AB"=>{city=>"Aschaffenburg", province=>2},
+ "ABG"=>{city=>"Altenburger Land", province=>15},
+ "AC"=>{city=>"Aachen", province=>10},
+ "AE"=>{city=>"Auerbach", province=>13},
+ "AH"=>{city=>"Ahaus ", province=>10},
+ "AIB"=>{city=>"Bad Aibling", province=>2},
+ "AIC"=>{city=>"Aichach-Friedberg", province=>2},
+ "AK"=>{city=>"Altenkirchen", province=>11},
+ "AL"=>{city=>"Altena", province=>10},
+ "ALF"=>{city=>"Alfeld (Leine)", province=>9},
+ "ALS"=>{city=>"Alsfeld", province=>7},
+ "ALZ"=>{city=>"Alzenau", province=>2},
+ "AM"=>{city=>"Amberg", province=>2},
+ "AN"=>{city=>"Ansbach", province=>2},
+ "ANA"=>{city=>"Annaberg", province=>13},
+ "ANG"=>{city=>"Angermünde", province=>4},
+ "ANK"=>{city=>"Ostvorpommern, Anklam", province=>8},
+ "AP"=>{city=>"Weimarer-Land", province=>15},
+ "APD"=>{city=>"Weimarer Land, Apolda", province=>15},
+ "AR"=>{city=>"Arnsberg", province=>10},
+ "ARN"=>{city=>"Ilm-Kreis", province=>15},
+ "ART"=>{city=>"Artern", province=>15},
+ "AS"=>{city=>"Amberg-Sulzbach", province=>2},
+ "ASD"=>{city=>"Aschendorf-Hümmling", province=>9},
+ "ASL"=>{city=>"Aschersleben", province=>14},
+ "ASZ"=>{city=>"Aue-Schwarzenberg", province=>13},
+ "AT"=>{city=>"Altentreptow", province=>8},
+ "AU"=>{city=>"Aue", province=>13},
+ "AUR"=>{city=>"Aurich", province=>9},
+ "AW"=>{city=>"Ahrweiler", province=>11},
+ "AZ"=>{city=>"Alzey", province=>11},
+ "AZE"=>{city=>"Anhalt-Zerbst", province=>14},
+ "AÖ"=>{city=>"Altötting", province=>2},
+ "B"=>{city=>"Berlin", province=>"3"},
+ "BA"=>{city=>"Bamberg", province=>2},
+ "BAD"=>{city=>"Baden-Baden", province=>1},
+ "BAR"=>{city=>"Barnim", province=>4},
+ "BB"=>{city=>"Böblingen", province=>1},
+ "BBG"=>{city=>"Bernburg", province=>14},
+ "BC"=>{city=>"Biberach", province=>1},
+ "BCH"=>{city=>"Buchen", province=>1},
+ "BE"=>{city=>"Beckum", province=>10},
+ "BED"=>{city=>"Brand-Erbisdorf", province=>13},
+ "BEI"=>{city=>"Beilngries", province=>2},
+ "BEL"=>{city=>"Belzig", province=>4},
+ "BER"=>{city=>"Bernau", province=>4},
+ "BF"=>{city=>"Burgsteinfurt", province=>10},
+ "BGD"=>{city=>"Berchtesgaden", province=>2},
+ "BGL"=>{city=>"Berchtesgadener Land", province=>2},
+ "BH"=>{city=>"Bühl", province=>1},
+ "BI"=>{city=>"Bielefeld", province=>10},
+ "BID"=>{city=>"Biedenkopf", province=>7},
+ "BIN"=>{city=>"Bingen", province=>11},
+ "BIR"=>{city=>"Birkenfeld", province=>11},
+ "BIT"=>{city=>"Bitburg", province=>11},
+ "BIW"=>{city=>"Bischofswerda", province=>13},
+ "BK"=>{city=>"Backnang", province=>1},
+ "BKS"=>{city=>"Bernkastel", province=>11},
+ "BL"=>{city=>"Zollernalbkreis", province=>1},
+ "BLB"=>{city=>"Bad Berleburg", province=>10},
+ "BLK"=>{city=>"Burgenlandkreis", province=>14},
+ "BM"=>{city=>"Erftkreis", province=>10},
+ "BN"=>{city=>"Bonn", province=>10},
+ "BNA"=>{city=>"Borna", province=>13},
+ "BO"=>{city=>"Bochum", province=>10},
+ "BOG"=>{city=>"Bogen", province=>2},
+ "BOH"=>{city=>"Bocholt", province=>10},
+ "BOR"=>{city=>"Borken", province=>10},
+ "BOT"=>{city=>"Bottrop", province=>10},
+ "BR"=>{city=>"Bruchsal", province=>1},
+ "BRA"=>{city=>"Wesermarsch", province=>9},
+ "BRB"=>{city=>"Brandenburg", province=>4},
+ "BRG"=>{city=>"Burg", province=>14},
+ "BRI"=>{city=>"Brilon", province=>10},
+ "BRK"=>{city=>"Bad Brückenau", province=>2},
+ "BRL"=>{city=>"Braunlage", province=>9},
+ "BRV"=>{city=>"Bremervörde", province=>9},
+ "BS"=>{city=>"Braunschweig", province=>9},
+ "BSB"=>{city=>"Bersenbrück", province=>9},
+ "BSK"=>{city=>"Beeskow", province=>4},
+ "BT"=>{city=>"Bayreuth", province=>2},
+ "BTF"=>{city=>"Bitterfeld", province=>14},
+ "BU"=>{city=>"Burgdorf", province=>9},
+ "BUL"=>{city=>"Burglengenfeld", province=>2},
+ "BZ"=>{city=>"Bautzen", province=>13},
+ "BZA"=>{city=>"Bergzabern", province=>11},
+ "BÖ"=>{city=>"Bördekreis", province=>14},
+ "BÜD"=>{city=>"Büdingen", province=>7},
+ "BÜR"=>{city=>"Büren", province=>10},
+ "BÜS"=>{city=>"Büsingen", province=>1},
+ "BÜZ"=>{city=>"Bützow", province=>8},
+ "C"=>{city=>"Chemnitz", province=>13},
+ "CA"=>{city=>"Calau", province=>4},
+ "CAS"=>{city=>"Castrop-Rauxel", province=>10},
+ "CB"=>{city=>"Cottbus", province=>4},
+ "CE"=>{city=>"Celle", province=>9},
+ "CHA"=>{city=>"Cham", province=>2},
+ "CLP"=>{city=>"Cloppenburg", province=>9},
+ "CLZ"=>{city=>"Clausthal-Zellerfeld", province=>9},
+ "CO"=>{city=>"Coburg", province=>2},
+ "COC"=>{city=>"Cochem-Zell", province=>11},
+ "COE"=>{city=>"Coesfeld", province=>10},
+ "CR"=>{city=>"Crailsheim", province=>1},
+ "CUX"=>{city=>"Cuxhaven", province=>9},
+ "CW"=>{city=>"Calw", province=>1},
+ "D"=>{city=>"Düsseldorf", province=>10},
+ "DA"=>{city=>"Darmstadt", province=>7},
+ "DAH"=>{city=>"Dachau ", province=>2},
+ "DAN"=>{city=>"Lüchow-Dannenberg", province=>9},
+ "DAU"=>{city=>"Daun", province=>11},
+ "DBR"=>{city=>"Bad Doberan", province=>8},
+ "DD"=>{city=>"Dresden", province=>13},
+ "DE"=>{city=>"Dessau", province=>14},
+ "DEG"=>{city=>"Deggendorf", province=>2},
+ "DEL"=>{city=>"Delmenhorst", province=>9},
+ "DGF"=>{city=>"Dingolfing-Landau", province=>2},
+ "DH"=>{city=>"Diepholz", province=>9},
+ "DI"=>{city=>"Dieburg", province=>7},
+ "DIL"=>{city=>"Dillenburg", province=>7},
+ "DIN"=>{city=>"Dinslaken", province=>10},
+ "DIZ"=>{city=>"Diez", province=>11},
+ "DKB"=>{city=>"Dinkelsbühl", province=>2},
+ "DL"=>{city=>"Döbeln", province=>13},
+ "DLG"=>{city=>"Dillingen a. d. Donau", province=>2},
+ "DM"=>{city=>"Demmin", province=>8},
+ "DN"=>{city=>"Düren", province=>10},
+ "DO"=>{city=>"Dortmund", province=>10},
+ "DON"=>{city=>"Donau-Ries", province=>2},
+ "DS"=>{city=>"Donaueschingen", province=>1},
+ "DT"=>{city=>"Detmold", province=>10},
+ "DU"=>{city=>"Duisburg", province=>10},
+ "DUD"=>{city=>"Duderstadt", province=>9},
+ "DW"=>{city=>"Weißeritzkreis", province=>13},
+ "DZ"=>{city=>"Delitzsch", province=>13},
+ "DÜW"=>{city=>"Bad Dürkheim", province=>11},
+ "E"=>{city=>"Essen", province=>10},
+ "EA"=>{city=>"Eisenach, Stadt", province=>15},
+ "EB"=>{city=>"Eilenburg", province=>13},
+ "EBE"=>{city=>"Ebersberg", province=>2},
+ "EBN"=>{city=>"Ebern", province=>2},
+ "EBS"=>{city=>"Ebermannstadt", province=>2},
+ "ECK"=>{city=>"Eckernförde", province=>16},
+ "ED"=>{city=>"Erding", province=>2},
+ "EE"=>{city=>"Elbe-Elster", province=>4},
+ "EF"=>{city=>"Erfurt", province=>15},
+ "EG"=>{city=>"Eggenfelden", province=>2},
+ "EH"=>{city=>"Eisenhüttenstadt", province=>4},
+ "EHI"=>{city=>"Ehingen", province=>1},
+ "EI"=>{city=>"Eichstätt", province=>2},
+ "EIC"=>{city=>"Eichsfeld", province=>15},
+ "EIH"=>{city=>"Eichstätt-Kreis", province=>2},
+ "EIL"=>{city=>"Eisleben", province=>14},
+ "EIN"=>{city=>"Einbeck", province=>9},
+ "EIS"=>{city=>"Saale-Holzlandkreis, Eisenberg", province=>15},
+ "EL"=>{city=>"Emsland", province=>9},
+ "EM"=>{city=>"Emmendingen", province=>1},
+ "EMD"=>{city=>"Emden", province=>9},
+ "EMS"=>{city=>"Rhein-Lahn-Kreis", province=>11},
+ "EN"=>{city=>"Ennepe-Ruhr-Kreis", province=>10},
+ "ER"=>{city=>"Erlangen", province=>2},
+ "ERB"=>{city=>"Odenwaldkreis", province=>7},
+ "ERH"=>{city=>"Erlangen-Höchstadt", province=>2},
+ "ERK"=>{city=>"Erkelenz", province=>10},
+ "ES"=>{city=>"Esslingen", province=>1},
+ "ESA"=>{city=>"Eisenach", province=>15},
+ "ESB"=>{city=>"Eschenbach i.d.Oberpfalz", province=>2},
+ "ESW"=>{city=>"Werra-Meißner-Kreis", province=>7},
+ "EU"=>{city=>"Euskirchen", province=>10},
+ "EUT"=>{city=>"Eutin", province=>16},
+ "EW"=>{city=>"Eberswalde", province=>4},
+ "F"=>{city=>"Frankfurt am Main", province=>7},
+ "FAL"=>{city=>"Fallingbostel", province=>9},
+ "FB"=>{city=>"Wetteraukreis", province=>7},
+ "FD"=>{city=>"Fulda", province=>7},
+ "FDB"=>{city=>"Friedberg", province=>2},
+ "FDS"=>{city=>"Freudenstadt", province=>1},
+ "FEU"=>{city=>"Feuchtwangen", province=>2},
+ "FF"=>{city=>"Frankfurt / Oder", province=>4},
+ "FFB"=>{city=>"Fürstenfeldbruck", province=>2},
+ "FG"=>{city=>"Freiberg", province=>13},
+ "FH"=>{city=>"Frankfurt / Main-Höchst", province=>7},
+ "FI"=>{city=>"Finsterwalde", province=>4},
+ "FKB"=>{city=>"Frankenberg", province=>7},
+ "FL"=>{city=>"Flensburg", province=>16},
+ "FLÖ"=>{city=>"Flöha", province=>13},
+ "FN"=>{city=>"Bodenseekreis", province=>1},
+ "FO"=>{city=>"Forchheim", province=>2},
+ "FOR"=>{city=>"Forst", province=>4},
+ "FR"=>{city=>"Freiburg", province=>1},
+ "FRG"=>{city=>"Freyung-Grafenau", province=>2},
+ "FRI"=>{city=>"Friesland", province=>9},
+ "FRW"=>{city=>"Bad Freienwalde", province=>4},
+ "FS"=>{city=>"Freising", province=>2},
+ "FT"=>{city=>"Frankenthal", province=>11},
+ "FTL"=>{city=>"Freital", province=>13},
+ "FW"=>{city=>"Fürstenwalde", province=>4},
+ "FZ"=>{city=>"Fritzlar", province=>7},
+ "FÜ"=>{city=>"Fürth", province=>2},
+ "FÜS"=>{city=>"Füssen", province=>2},
+ "G"=>{city=>"Gera", province=>15},
+ "GA"=>{city=>"Gardelegen", province=>14},
+ "GAN"=>{city=>"Bad Gandersheim", province=>9},
+ "GAP"=>{city=>"Garmisch-Partenkirchen", province=>2},
+ "GC"=>{city=>"Chemnitzer Land", province=>13},
+ "GD"=>{city=>"Schwäbisch Gmünd", province=>1},
+ "GDB"=>{city=>"Gadebusch", province=>8},
+ "GE"=>{city=>"Gelsenkirchen", province=>10},
+ "GEL"=>{city=>"Geldern", province=>10},
+ "GEM"=>{city=>"Gemünden a.Main", province=>2},
+ "GEO"=>{city=>"Gerolzhofen", province=>2},
+ "GER"=>{city=>"Germersheim", province=>11},
+ "GF"=>{city=>"Gifhorn", province=>9},
+ "GG"=>{city=>"Groß-Gerau", province=>7},
+ "GHA"=>{city=>"Geithain", province=>13},
+ "GHC"=>{city=>"Gräfenhainichen", province=>14},
+ "GI"=>{city=>"Gießen", province=>7},
+ "GK"=>{city=>"Geilenkirchen-Heinsberg", province=>10},
+ "GL"=>{city=>"Rheinisch-Bergischer Kreis", province=>10},
+ "GLA"=>{city=>"Gladbeck", province=>10},
+ "GM"=>{city=>"Oberbergischer Kreis", province=>10},
+ "GMN"=>{city=>"Grimmen", province=>8},
+ "GN"=>{city=>"Gelnhausen", province=>7},
+ "GNT"=>{city=>"Genthin", province=>14},
+ "GOA"=>{city=>"St. Goar", province=>11},
+ "GOH"=>{city=>"St. Goarshausen", province=>11},
+ "GP"=>{city=>"Göppingen", province=>1},
+ "GR"=>{city=>"Görlitz", province=>13},
+ "GRA"=>{city=>"Grafenau", province=>2},
+ "GRH"=>{city=>"Großenhain", province=>13},
+ "GRI"=>{city=>"Griesbach i. Rottal", province=>2},
+ "GRM"=>{city=>"Grimma", province=>13},
+ "GRS"=>{city=>"Gransee", province=>4},
+ "GRZ"=>{city=>"Greiz", province=>15},
+ "GS"=>{city=>"Goslar", province=>9},
+ "GT"=>{city=>"Gütersloh", province=>10},
+ "GTH"=>{city=>"Gotha", province=>15},
+ "GUB"=>{city=>"Guben", province=>4},
+ "GUN"=>{city=>"Gunzenhausen", province=>2},
+ "GV"=>{city=>"Grevenbroich", province=>10},
+ "GVM"=>{city=>"Grevesmühlen", province=>8},
+ "GW"=>{city=>"Greifswald Land", province=>8},
+ "GZ"=>{city=>"Günzburg", province=>2},
+ "GÖ"=>{city=>"Göttingen", province=>9},
+ "GÜ"=>{city=>"Güstrow", province=>8},
+ "H"=>{city=>"Hannover", province=>9},
+ "HA"=>{city=>"Hagen", province=>10},
+ "HAB"=>{city=>"Hammelburg", province=>2},
+ "HAL"=>{city=>"Halle", province=>14},
+ "HAM"=>{city=>"Hamm", province=>10},
+ "HAS"=>{city=>"Haßberge", province=>2},
+ "HB"=>{city=>"Bremen", province=>5},
+ "HBN"=>{city=>"Hildburghausen", province=>15},
+ "HBS"=>{city=>"Halberstadt", province=>14},
+ "HC"=>{city=>"Hainichen", province=>13},
+ "HCH"=>{city=>"Hechingen", province=>1},
+ "HD"=>{city=>"Rhein-Neckar-Kreis", province=>1},
+ "HDH"=>{city=>"Heidenheim (Brenz)", province=>1},
+ "HDL"=>{city=>"Haldensleben", province=>14},
+ "HE"=>{city=>"Helmstedt", province=>9},
+ "HEB"=>{city=>"Hersbruck", province=>2},
+ "HEF"=>{city=>"Hersfeld-Rotenburg", province=>7},
+ "HEI"=>{city=>"Dithmarschen", province=>16},
+ "HER"=>{city=>"Herne", province=>10},
+ "HET"=>{city=>"Hettstedt", province=>14},
+ "HF"=>{city=>"Herford", province=>10},
+ "HG"=>{city=>"Hochtaunus-Kreis", province=>7},
+ "HGN"=>{city=>"Hagenow", province=>8},
+ "HGW"=>{city=>"Greifswald", province=>8},
+ "HH"=>{city=>"Hamburg", province=>6},
+ "HHM"=>{city=>"Hohenmölsen", province=>14},
+ "HI"=>{city=>"Hildesheim", province=>9},
+ "HIG"=>{city=>"Eichsfeld, Heiligenstadt", province=>15},
+ "HIP"=>{city=>"Hilpoltstein", province=>2},
+ "HL"=>{city=>"Lübeck", province=>16},
+ "HM"=>{city=>"Hameln-Pyrmont", province=>9},
+ "HMÜ"=>{city=>"Hann. Münden", province=>9},
+ "HN"=>{city=>"Heilbronn", province=>1},
+ "HO"=>{city=>"Hof", province=>2},
+ "HOG"=>{city=>"Hofgeismar", province=>7},
+ "HOH"=>{city=>"Hofheim i. Ufr.", province=>2},
+ "HOL"=>{city=>"Holzminden", province=>9},
+ "HOM"=>{city=>"Saarpfalz-Kreis", province=>12},
+ "HOR"=>{city=>"Horb", province=>1},
+ "HOT"=>{city=>"Hohenstein-Ernstthal", province=>13},
+ "HP"=>{city=>"Bergstraße", province=>7},
+ "HR"=>{city=>"Schwalm-Eder-Kreis", province=>7},
+ "HRO"=>{city=>"Rostock", province=>8},
+ "HS"=>{city=>"Heinsberg", province=>10},
+ "HSK"=>{city=>"Hochsauerland-Kreis", province=>10},
+ "HST"=>{city=>"Stralsund", province=>8},
+ "HU"=>{city=>"Main-Kinzig-Kreis", province=>7},
+ "HUS"=>{city=>"Husum", province=>16},
+ "HV"=>{city=>"Havelberg", province=>14},
+ "HVL"=>{city=>"Havelland", province=>4},
+ "HW"=>{city=>"Halle/Westfalen", province=>10},
+ "HWI"=>{city=>"Wismar", province=>8},
+ "HX"=>{city=>"Höxter", province=>10},
+ "HY"=>{city=>"Hoyerswerda", province=>13},
+ "HZ"=>{city=>"Herzberg", province=>4},
+ "HÖS"=>{city=>"Höchstadt a. d. Aisch", province=>2},
+ "HÜN"=>{city=>"Hünfeld", province=>7},
+ "IGB"=>{city=>"St. Ingbert", province=>12},
+ "IK"=>{city=>"Ilm-Kreis", province=>15},
+ "IL"=>{city=>"Ilmenau", province=>15},
+ "ILL"=>{city=>"Illertissen", province=>2},
+ "IN"=>{city=>"Ingolstadt", province=>2},
+ "IS"=>{city=>"Iserlohn", province=>10},
+ "IZ"=>{city=>"Steinburg", province=>16},
+ "J"=>{city=>"Jena", province=>15},
+ "JB"=>{city=>"Jüterbog", province=>4},
+ "JE"=>{city=>"Jessen", province=>14},
+ "JEV"=>{city=>"Jever", province=>9},
+ "JL"=>{city=>"Jerichower Land", province=>14},
+ "JÜL"=>{city=>"Jülich", province=>10},
+ "K"=>{city=>"Köln", province=>10},
+ "KA"=>{city=>"Karlsruhe", province=>1},
+ "KAR"=>{city=>"Karlstadt", province=>2},
+ "KB"=>{city=>"Waldeck-Frankenberg", province=>7},
+ "KC"=>{city=>"Kronach", province=>2},
+ "KE"=>{city=>"Kempten", province=>2},
+ "KEH"=>{city=>"Kelheim", province=>2},
+ "KEL"=>{city=>"Kehl", province=>1},
+ "KEM"=>{city=>"Kemnath", province=>2},
+ "KF"=>{city=>"Kaufbeuren", province=>2},
+ "KG"=>{city=>"Bad Kissingen", province=>2},
+ "KH"=>{city=>"Bad Kreuznach", province=>11},
+ "KI"=>{city=>"Kiel", province=>16},
+ "KIB"=>{city=>"Donnersberg-Kreis", province=>11},
+ "KK"=>{city=>"Kempen-Krefeld", province=>10},
+ "KL"=>{city=>"Kaiserslautern", province=>11},
+ "KLE"=>{city=>"Kleve", province=>10},
+ "KLZ"=>{city=>"Klötze", province=>14},
+ "KM"=>{city=>"Kamenz", province=>13},
+ "KN"=>{city=>"Konstanz", province=>1},
+ "KO"=>{city=>"Koblenz", province=>11},
+ "KR"=>{city=>"Krefeld", province=>10},
+ "KRU"=>{city=>"Krumbach", province=>2},
+ "KS"=>{city=>"Kassel", province=>7},
+ "KT"=>{city=>"Kitzingen", province=>2},
+ "KU"=>{city=>"Kulmbach", province=>2},
+ "KUS"=>{city=>"Kusel", province=>11},
+ "KW"=>{city=>"Königs-Wusterhausen", province=>4},
+ "KY"=>{city=>"Kyritz", province=>4},
+ "KYF"=>{city=>"Kyffhäuserkreis", province=>15},
+ "KÖN"=>{city=>"Bad Königshofen i. Grabfeld", province=>2},
+ "KÖT"=>{city=>"Köthen", province=>14},
+ "KÖZ"=>{city=>"Kötzting", province=>2},
+ "KÜN"=>{city=>"Hohenlohekreis", province=>1},
+ "L"=>{city=>"Leipzig / Leipziger Land", province=>13},
+ "LA"=>{city=>"Landshut", province=>2},
+ "LAN"=>{city=>"Landau a.d.Isar", province=>2},
+ "LAT"=>{city=>"Lauterbach", province=>7},
+ "LAU"=>{city=>"Nürnberger Land", province=>2},
+ "LB"=>{city=>"Ludwigsburg", province=>1},
+ "LBS"=>{city=>"Lobenstein", province=>15},
+ "LBZ"=>{city=>"Lübz", province=>8},
+ "LC"=>{city=>"Luckau", province=>4},
+ "LD"=>{city=>"Landau i. d. Pfalz", province=>11},
+ "LDK"=>{city=>"Lahn-Dill-Kreis", province=>7},
+ "LDS"=>{city=>"Dahme-Spreewald", province=>4},
+ "LE"=>{city=>"Lemgo", province=>10},
+ "LEO"=>{city=>"Leonberg", province=>1},
+ "LER"=>{city=>"Leer", province=>9},
+ "LEV"=>{city=>"Leverkusen", province=>10},
+ "LF"=>{city=>"Laufen", province=>2},
+ "LG"=>{city=>"Lüneburg", province=>9},
+ "LH"=>{city=>"Lüdinghausen", province=>10},
+ "LI"=>{city=>"Lindau", province=>2},
+ "LIB"=>{city=>"Bad Liebenwerda", province=>4},
+ "LIF"=>{city=>"Lichtenfels", province=>2},
+ "LIN"=>{city=>"Lingen", province=>9},
+ "LIP"=>{city=>"Lippe", province=>10},
+ "LK"=>{city=>"Lübbecke", province=>10},
+ "LL"=>{city=>"Landsberg am Lech", province=>2},
+ "LM"=>{city=>"Limburg-Weilburg", province=>7},
+ "LN"=>{city=>"Lübben", province=>4},
+ "LOH"=>{city=>"Lohr a.Main", province=>2},
+ "LOS"=>{city=>"Oder-Spree", province=>4},
+ "LP"=>{city=>"Lippstadt", province=>10},
+ "LR"=>{city=>"Lahr", province=>1},
+ "LSZ"=>{city=>"Bad Langensalza", province=>15},
+ "LU"=>{city=>"Ludwigshafen", province=>11},
+ "LUK"=>{city=>"Luckenwalde", province=>4},
+ "LWL"=>{city=>"Ludwigslust", province=>8},
+ "LÖ"=>{city=>"Lörrach", province=>1},
+ "LÖB"=>{city=>"Löbau", province=>13},
+ "LÜD"=>{city=>"Lüdenscheid, Stadt", province=>10},
+ "LÜN"=>{city=>"Lünen", province=>10},
+ "M"=>{city=>"München", province=>2},
+ "MA"=>{city=>"Mannheim", province=>1},
+ "MAB"=>{city=>"Marienberg", province=>13},
+ "MAI"=>{city=>"Mainburg", province=>2},
+ "MAK"=>{city=>"Marktredwitz", province=>2},
+ "MAL"=>{city=>"Mallersdorf", province=>2},
+ "MAR"=>{city=>"Marktheidenfeld", province=>2},
+ "MB"=>{city=>"Miesbach", province=>2},
+ "MC"=>{city=>"Malchin", province=>8},
+ "MD"=>{city=>"Magdeburg", province=>14},
+ "ME"=>{city=>"Mettmann", province=>10},
+ "MED"=>{city=>"Meldorf /Suderdithmarschen", province=>16},
+ "MEG"=>{city=>"Melsungen", province=>7},
+ "MEI"=>{city=>"Meißen", province=>13},
+ "MEK"=>{city=>"Mittlerer Erzgebirgskreis", province=>13},
+ "MEL"=>{city=>"Melle", province=>9},
+ "MEP"=>{city=>"Meppen", province=>9},
+ "MER"=>{city=>"Merseburg", province=>14},
+ "MES"=>{city=>"Meschede", province=>10},
+ "MET"=>{city=>"Mellrichstadt", province=>2},
+ "MG"=>{city=>"Mönchengladbach", province=>10},
+ "MGH"=>{city=>"Bad Mergentheim", province=>1},
+ "MGN"=>{city=>"Meiningen", province=>15},
+ "MH"=>{city=>"Mülheim an der Ruhr", province=>"Nordrhein-Westfalen."},
+ "MHL"=>{city=>"Unstrut-Hainich-Kreis, Mühlhausen", province=>15},
+ "MI"=>{city=>"Minden", province=>10},
+ "MIL"=>{city=>"Miltenberg", province=>2},
+ "MK"=>{city=>"Märkischer Kreis", province=>10},
+ "ML"=>{city=>"Mansfelder Land", province=>14},
+ "MM"=>{city=>"Memmingen", province=>2},
+ "MN"=>{city=>"Unterallgäu", province=>2},
+ "MO"=>{city=>"Moers", province=>10},
+ "MOD"=>{city=>"Marktoberdorf", province=>2},
+ "MOL"=>{city=>"Märkisch-Oderland", province=>4},
+ "MON"=>{city=>"Monschau", province=>10},
+ "MOS"=>{city=>"Neckar-Odenwald-Kreis", province=>1},
+ "MQ"=>{city=>"Merseburg-Querfurt", province=>14},
+ "MR"=>{city=>"Marburg-Biedenkopf", province=>7},
+ "MS"=>{city=>"Münster", province=>10},
+ "MSP"=>{city=>"Main-Spessart", province=>2},
+ "MST"=>{city=>"Mecklenburg-Strelitz", province=>8},
+ "MT"=>{city=>"Montabaur", province=>11},
+ "MTK"=>{city=>"Main-Taunus-Kreis", province=>7},
+ "MTL"=>{city=>"Muldentalkreis", province=>13},
+ "MW"=>{city=>"Mittweida", province=>13},
+ "MY"=>{city=>"Mayen", province=>11},
+ "MYK"=>{city=>"Mayen-Koblenz", province=>11},
+ "MZ"=>{city=>"Mainz (-Bingen)", province=>11},
+ "MZG"=>{city=>"Merzig-Saar", province=>12},
+ "MÜ"=>{city=>"Mühldorf am Inn", province=>2},
+ "MÜB"=>{city=>"Münchberg", province=>2},
+ "MÜL"=>{city=>"Müllheim", province=>1},
+ "MÜN"=>{city=>"Münsingen", province=>1},
+ "MÜR"=>{city=>"Müritz", province=>8},
+ "N"=>{city=>"Nürnberg", province=>2},
+ "NAB"=>{city=>"Nabburg", province=>2},
+ "NAI"=>{city=>"Naila", province=>2},
+ "NAU"=>{city=>"Nauen", province=>4},
+ "NB"=>{city=>"Neubrandenburg", province=>8},
+ "ND"=>{city=>"Neuburg-Schrobenhausen", province=>2},
+ "NDH"=>{city=>"Nordhausen", province=>15},
+ "NE"=>{city=>"Neuss", province=>10},
+ "NEA"=>{city=>"Neustadt a. d. Aisch", province=>2},
+ "NEB"=>{city=>"Nebra", province=>14},
+ "NEC"=>{city=>"Neustadt b.Coburg", province=>2},
+ "NEN"=>{city=>"Neunburg vorm Wald", province=>2},
+ "NES"=>{city=>"Rhön-Grabfeld", province=>2},
+ "NEU"=>{city=>"Titisee-Neustadt im Schwarzwald", province=>1},
+ "NEW"=>{city=>"Neustadt an der Waldnaab", province=>2},
+ "NF"=>{city=>"Nordfriesland", province=>16},
+ "NH"=>{city=>"Neuhaus am Rennweg", province=>15},
+ "NI"=>{city=>"Nienburg", province=>9},
+ "NIB"=>{city=>"Niebüll", province=>16},
+ "NK"=>{city=>"Neunkirchen", province=>12},
+ "NM"=>{city=>"Neumarkt", province=>2},
+ "NMB"=>{city=>"Naumburg", province=>14},
+ "NMS"=>{city=>"Neumünster", province=>16},
+ "NOH"=>{city=>"Bentheim", province=>9},
+ "NOL"=>{city=>"Niederschlesische Oberlausitz", province=>13},
+ "NOM"=>{city=>"Northeim", province=>9},
+ "NOR"=>{city=>"Norden", province=>9},
+ "NP"=>{city=>"Neuruppin", province=>4},
+ "NR"=>{city=>"Neuwied", province=>11},
+ "NRÜ"=>{city=>"Neustadt a.Rübenberge", province=>9},
+ "NT"=>{city=>"Nürtingen", province=>1},
+ "NU"=>{city=>"Neu-Ulm", province=>2},
+ "NVP"=>{city=>"Nordvorpommern", province=>8},
+ "NW"=>{city=>"Neustadt a. d. Weinstraße", province=>11},
+ "NWM"=>{city=>"Nordwestmecklenburg", province=>8},
+ "NY"=>{city=>"Niesky", province=>13},
+ "NZ"=>{city=>"Neustrelitz", province=>8},
+ "NÖ"=>{city=>"Nördlingen", province=>2},
+ "OA"=>{city=>"Oberallgäu", province=>2},
+ "OAL"=>{city=>"Ostallgäu", province=>2},
+ "OB"=>{city=>"Oberhausen", province=>10},
+ "OBB"=>{city=>"Obernburg a. Main", province=>2},
+ "OBG"=>{city=>"Osterburg", province=>14},
+ "OC"=>{city=>"Oschersleben", province=>14},
+ "OCH"=>{city=>"Ochsenfurt", province=>2},
+ "OD"=>{city=>"Stormarn", province=>16},
+ "OE"=>{city=>"Olpe", province=>10},
+ "OF"=>{city=>"Offenbach", province=>7},
+ "OG"=>{city=>"Ortenaukreis", province=>1},
+ "OH"=>{city=>"Ostholstein", province=>16},
+ "OHA"=>{city=>"Osterode am Harz", province=>9},
+ "OHV"=>{city=>"Oberhavel", province=>4},
+ "OHZ"=>{city=>"Osterholz-Scharmbeck", province=>9},
+ "OK"=>{city=>"Ohre-Kreis", province=>14},
+ "OL"=>{city=>"Oldenburg", province=>9},
+ "OLD"=>{city=>"Oldenburg/Holstein", province=>16},
+ "OP"=>{city=>"Opladen", province=>10},
+ "OPR"=>{city=>"Ostprignitz-Ruppin", province=>4},
+ "OR"=>{city=>"Oranienburg", province=>4},
+ "OS"=>{city=>"Osnabrück", province=>9},
+ "OSL"=>{city=>"Oberspreewald-Lausitz", province=>4},
+ "OTT"=>{city=>"Otterndorf", province=>9},
+ "OTW"=>{city=>"Ottweiler", province=>12},
+ "OVI"=>{city=>"Oberviechtach", province=>2},
+ "OVL"=>{city=>"Obervogtland", province=>13},
+ "OVP"=>{city=>"Ostvorpommern", province=>8},
+ "OZ"=>{city=>"Oschatz", province=>13},
+ "ÖHR"=>{city=>"Öhringen", province=>1},
+ "P"=>{city=>"Potsdam", province=>4},
+ "PA"=>{city=>"Passau", province=>2},
+ "PAF"=>{city=>"Pfaffenhofen", province=>2},
+ "PAN"=>{city=>"Rottal-Inn", province=>2},
+ "PAR"=>{city=>"Parsberg", province=>2},
+ "PB"=>{city=>"Paderborn", province=>10},
+ "PCH"=>{city=>"Parchim", province=>8},
+ "PE"=>{city=>"Peine", province=>9},
+ "PEG"=>{city=>"Pegnitz", province=>2},
+ "PER"=>{city=>"Perleberg", province=>4},
+ "PF"=>{city=>"Pforzheim / Enzkreis", province=>1},
+ "PI"=>{city=>"Pinneberg", province=>16},
+ "PIR"=>{city=>"Sächsische Schweiz", province=>13},
+ "PK"=>{city=>"Pritzwalk", province=>4},
+ "PL"=>{city=>"Plauen", province=>13},
+ "PLÖ"=>{city=>"Plön", province=>16},
+ "PM"=>{city=>"Potsdam-Mittelmark", province=>4},
+ "PN"=>{city=>"Pößneck", province=>15},
+ "PR"=>{city=>"Prignitz", province=>4},
+ "PRÜ"=>{city=>"Prüm", province=>11},
+ "PS"=>{city=>"Pirmasens / Südwestpfalz", province=>11},
+ "PW"=>{city=>"Pasewalk", province=>8},
+ "PZ"=>{city=>"Prenzlau", province=>4},
+ "QFT"=>{city=>"Querfurt", province=>14},
+ "QLB"=>{city=>"Quedlinburg", province=>14},
+ "R"=>{city=>"Regensburg", province=>2},
+ "RA"=>{city=>"Rastatt", province=>1},
+ "RC"=>{city=>"Reichenbach", province=>13},
+ "RD"=>{city=>"Rendsburg-Eckernförde", province=>16},
+ "RDG"=>{city=>"Ribnitz-Damgarten", province=>8},
+ "RE"=>{city=>"Recklinghausen", province=>10},
+ "REG"=>{city=>"Regen", province=>2},
+ "REH"=>{city=>"Rehau", province=>2},
+ "REI"=>{city=>"Bad Reichenhall", province=>2},
+ "RG"=>{city=>"Großenhain", province=>13},
+ "RH"=>{city=>"Roth", province=>2},
+ "RI"=>{city=>"Rinteln", province=>9},
+ "RID"=>{city=>"Riedenburg", province=>2},
+ "RIE"=>{city=>"Riesa", province=>13},
+ "RL"=>{city=>"Rochlitz", province=>13},
+ "RM"=>{city=>"Röbel", province=>8},
+ "RN"=>{city=>"Rathenow", province=>4},
+ "RO"=>{city=>"Rosenheim", province=>2},
+ "ROD"=>{city=>"Roding", province=>2},
+ "ROF"=>{city=>"Rotenburg/Fulda", province=>7},
+ "ROK"=>{city=>"Rockenhausen", province=>11},
+ "ROL"=>{city=>"Rottenburg a. d. Laaber", province=>2},
+ "ROS"=>{city=>"Rostock-Kreis", province=>8},
+ "ROT"=>{city=>"Rothenburg o.d.Tauber", province=>2},
+ "ROW"=>{city=>"Rotenburg (Wümme)", province=>9},
+ "RS"=>{city=>"Remscheid", province=>10},
+ "RSL"=>{city=>"Roßlau", province=>14},
+ "RT"=>{city=>"Reutlingen", province=>1},
+ "RU"=>{city=>"Rudolstadt", province=>15},
+ "RV"=>{city=>"Ravensburg", province=>1},
+ "RW"=>{city=>"Rottweil", province=>1},
+ "RY"=>{city=>"Rheydt", province=>10},
+ "RZ"=>{city=>"Herzogtum Lauenburg", province=>16},
+ "RÜD"=>{city=>"Rheingau-Taunus-Kreis", province=>7},
+ "RÜG"=>{city=>"Rügen", province=>8},
+ "S"=>{city=>"Stuttgart", province=>1},
+ "SAB"=>{city=>"Saarburg", province=>11},
+ "SAD"=>{city=>"Schwandorf in Bayern", province=>2},
+ "SAN"=>{city=>"Stadtsteinach", province=>2},
+ "SAW"=>{city=>"Altmarkkreis Salzwedel", province=>14},
+ "SB"=>{city=>"Saarbrücken", province=>12},
+ "SBG"=>{city=>"Strasburg", province=>8},
+ "SBK"=>{city=>"Schönebeck", province=>"Sachsen Anhalt"},
+ "SC"=>{city=>"Schwabach", province=>2},
+ "SCZ"=>{city=>"Schleiz", province=>15},
+ "SDH"=>{city=>"Sondershausen", province=>15},
+ "SDL"=>{city=>"Stendal", province=>14},
+ "SDT"=>{city=>"Schwedt", province=>4},
+ "SE"=>{city=>"Bad Segeberg", province=>16},
+ "SEB"=>{city=>"Sebnitz", province=>13},
+ "SEE"=>{city=>"Seelow", province=>4},
+ "SEF"=>{city=>"Scheinfeld", province=>2},
+ "SEL"=>{city=>"Selb", province=>2},
+ "SF"=>{city=>"Sonthofen", province=>2},
+ "SFA"=>{city=>"Soltau-Fallingbostel", province=>9},
+ "SFB"=>{city=>"Senftenberg", province=>4},
+ "SFT"=>{city=>"Staßfurt", province=>14},
+ "SG"=>{city=>"Solingen", province=>10},
+ "SGH"=>{city=>"Sangerhausen", province=>14},
+ "SHA"=>{city=>"Schwäbisch Hall", province=>1},
+ "SHG"=>{city=>"Schaumburg", province=>9},
+ "SHK"=>{city=>"Saale-Holzland-Kreis", province=>15},
+ "SHL"=>{city=>"Suhl", province=>15},
+ "SI"=>{city=>"Siegen", province=>10},
+ "SIG"=>{city=>"Sigmaringen", province=>1},
+ "SIM"=>{city=>"Rhein-Hunsrück-Kreis", province=>11},
+ "SK"=>{city=>"Saalkreis", province=>14},
+ "SL"=>{city=>"Schleswig-Flensburg", province=>16},
+ "SLE"=>{city=>"Schleiden", province=>10},
+ "SLF"=>{city=>"Saalfeld-Rudolstadt", province=>15},
+ "SLG"=>{city=>"Saulgau", province=>1},
+ "SLN"=>{city=>"Schmölln", province=>15},
+ "SLS"=>{city=>"Saarlouis", province=>12},
+ "SLZ"=>{city=>"Bad Salzungen", province=>15},
+ "SLÜ"=>{city=>"Schlüchtern", province=>7},
+ "SM"=>{city=>"Schmalkalden-Meiningen", province=>15},
+ "SMÜ"=>{city=>"Schwabmünchen", province=>2},
+ "SN"=>{city=>"Schwerin", province=>8},
+ "SNH"=>{city=>"Sinsheim Elsenz", province=>1},
+ "SO"=>{city=>"Soest", province=>10},
+ "SOB"=>{city=>"Schrobenhausen", province=>2},
+ "SOG"=>{city=>"Schongau", province=>2},
+ "SOK"=>{city=>"Saale-Orla-Kreis", province=>15},
+ "SOL"=>{city=>"Soltau", province=>9},
+ "SON"=>{city=>"Sonneberg", province=>15},
+ "SP"=>{city=>"Speyer", province=>11},
+ "SPB"=>{city=>"Spremberg", province=>4},
+ "SPN"=>{city=>"Spree-Neiße", province=>4},
+ "SPR"=>{city=>"Springe", province=>9},
+ "SR"=>{city=>"Straubing (-Bogen)", province=>2},
+ "SRB"=>{city=>"Strausberg", province=>4},
+ "SRO"=>{city=>"Stadtroda", province=>15},
+ "ST"=>{city=>"Steinfurt", province=>10},
+ "STA"=>{city=>"Starnberg", province=>2},
+ "STB"=>{city=>"Sternberg", province=>8},
+ "STD"=>{city=>"Stade", province=>9},
+ "STE"=>{city=>"Staffelstein", province=>2},
+ "STH"=>{city=>"Schaumburg-Lippe", province=>9},
+ "STL"=>{city=>"Stollberg", province=>13},
+ "STO"=>{city=>"Stockach", province=>1},
+ "SU"=>{city=>"Rhein-Sieg-Kreis", province=>10},
+ "SUL"=>{city=>"Sulzbach-Rosenberg", province=>2},
+ "SW"=>{city=>"Schweinfurt", province=>2},
+ "SWA"=>{city=>"Bad Schwalbach", province=>7},
+ "SY"=>{city=>"Syke", province=>9},
+ "SZ"=>{city=>"Salzgitter", province=>9},
+ "SZB"=>{city=>"Schwarzenberg", province=>13},
+ "SÄK"=>{city=>"Säckingen", province=>1},
+ "SÖM"=>{city=>"Sömmerda", province=>15},
+ "SÜW"=>{city=>"Südliche Weinstraße", province=>11},
+ "TBB"=>{city=>"Main-Tauber-Kreis", province=>1},
+ "TE"=>{city=>"Tecklenburg", province=>10},
+ "TET"=>{city=>"Teterow", province=>8},
+ "TF"=>{city=>"Teltow-Fläming", province=>4},
+ "TG"=>{city=>"Torgau", province=>13},
+ "TIR"=>{city=>"Tirschenreuth", province=>2},
+ "TO"=>{city=>"Torgau-Oschatz", province=>13},
+ "TP"=>{city=>"Templin", province=>4},
+ "TR"=>{city=>"Trier", province=>11},
+ "TS"=>{city=>"Traunstein", province=>2},
+ "TT"=>{city=>"Tettnang", province=>1},
+ "TUT"=>{city=>"Tuttlingen", province=>1},
+ "TÖL"=>{city=>"Bad Tölz-Wolfratshausen", province=>2},
+ "TÖN"=>{city=>"Tönning", province=>16},
+ "TÜ"=>{city=>"Tübingen", province=>1},
+ "UE"=>{city=>"Uelzen", province=>9},
+ "UEM"=>{city=>"Ueckermünde", province=>8},
+ "UER"=>{city=>"Uecker-Randow", province=>8},
+ "UFF"=>{city=>"Uffenheim", province=>2},
+ "UH"=>{city=>"Unstrut-Hainich-Kreis", province=>15},
+ "UL"=>{city=>"Ulm / Alb-Donau-Kreis", province=>1},
+ "UM"=>{city=>"Uckermark", province=>4},
+ "UN"=>{city=>"Unna", province=>10},
+ "USI"=>{city=>"Usingen", province=>7},
+ "ÜB"=>{city=>"Überlingen", province=>1},
+ "V"=>{city=>"Vogtlandkreis", province=>13},
+ "VAI"=>{city=>"Vaihingen", province=>1},
+ "VB"=>{city=>"Vogelsbergkreis", province=>7},
+ "VEC"=>{city=>"Vechta", province=>9},
+ "VER"=>{city=>"Verden", province=>9},
+ "VIB"=>{city=>"Vilsbiburg", province=>2},
+ "VIE"=>{city=>"Viersen", province=>10},
+ "VIT"=>{city=>"Viechtach", province=>2},
+ "VK"=>{city=>"Völklingen", province=>12},
+ "VL"=>{city=>"Villingen", province=>1},
+ "VOF"=>{city=>"Vilshofen", province=>2},
+ "VOH"=>{city=>"Vohenstrauß", province=>2},
+ "VS"=>{city=>"Schwarzwald-Baar-Kreis", province=>1},
+ "W"=>{city=>"Wuppertal", province=>10},
+ "WA"=>{city=>"Waldeck", province=>7},
+ "WAF"=>{city=>"Warendorf", province=>10},
+ "WAK"=>{city=>"Wartburgkreis", province=>15},
+ "WAM"=>{city=>"Westlicher Altmark-Kreis", province=>14},
+ "WAN"=>{city=>"Wanne-Eickel", province=>10},
+ "WAR"=>{city=>"Warburg", province=>10},
+ "WAT"=>{city=>"Wattenscheid", province=>10},
+ "WB"=>{city=>"Wittenberg", province=>14},
+ "WBS"=>{city=>"Worbis", province=>15},
+ "WD"=>{city=>"Wiedenbrück", province=>10},
+ "WDA"=>{city=>"Werdau", province=>13},
+ "WE"=>{city=>"Weimar", province=>15},
+ "WEB"=>{city=>"Westerburg-Westerwald", province=>11},
+ "WEG"=>{city=>"Wegscheid", province=>2},
+ "WEL"=>{city=>"Weilburg", province=>7},
+ "WEM"=>{city=>"Wesermünde", province=>9},
+ "WEN"=>{city=>"Weiden", province=>2},
+ "WER"=>{city=>"Wertingen", province=>2},
+ "WES"=>{city=>"Wesel", province=>10},
+ "WF"=>{city=>"Wolfenbüttel", province=>9},
+ "WG"=>{city=>"Wangen", province=>1},
+ "WHV"=>{city=>"Wilhelmshaven", province=>9},
+ "WI"=>{city=>"Wiesbaden", province=>7},
+ "WIL"=>{city=>"Wittlich", province=>11},
+ "WIS"=>{city=>"Wismar, Kreis", province=>8},
+ "WIT"=>{city=>"Witten", province=>10},
+ "WIZ"=>{city=>"Witzenhausen", province=>7},
+ "WK"=>{city=>"Wittstock", province=>4},
+ "WL"=>{city=>"Harburg", province=>9},
+ "WLG"=>{city=>"Wolgast", province=>8},
+ "WM"=>{city=>"Weilheim-Schongau", province=>2},
+ "WMS"=>{city=>"Wolmirstedt", province=>14},
+ "WN"=>{city=>"Rems-Murr-Kreis", province=>1},
+ "WND"=>{city=>"St. Wendel", province=>12},
+ "WO"=>{city=>"Worms", province=>11},
+ "WOB"=>{city=>"Wolfsburg", province=>9},
+ "WOH"=>{city=>"Wolfhagen", province=>7},
+ "WOL"=>{city=>"Wolfach", province=>1},
+ "WOR"=>{city=>"Wolfratshausen", province=>2},
+ "WOS"=>{city=>"Wolfstein", province=>2},
+ "WR"=>{city=>"Wernigerode", province=>14},
+ "WRN"=>{city=>"Waren", province=>8},
+ "WS"=>{city=>"Wasserburg a. Inn", province=>2},
+ "WSF"=>{city=>"Weißenfels", province=>14},
+ "WST"=>{city=>"Ammerland", province=>9},
+ "WSW"=>{city=>"Weißwasser", province=>13},
+ "WT"=>{city=>"Waldshut", province=>1},
+ "WTL"=>{city=>"Wittlage", province=>9},
+ "WTM"=>{city=>"Wittmund", province=>9},
+ "WUG"=>{city=>"Weißenburg-Gunzenhausen", province=>2},
+ "WUN"=>{city=>"Wunsiedel", province=>2},
+ "WUR"=>{city=>"Wurzen", province=>13},
+ "WW"=>{city=>"Westerwald-Kreis", province=>11},
+ "WZ"=>{city=>"Wetzlar", province=>7},
+ "WZL"=>{city=>"Wanzleben", province=>14},
+ "WÜ"=>{city=>"Würzburg", province=>2},
+ "WÜM"=>{city=>"Waldmünchen", province=>2},
+ "Z"=>{city=>"Zwickau (-Land)", province=>13},
+ "ZE"=>{city=>"Zerbst", province=>14},
+ "ZEL"=>{city=>"Zell / Mosel", province=>11},
+ "ZI"=>{city=>"Löbau-Zittau", province=>13},
+ "ZIG"=>{city=>"Ziegenhain", province=>7},
+ "ZP"=>{city=>"Zschopau", province=>13},
+ "ZR"=>{city=>"Zeulenroda", province=>15},
+ "ZS"=>{city=>"Zossen", province=>4},
+ "ZW"=>{city=>"Zweibrücken", province=>11},
+ "ZZ"=>{city=>"Zeitz", province=>14}
+ );
+ my ($key) = @_;
+ $key = $trans{lc $key} if defined $trans{lc $key};
+ my %location;
+ $key = uc($key);
+ my %base = %de_kfz;
+ if (defined $base{$key}) {
+ $location{country} = 'Germany';
+ $location{city} = $base{$key}{'city'};
+ $location{province} = $province{$base{$key}->{province}};
+ } else {
+ #Irssi::print $key;
+ foreach (keys %base) {
+ my $city = $base{$_}{city};
+ #$city = lc($city);
+ #$city =~ s/ä/ae/g;
+ #$city =~ s/ü/ue/g;
+ #$city =~ s/ö/oe/g;
+ #$city = uc($city);
+ if ($city =~ /(^| |-)$key( |-|$)/i) {
+ $location{country} = 'Germany';
+ $location{city} = $base{$_}{city};
+ $location{province} = $province{$base{$_}{province}};
+ }
+ }
+ }
+ return %location;
+}
+
+
+foreach ((352, 315)) {
+ Irssi::signal_add_first('event '.$_, 'process_reply');
+}
+
+sub pre_unload { save_cache(); }
+
+Irssi::signal_add('message join', 'event_message_join');
+Irssi::signal_add('query created', 'event_query_created');
+Irssi::signal_add('setup saved', 'save_cache');
+
+Irssi::settings_add_bool($IRSSI{'name'}, 'localize_background', 1);
+
+Irssi::settings_add_str($IRSSI{'name'}, 'localize_cache_filename', Irssi::get_irssi_dir()."/localize_cache");
+Irssi::settings_add_str($IRSSI{'name'}, 'localize_trace_cmd', "/usr/sbin/traceroute -q 1 -w 2 -I");
+Irssi::settings_add_int($IRSSI{'name'}, 'localize_trace_distance', 3);
+
+Irssi::settings_add_str($IRSSI{'name'}, 'localize_auto_localize_channel_list', '.*');
+Irssi::settings_add_bool($IRSSI{'name'}, 'localize_auto_localize_on_join', 0);
+Irssi::settings_add_bool($IRSSI{'name'}, 'localize_auto_localize_on_query', 1);
+Irssi::settings_add_int($IRSSI{'name'}, 'localize_auto_localize_maxrequests', 5);
+Irssi::settings_add_bool($IRSSI{'name'}, 'localize_get_coordinates', 0);
+Irssi::settings_add_bool($IRSSI{'name'}, 'localize_use_databases', 1);
+Irssi::settings_add_bool($IRSSI{'name'}, 'localize_use_traceroute', 1);
+Irssi::settings_add_bool($IRSSI{'name'}, 'localize_show_message', 1);
+Irssi::settings_add_str($IRSSI{'name'}, 'localize_ipatlas_nocache', '.*\.dip\.t-dialin\.net');
+
+Irssi::settings_add_bool($IRSSI{'name'}, 'localize_xplanet_show_map', 0);
+Irssi::settings_add_str($IRSSI{'name'}, 'localize_xplanet_temp_file', Irssi::get_irssi_dir()."/localize_xplanet_temp");
+Irssi::settings_add_str($IRSSI{'name'}, 'localize_xplanet_cmd', "xplanet -w");
+
+Irssi::theme_register([
+ auto_localize => '%B`->%n $0 ($1) has been localized in $2, $3, $4 %B[%n$5%B]%n',
+]);
+
+Irssi::command_bind('localize', 'cmd_localize');
+
+load_cache();
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /localize -h for help';
diff --git a/scripts/log2ansi.pl b/scripts/log2ansi.pl
new file mode 100644
index 0000000..718834c
--- /dev/null
+++ b/scripts/log2ansi.pl
@@ -0,0 +1,419 @@
+#! /usr/bin/perl
+#
+# Copyright (C) 2002-2021 by Peder Stray <peder.stray@gmail.com>
+#
+# This is a standalone perl program and not intended to run within
+# irssi, it will complain if you try to...
+
+use strict;
+use Getopt::Long;
+use Encode;
+use Pod::Usage;
+
+use vars qw(%ansi %base %attr %old);
+use vars qw(@bols @nums @mirc @irssi @mc @mh @ic @ih @cn);
+use vars qw($class $oldclass);
+
+use vars qw{$VERSION %IRSSI};
+($VERSION) = '$Revision: 1.11.1 $' =~ / (\d+(\.\d+)+) /;
+%IRSSI = (
+ name => 'log2ansi',
+ authors => 'Peder Stray',
+ contact => 'peder.stray@gmail.com',
+ url => 'https://github.com/pstray/irssi-log2ansi',
+ license => 'GPL',
+ description => 'Convert various color codes to ANSI colors, useful for log filtering and viewing.',
+ );
+
+my $opt_clear = 0;
+my $opt_html = 0;
+my $opt_utf8 = 0;
+my $opt_help = 0;
+
+if (__PACKAGE__ =~ /^Irssi/) {
+ # we are within irssi... die!
+ Irssi::print("%RWarning:%n log2ansi should not run from within irssi");
+}
+else {
+ do_convert();
+}
+
+sub defc {
+ my($attr) = shift || \%attr;
+ $attr->{fgc} = $attr->{bgc} = -1;
+ $attr->{fgh} = $attr->{bgh} = 0;
+}
+
+sub defm {
+ my($attr) = shift || \%attr;
+ $attr->{bold} = $attr->{underline} =
+ $attr->{blink} = $attr->{reverse} = 0;
+}
+
+sub def {
+ my($attr) = shift || \%attr;
+ defc($attr);
+ defm($attr);
+}
+
+sub setold {
+ %old = %attr;
+}
+
+sub emit {
+ my($str) = @_;
+ my(%elem,@elem);
+
+ if ($opt_clear) {
+ # do nothing
+ }
+ else {
+
+ if ($opt_html) {
+ my %class;
+
+ for (@bols) {
+ $class{$_}++ if $attr{$_};
+ }
+
+ for (qw(fg bg)) {
+ my $h = delete $class{"${_}h"};
+ my $n = $attr{"${_}c"};
+ next unless $n >= 0;
+ $class{"$_$cn[$n + 8 * $h]"}++;
+ }
+
+ $class = join " ", sort keys %class;
+
+ print qq{</span>} if $oldclass;
+ print qq{<span class="$class">} if $class;
+ $oldclass = $class;
+ }
+ else {
+ my(@clear) = ( (grep { $old{$_} > $attr{$_} } @bols),
+ (grep { $old{$_}>=0 && $attr{$_}<0 } @nums)
+ );
+
+ $elem{0}++ if @clear;
+
+ for (@bols) {
+ $elem{$base{$_}}++
+ if $attr{$_} && ($old{$_} != $attr{$_} || $elem{0});
+ }
+
+ for (@nums) {
+ $elem{$base{$_}+$attr{$_}}++
+ if $attr{$_} >= 0 && ($old{$_} != $attr{$_} || $elem{0});
+ }
+
+ @elem = sort {$a<=>$b} keys %elem;
+
+ if (@elem) {
+ @elem = () if @elem == 1 && !$elem[0];
+ printf "\e[%sm", join ";", @elem;
+ }
+ }
+ }
+
+ if ($opt_html) {
+ for ($str) {
+ s/&/&amp;/g;
+ s/</&lt;/g;
+ s/>/&gt;/g;
+ }
+ }
+
+ print $str;
+
+ setold;
+}
+
+sub do_convert {
+
+ GetOptions(
+ 'c|clear!' => \$opt_clear,
+ 'h|html!' => \$opt_html,
+ 'u|utf8!' => \$opt_utf8,
+ 'help' => sub { $opt_help = 1 },
+ 'full-help' => sub { $opt_help = 2 },
+ ) or pod2usage(2);
+
+ # show some help if stdin is a tty and no files
+ $opt_help = 1 if !$opt_help && -t 0 && !@ARGV;
+
+ pod2usage(-verbose => $opt_help,
+ -exitval => 0,
+ ) if $opt_help;
+
+ for (@ARGV) {
+ if (/\.xz$/) {
+ $_ = "unxz < '$_' |";
+ }
+ elsif (/\.bz2$/) {
+ $_ = "bunzip2 < '$_' |";
+ }
+ elsif (/\.gz$/) {
+ $_ = "gunzip < '$_' |";
+ }
+ elsif (/\.lzma$/) {
+ $_ = "unlzma < '$_' |";
+ }
+ }
+
+ my($n) = 0;
+ %ansi = map { $_ => $n++ } split //, 'krgybmcw';
+
+ @bols = qw(bold underline blink reverse fgh bgh);
+ @nums = qw(fgc bgc);
+
+ @base{@bols} = qw(1 4 5 7 1 5);
+ @base{@nums} = qw(30 40);
+
+ @mirc = split //, 'WkbgRrmyYGcCBMKw';
+ @irssi = split //, 'kbgcrmywKBGCRMYW';
+
+ @mc = map {$ansi{lc $_}} @mirc;
+ @mh = map {$_ eq uc $_} @mirc;
+
+ @ic = map {$ansi{lc $_}} @irssi;
+ @ih = map {$_ eq uc $_} @irssi;
+
+ @cn = qw(black dr dg dy db dm dc lgray dgray lr lg ly lb lm lc white);
+
+
+ if ($opt_html) {
+ print qq{<div class="loglines">\n};
+ }
+
+ if ($opt_utf8) {
+ binmode STDIN, ':bytes'; #encoding(cp1252)';
+ binmode STDOUT, ':encoding((UTF-8)';
+ }
+
+ while (<>) {
+ if ($opt_utf8) {
+ my $line;
+ while (length) {
+ $line .= decode("utf8", $_, Encode::FB_QUIET);
+ $line .= substr $_, 0, 1, "";
+ }
+ $_ = $line;
+ }
+
+ chomp;
+
+ def;
+ setold;
+
+ if ($opt_html) {
+ printf qq{<div class="logline">};
+ }
+
+ while (length) {
+ if (s/^\cB//) {
+ # toggle bold
+ $attr{bold} = !$attr{bold};
+
+ } elsif (s/^\cC//) {
+ # mirc colors
+
+ if (/^[^\d,]/) {
+ defc;
+ } else {
+
+ if (s/^(\d\d?)//) {
+ $attr{fgc} = $mc[$1 % 16];
+ $attr{fgh} = $mh[$1 % 16];
+ }
+
+ if (s/^,//) {
+ if (s/^(\d\d?)//) {
+ $attr{bgc} = $mc[$1 % 16];
+ $attr{bgh} = $mh[$1 % 16];
+ } else {
+ $attr{bgc} = -1;
+ $attr{bgh} = 0;
+ }
+ }
+ }
+
+ } elsif (s/^\cD//) {
+ # irssi format
+
+ if (s/^a//) {
+ $attr{blink} = !$attr{blink};
+ } elsif (s/^b//) {
+ $attr{underline} = !$attr{underline};
+ } elsif (s/^c//) {
+ $attr{bold} = !$attr{bold};
+ } elsif (s/^d//) {
+ $attr{reverse} = !$attr{reverse};
+ } elsif (s/^e//) {
+ # indent
+ } elsif (s/^f([^,]*),//) {
+ # indent_func
+ } elsif (s/^g//) {
+ def;
+ } elsif (s/^h//) {
+ # cleol
+ } elsif (s/^i//) {
+ # monospace
+ } else {
+ s/^(.)(.)//;
+ my($f,$b) = map { ord($_)-ord('0') } $1, $2;
+ if ($f<0) {
+ # $attr{fgc} = -1; $attr{fgh} = 0;
+ } else {
+ # c>7 => bold, c -= 8 if c>8
+ $attr{fgc} = $ic[$f];
+ $attr{fgh} = $ih[$f];
+ }
+ if ($b<0) {
+ # $attr{bgc} = -1; $attr{bgh} = 0;
+ } else {
+ # c>7 => blink, c -= 8
+ $attr{bgc} = $ic[$b];
+ $attr{bgh} = $ih[$b];
+ }
+ }
+
+ } elsif (s/^\cF//) {
+ # blink
+ $attr{blink} = !$attr{blink};
+
+ } elsif (s/^\cO//) {
+ def;
+
+ } elsif (s/^\cV//) {
+ $attr{reverse} = !$attr{reverse};
+
+ } elsif (s/^\c[\[([^m]*)m//) {
+ my(@ansi) = split ";", $1;
+ my(%a);
+
+ push @ansi, 0 unless @ansi;
+
+ for my $code (@ansi) {
+ if ($code == 0) {
+ def(\%a);
+ } elsif ($code == $base{bold}) {
+ $a{bold} = 1;
+ } elsif ($code == $base{underline}) {
+ $a{underline} = 1;
+ } elsif ($code == $base{blink}) {
+ $a{underline} = 1;
+ } elsif ($code == $base{reverse}) {
+ $a{reverse} = 1;
+ } elsif ($code >= 30 && $code <= 37) {
+ $a{fgc} = $code - 30;
+ } elsif ($code >= 40 && $code <= 47) {
+ $a{bgc} = $code - 40;
+ } else {
+ $a{$code} = 1;
+ }
+ }
+
+ if ($a{fgc} >= 0 && $a{bold}) {
+ $a{fgh} = 1;
+ $a{bold} = 0;
+ }
+
+ if ($a{bgc} >= 0 && $a{blink}) {
+ $a{bgh} = 1;
+ $a{blink} = 0;
+ }
+
+ for my $key (keys %a) {
+ $attr{$key} = $a{$key};
+ }
+
+ } elsif (s/^\c_//) {
+ $attr{underline} = !$attr{underline};
+
+ } else {
+ s/^(.[^\cB\cC\cD\cF\cO\cV\c[\c_]*)//;
+ emit $1;
+ }
+ }
+
+ def;
+ emit "";
+ if ($opt_html) {
+ print "</div>";
+ }
+ print "\n";
+ }
+
+ if ($opt_html) {
+ print "</div>\n";
+ }
+
+}
+
+__END__
+
+=head1 NAME
+
+log2ansi - Convert foo various color escape codes to ANSI (or strip them)
+
+=head1 SYNOPSIS
+
+B<log2ansi>
+[B<-c>|B<--clear>]
+[B<-h>|B<--html>]
+[B<-u>|B<--utf8>]
+[B<--help>]
+[I<logfile ...>]
+
+=head1 OPTIONS
+
+=over
+
+=item B<-c>, B<--clear>
+
+Instructs B<log2ansi> to clear all formatting and output plain text logs.
+
+=item B<-h>, B<--html>
+
+Instructs B<log2ansi> to output a HTML fragment instead of ANSI text.
+
+The whole log will be wrapped in a div with class C<loglines>, each line
+of the log in a div with class C<logline>. Colors are wrapped in spans,
+with a class name consisting of C<fg> or C<bg>, concatenated with the
+color name, either C<black> or C<white>, or C<r>, C<g>, C<b>, C<c>,
+C<m>, C<y>, or C<gray> prefixed with either C<l> for light, or C<d> for
+dark.
+
+You have to include appropriate CSS yourself to get any colors at all
+when viewing the log.
+
+=item B<-u>, B<--utf8>
+
+This forces output to be UTF-8, and does input decoding of UTF-8 with
+fallback to ISO-8859-1. Use this if your input logs have mixed UTF-8
+and ISO-8859-1.
+
+=item B<--help>, B<--full-help>
+
+Show help, either just option descriptions or a full man page.
+
+=back
+
+=head1 DESCRIPTION
+
+Use B<log2ansi> to convert logfiles from Irssi with internal escape
+codes, mIRC color codes or ANSI escapes to plain text with ANSI
+formatted color codes for viewing in a terminal.
+
+Use the B<--clear> option to strip all formatting escapes and output
+just plain text.
+
+You can supply input on standard input, or as filenames on the command
+line. Any file ending in B<.gz>, B<.bz2>, B<.xz> or B<.lzma> will be
+uncompressed automatically before processing.
+
+=head1 AUTHORS
+
+ Peder Stray <peder.stray@gmail.com>
+
+=cut
diff --git a/scripts/logcompress.pl b/scripts/logcompress.pl
new file mode 100644
index 0000000..39089c1
--- /dev/null
+++ b/scripts/logcompress.pl
@@ -0,0 +1,24 @@
+# compress log files when they're rotated
+# for irssi 0.7.99 by Timo Sirainen
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.01";
+%IRSSI = (
+ authors => "Timo \'cras\' Sirainen",
+ contact => "tss\@iki.fi",
+ name => "logcompress",
+ description => "compress logfiles then they\'re rotated",
+ license => "Public Domain",
+ url => "http://irssi.org/",
+ changed => "2002-03-04T22:47+0100"
+);
+
+
+my $compressor = "bzip2 -9";
+
+sub sig_rotate {
+ Irssi::command("exec - $compressor ".$_[0]->{real_fname});
+}
+
+Irssi::signal_add('log rotated', 'sig_rotate');
diff --git a/scripts/logresume.pl b/scripts/logresume.pl
new file mode 100644
index 0000000..0ce33a8
--- /dev/null
+++ b/scripts/logresume.pl
@@ -0,0 +1,253 @@
+# Idea based on queryresume.pl by Stefan Tomanek
+
+### NOTES/BUGS
+# - /set logresume_query_lines
+# - /set logresume_channel_lines (set to 0 to make this script act more like queryresume.pl)
+# - Coloured logs (/set autolog_colors ON) work perfectly well, and are recommended if you want it to look like you never left
+# - bonus feature: /logtail 10 will print the last 10 lines of a log
+# - bonus feature: /logview will open the log in your PAGER, or do e.g. /logview screen vim -R. You'll need to be using irssi in screen. Running the program without screen is possible, but you need to ^L to redraw after closing it, and if you look at it too long irssi blocks on output and all your connections will ping out
+# - behaviour on channel join fail is potentially a little odd. Unmotivated to test or fix this.
+
+use strict;
+use Irssi;
+use Fcntl qw( :seek O_RDONLY );
+
+our $VERSION = "0.6";
+our %IRSSI = (
+ name => "logresume",
+ description => "print last n lines of logs when opening queries/channels",
+ url => "http://explodingferret.com/linux/irssi/logresume.pl",
+ authors => "ferret",
+ contact => "ferret(tA)explodingferret(moCtoD), ferret on irc.freenode.net",
+ licence => "Public Domain",
+ changed => "2012-10-08",
+ changes => "0.6: added memory of windows that have been logresumed already"
+ . "0.5: added /logtail and /logview"
+ . "0.4: fixed problem with lines containing %, removed use warnings"
+ . "0.3: swapped File::ReadBackwards for internal tail implementation",
+ modules => "",
+ commands => "logtail, logview",
+ settings => "logresume_channel_lines, logresume_query_lines",
+);
+
+Irssi::print "$IRSSI{name} version $VERSION loaded, see the top of the script for help";
+if ( ! Irssi::settings_get_bool('autolog') ) {
+ Irssi::print( "$IRSSI{name}: /set autolog is currently OFF. This script probably won't work well unless it's ON" );
+}
+
+Irssi::settings_add_int($IRSSI{name}, 'logresume_channel_lines', 15);
+Irssi::settings_add_int($IRSSI{name}, 'logresume_query_lines', 20);
+
+my $debug = 0;
+sub debug_print { $debug and Irssi::print $IRSSI{name} . ' %RDEBUG%n: ' . $_[0]; }
+sub prettyprint { Irssi::print $IRSSI{name} . ' %Winfo%n: ' . $_[0]; }
+
+# This hash of hashes maps servertag -> item names -> _irssi. The point of this is so that
+# we don't print the last n log entries into a window that just recently had that item in it
+# (e.g. on server reconnect), since that content is like right there already.
+# the _irssi hash key is used as a unique identifier for windows (although they get reused).
+# Was using refnum for this originally, but it's very difficult to implement with that due to
+# the way the 'window refnum changed' and 'window destroyed' signals work (mostly the order
+# they run in).
+my %haveprinted;
+
+# initial fill of hash
+sub inithash {
+ for my $win ( Irssi::windows() ) {
+ for my $winitem ( $win->items() ) {
+ next unless $winitem->{type} eq 'QUERY' or $winitem->{type} eq 'CHANNEL';
+ next unless defined $winitem->{server} and defined $winitem->{name};
+ $haveprinted{$winitem->{server}{tag}}{$winitem->{name}} = $win->{_irssi};
+ }
+ }
+}
+
+inithash();
+
+# a new log was opened! initiate the process of printing some stuff to the screen
+Irssi::signal_add_last 'log started' => sub {
+ my ( $log ) = @_;
+ my $lines;
+
+ for my $logitem ( @{ $log->{items} } ) {
+ my $server = Irssi::server_find_tag( $logitem->{servertag} );
+ next unless defined $server;
+
+ next unless defined $logitem->{name};
+ my $winitem = $server->window_item_find( $logitem->{name} );
+ next unless defined $winitem;
+
+ my $irssiref = $winitem->window()->{_irssi};
+ my $servertag = $server->{tag};
+ my $itemname = $winitem->{name};
+
+ debug_print( "log started | servertag='$servertag' itemname='$itemname' irssiref='$irssiref'" );
+
+ if( $winitem->{type} eq 'QUERY' ) {
+ $lines = Irssi::settings_get_int('logresume_query_lines');
+ } elsif( $winitem->{type} eq 'CHANNEL' ) {
+ $lines = Irssi::settings_get_int('logresume_channel_lines');
+ } else {
+ next; # other window types not implemented
+ }
+
+ # don't print log output if we already did for this window, as that would indicate the
+ # item was recently in this window, so the scrollback contains this stuff already
+ if( $haveprinted{$servertag}{$itemname} ne $irssiref ) {
+ $haveprinted{$servertag}{$itemname} = $irssiref;
+ debug_print( "log started || not recorded as already printed, will do print_tail" );
+ print_tail( $winitem, $lines );
+ }
+ }
+};
+
+# when windows are destroyed we need to remove entries from %haveprinted
+Irssi::signal_add 'window destroyed' => sub {
+ my ( $win ) = @_;
+ my $irssiref = $win->{_irssi};
+ debug_print( "window destroyed | refnum='$win->{refnum}' irssiref='$irssiref'" );
+
+ for my $servertag (keys %haveprinted) {
+ for my $itemname (keys %{$haveprinted{$servertag}}) {
+ if ( $haveprinted{$servertag}{$itemname} eq $irssiref ) {
+ debug_print( "window destroyed || removed servertag='$servertag' itemname='$itemname'" );
+ $haveprinted{$servertag}{$itemname} = '';
+ }
+ }
+ }
+};
+
+Irssi::signal_add 'window item moved' => sub {
+ my ( $to_win, $winitem, $from_win ) = @_;
+ my $servertag = $winitem->{server}{tag};
+ my $itemname = $winitem->{name};
+
+ debug_print( "window item moved | servertag='$servertag' itemname='$itemname' was='$haveprinted{$servertag}{$itemname}' fromref='$from_win->{_irssi}' toref='$to_win->{_irssi}'" );
+ $haveprinted{$servertag}{$itemname} = $to_win->{_irssi};
+};
+
+Irssi::signal_add 'query nick changed' => sub {
+ my ( $win, $oldnick ) = @_;
+
+ debug_print( "query nick changed | oldnick='$oldnick' newnick='$win->{name}' transferring='$haveprinted{$win->{server}{tag}}{$oldnick}'" );
+ $haveprinted{$win->{server}{tag}}{$win->{name}} = $haveprinted{$win->{server}{tag}}{$oldnick};
+ $haveprinted{$win->{server}{tag}}{$oldnick} = '';
+};
+
+sub print_tail {
+ my ( $winitem, $lines ) = @_; # winitem is a channel or query or whatever
+
+ return unless $lines > 0;
+
+ my $log = get_log_filename( $winitem );
+ return unless defined $log;
+
+ my $winrec = $winitem->window(); # need to print to the window, not the window item
+
+ for( tail( $lines, $log ) ) { # sub tail is defined below
+ s/%/%%/g; # prevent irssi format notation being expanded
+ $winrec->print( $_, MSGLEVEL_NEVER );
+ }
+
+ $winrec->print( '%K[%Clogresume%n ' . $log . '%K]%n' );
+}
+
+
+sub get_log_filename {
+ my ( $winitem ) = @_;
+ my ( $tag, $name ) = ( $winitem->{server}{tag}, $winitem->{name} );
+
+ my @logs = map { $_->{real_fname} } grep {
+ grep {
+ $_->{name} eq $name and $_->{servertag} eq $tag
+ } @{ $_->{items} }
+ } Irssi::logs();
+
+ unless( @logs ) {
+ debug_print( "no logfile for $tag, $name" );
+ return undef;
+ }
+
+ debug_print( "surplus logfile for $tag, $name: $_" ) for @logs[1..$#logs];
+ return $logs[0];
+}
+
+
+Irssi::command_bind 'logtail' => sub {
+ my ( $lines ) = @_;
+ if ( not $lines =~ /[1-9][0-9]*/ ) {
+ prettyprint( 'usage: /logtail <number>' );
+ }
+
+ print_tail( Irssi::active_win()->{active}, $lines );
+};
+
+
+# irssi will NOT communicate in any way with the server while the command is running, unless the command returns immediately (e.g. running screen in screen, or backgrounded X11 text editor). So use screen.
+# usage: /logview foo bar baz
+# will run: foo bar baz filename.log
+Irssi::command_bind 'logview' => sub {
+ my ( $args, $server, $winitem ) = @_;
+
+ my $log = get_log_filename( $winitem );
+ return unless defined $log;
+
+ my $pager = $ENV{PAGER} || "less";
+ my $program = $_[0] || "screen $pager";
+
+ system( split( / /, $program ), $log ) == 0 or do {
+ if ( $? == -1 ) {
+ prettyprint( "logview: running command '$program $log' failed: $!" );
+ } elsif ( $? & 127 ) {
+ prettyprint( "logview: running command '$program $log' died with signal " . ( $? & 127 ) );
+ } else {
+ prettyprint( "logview: running command '$program $log' exited with status " . ( $? >> 8 ) );
+ }
+ };
+};
+
+
+sub tail {
+ my ( $needed_lines, $filename ) = @_;
+ return unless $needed_lines > 0;
+
+ my @lines = ();
+
+ sysopen( my $fh, $filename, O_RDONLY ) or return;
+ binmode $fh;
+ my $blksize = (stat $fh)[11];
+
+ # start at the end of the file
+ my $pos = sysseek( $fh, 0, SEEK_END ) or return;
+
+ # for the first chunk read a trailing partial block, so we start on what's probably a natural disk boundary
+ # if there's no trailing partial block read a full one
+ # Also guarantees that $pos will become zero before it becomes negative
+ $pos -= $pos % $blksize || $blksize;
+
+ # - 1 is because $lines[0] is partial
+ while ( @lines - 1 < $needed_lines ) {
+ # go to top of this chunk
+ sysseek( $fh, $pos, SEEK_SET ) or last; # partial output better than none
+
+ sysread( $fh, my $buf, $blksize );
+ last if $!;
+
+ # ruin my lovely generic tail function
+ $buf =~ s/^--- Log.*\n//mg;
+
+ if ( @lines ) {
+ splice @lines, 0, 1, split( /\n/, $buf . $lines[0], -1 );
+ } else {
+ @lines = split( /\n/, $buf, -1 );
+ # unix philosophy (as tail, wc, etc.): trailing newline is not a line for counting purposes
+ pop @lines if @lines and $lines[-1] eq "";
+ }
+
+ last if $pos == 0;
+
+ $pos -= $blksize;
+ }
+
+ return ( $needed_lines >= @lines ? @lines : @lines[ -$needed_lines .. -1 ] );
+}
diff --git a/scripts/ls.pl b/scripts/ls.pl
new file mode 100644
index 0000000..6481081
--- /dev/null
+++ b/scripts/ls.pl
@@ -0,0 +1,40 @@
+use vars qw($VERSION %IRSSI);
+
+use Irssi 20020120;
+$VERSION = "0.02";
+%IRSSI = (
+ authors => "c0ffee",
+ contact => "c0ffee\@penguin-breeder.org",
+ name => "List nicks in channel",
+ description => "Use /ls <regex> to show all nicks (including ident\@host) matching regex in the current channel",
+ license => "Public Domain",
+ url => "http://www.penguin-breeder.org/irssi/",
+ changed => "Fri Sep 06 15:36 CEST 2002",
+);
+
+
+sub cmd_ls {
+ my ($data, $server, $channel) = @_;
+ my @nicks;
+ my $n;
+ my $nick;
+
+ if ($channel->{type} ne "CHANNEL") {
+
+ Irssi::print("Your are not on a channel");
+ return;
+
+ }
+
+ @nicks = $channel->nicks();
+
+ foreach $nick (@nicks) {
+
+ $n = $nick->{nick} . "!" . $nick->{host};
+
+ $channel->print("$n") if $n =~ /$data/i;
+
+ }
+}
+
+Irssi::command_bind('ls','cmd_ls');
diff --git a/scripts/mailcheck_imap.pl b/scripts/mailcheck_imap.pl
new file mode 100644
index 0000000..b1ee937
--- /dev/null
+++ b/scripts/mailcheck_imap.pl
@@ -0,0 +1,566 @@
+# mailcheck_imap.pl
+
+# Contains code from centericq.pl (public domain) and imapbiff (GPL) and
+# hence this is also GPL'd.
+
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.5";
+%IRSSI = (
+ authors => "David \"Legooolas\" Gardner",
+ contact => "irssi\@icmfp.com",
+ name => "mailcheck_imap",
+ description => "Staturbar item which indicates how many new emails you have in the specified IMAP[S] mailbox",
+ sbitems => "mailcheck_imap",
+ license => "GNU GPLv2",
+ url => "http://icmfp.com/irssi",
+);
+
+
+# TODO:
+#
+# - command to show status, so we can see if we are currently connected
+# - add to statusbar item to say connected/not
+#
+# ? get user to type in password instead of storing it in a setting...
+# - eg. /mailcheck_imap_pass <password>
+#
+# - settings
+# - execute arbitrary command (with /exec?) on new mail?
+# - for 'spoing' or something ;)
+# - auto-reconnect on/off
+#
+#
+# LATER:
+# - show subject/sender/whatever of new mail (customizable)
+# - multiple accounts?
+# - multiple mailboxes?
+
+
+# Known bugs: segfaults on exit of irssi when script loaded :/
+
+
+use Irssi;
+use Irssi::TextUI;
+use IO::Socket;
+
+# TODO : avoid requiring SSL when it's not in use?
+#if (Irssi::settings_get_bool('mailcheck_imap_use_ssl')) {
+# Irssi::print("Using SSL.") if $debug_msgs;
+# $port = 993;
+ require IO::Socket::SSL;
+# - you need the package libio-socket-ssl-perl on Debian
+#}
+
+#
+# TODO : Set up signal handling for clean shutdown...
+#
+#$SIG{'ALRM'} = sub { die "socket timeout" };
+#$SIG{'QUIT'} = 'cleanup';
+#$SIG{'HUP'} = 'cleanup';
+#$SIG{'INT'} = 'cleanup';
+#$SIG{'KILL'} = 'cleanup';
+#$SIG{'TERM'} = 'cleanup';
+
+
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+
+sub show_help() {
+ my $help = $IRSSI{name}." ".$VERSION."
+/mailcheck_imap_help
+ Display this help.
+/mailcheck_imap
+ Check for new mail immediately, opening the connection if required.
+/mailcheck_imap_stop
+ Close connection to server and stop checking for new mail.
+/set mailcheck_imap
+ Show all mailcheck_imap settings.
+ Note: You need to set at least host, user and password.
+/statusbar <name> add mailcheck_imap
+ Add statusbar item for mailcheck.
+
+
+Formats in theme for statusbar item:
+(number of new mails in $0, total number of message in $1)
+ sb_mailcheck_imap = \"{sb Mail: $0 new, $1 total}\";
+ sb_mailcheck_imap_zero = \"{sb Mail: None new, $1 total}\";
+
+Format in theme for 'new mail arrived' message in current window:
+(number of new mails in $0, total number of message in $1)
+ mailcheck_imap_echo = \"You have $0 new message(s)!\";
+
+Note: You have to set at least the mailcheck_imap_host, user,
+ and password settings.
+
+IMPORTANT NOTE: As this stores the password in your irssi config
+file, you should really set the mode of the file to 0600 so that
+it's only readable by your user.
+";
+ my $text = "";
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP draw_box($IRSSI{name}, $text, "Help", 1);
+}
+
+
+sub cmd_mailcheck_imap_help {
+ show_help();
+}
+
+
+#
+# Global variables.
+#
+my $handle;
+my ($logged_in, $sleep);
+my ($last_refresh_time, $refresh_tag);
+my ($new_messages, $old_new_messages);
+my ($total_messages, $old_total_messages);
+
+$handle = 0;
+$logged_in = 0;
+$old_new_messages = -1;
+$old_total_messages = -1;
+
+
+#
+# Subroutine to update status, called every N seconds.
+#
+sub refresh_mailcheck_imap {
+
+ # For now, just print a message and return :)
+ Irssi::print("update hit.") if Irssi::settings_get_bool('mailcheck_imap_debug');
+
+ # ensure we have details for the login..
+ if(!check_details()) {
+ return 0;
+ }
+
+ if(!$handle) {
+ if(!setup_socket()) {
+ error("Couldn't setup socket to imap server!",0);
+ return 0;
+ }
+ }
+ Irssi::print("Socket is setup.") if Irssi::settings_get_bool('mailcheck_imap_debug');
+
+ if(!$logged_in) {
+ if(!login()) {
+ return 0;
+ }
+ }
+ $new_messages = check_imap("UNSEEN");
+ $total_messages = check_imap("MESSAGES");
+
+ $new_messages = 0 if (! $new_messages);
+ $total_messages = 0 if (! $total_messages);
+
+ if ($new_messages eq "-1" || $total_messages eq "-1") {
+ Irssi::print("check_imap returned an error, no updates.") if Irssi::settings_get_bool('mailcheck_imap_debug');
+ }
+
+ # update statusbar if changed rather than updating every the time...
+ if(($new_messages != $old_new_messages) ||
+ ($total_messages != $old_total_messages)) {
+ update_statusbar_item();
+ }
+
+
+ # TODO : This doesn't work if you get a sequence such as:
+ # check -> arrive, delete, arrive -> check
+ # as it is just done on the number of unseen messages and won't know..
+ if(($new_messages > $old_new_messages) &&
+ (Irssi::settings_get_bool('mailcheck_imap_echo_new_in_window'))) {
+ # If set, echo to the current window...
+ my $theme = Irssi::current_theme();
+ my $format = $theme->format_expand("{mailcheck_imap_echo}");
+
+ if ($format) {
+ # use theme-specific look
+ $format = $theme->format_expand("{mailcheck_imap_echo $new_messages $total_messages}", Irssi::EXPAND_FLAG_IGNORE_REPLACES);
+ } else {
+ # use the default look
+ $format = "mailcheck_imap: You have ".$new_messages." new message(s).";
+ }
+
+ print CLIENTCRAP $format;
+ }
+ $old_new_messages = $new_messages;
+ $old_total_messages = $total_messages;
+
+ # Adding new timeout to make sure that this function will be called again
+ if ($refresh_tag) {
+ Irssi::timeout_remove($refresh_tag);
+ }
+ my $time = Irssi::settings_get_int('mailcheck_imap_interval');
+ $refresh_tag = Irssi::timeout_add($time*1000, 'refresh_mailcheck_imap', undef);
+
+ return 1;
+}
+
+
+#
+# Subroutine to setup socket handle.
+#
+sub setup_socket {
+ # Set an alarm in case we can not connect or get hung. Older versions
+ # the IO::Socket perl module caused errors with the alarm we set before
+ # setting up the socket. If this program dies in debug mode saying:
+ # "Alarm clock", then you can probably fix it by upgrading your perl
+ # IO module.
+ my ($host,$port);
+
+ $host = Irssi::settings_get_str('mailcheck_imap_host');
+ $port = Irssi::settings_get_int('mailcheck_imap_port');
+
+ # change port number if SSL enabled and original imap port unchanged
+ if($port == 143 && Irssi::settings_get_bool('mailcheck_imap_use_ssl')) {
+ $port = 993;
+ }
+
+ eval {
+ alarm 30;
+ Irssi::print("mailcheck_imap connecting to mail server...");
+
+ if (Irssi::settings_get_bool('mailcheck_imap_use_ssl')) {
+ Irssi::print("Using ssl...") if Irssi::settings_get_bool('mailcheck_imap_debug');
+ $handle = IO::Socket::SSL->new(Proto => "tcp",
+ SSL_verify_mode => 0x00,
+ PeerAddr => $host,
+ PeerPort => $port,
+ )
+ or error("Can't connect to port $port on $host: $!",0), return 0;
+ } else {
+ $handle = IO::Socket::INET->new(Proto => "tcp",
+ PeerAddr => $host,
+ PeerPort => $port,
+ )
+ or error("Can't connect to port $port on $host: $!",0), return 0;
+ }
+ $handle->autoflush(1); # So output gets there right away.
+ Irssi::print("...done");
+ receive();
+ alarm 0;
+ };
+ if ($@) {
+ alarm 0;
+ if ($@ =~ /timeout/) {
+ alarm();
+ return 0;
+ } else {
+ error("$@",0);
+ return 0;
+ }
+ }
+ return 1;
+}
+
+#
+# Subroutine to login to the mailbox.
+#
+sub login {
+ my ($response,$success);
+ my ($user,$password);
+
+
+ $user = Irssi::settings_get_str('mailcheck_imap_user');
+ $password = Irssi::settings_get_str('mailcheck_imap_password');
+
+
+ $logged_in = 0;
+ # Set an alarm in case we can not connect or get hung. Older versions
+ # the IO::Socket perl module caused errors with the alarm we set before
+ # setting up the socket. If this program dies in debug mode saying:
+ # "Alarm clock", then you can probably fix it by upgrading your perl
+ # IO module.
+ eval {
+ alarm 30;
+ send_data("A001 LOGIN \"$user\" \"$password\"","\"$user\"");
+ while (1) {
+ ($success,$response) = receive();
+ if (! $success) {
+ return 0;
+ }
+ last if $response =~ /LOGIN|OK/;
+ }
+ if ($response =~ /fail|BAD/) {
+ return 0;
+ } else {
+ $logged_in = 1;
+ }
+ alarm 0;
+ };
+ if ($@) {
+ alarm 0;
+ if ($@ =~ /timeout/) {
+ alarm();
+ return 0;
+ } else {
+ error("$@",0);
+ return 0;
+ }
+ }
+ # Success! :D
+ return 1;
+}
+
+#
+# Subroutine that does check of imap mailbox.
+#
+sub check_imap {
+ my ($type) = @_;
+
+ #my ($type) = ("MESSAGES");
+
+ my ($response,$success,$num_messages);
+ # Set an alarm in case we can not connect or get hung. Older versions
+ # the IO::Socket perl module caused errors with the alarm we set before
+ # setting up the socket. If this program dies in debug mode saying:
+ # "Alarm clock", then you can probably fix it by upgrading your perl
+ # IO module.
+ eval {
+ alarm 30;
+ send_data("A003 STATUS INBOX ($type)");
+ while (1) {
+ ($success,$response) = receive();
+ if (! $success) {
+ return "-1";
+ }
+ last if $response =~ /STATUS\s+.*?\s+\($type/;
+ }
+ ($num_messages) = $response =~ /\($type\s+(\d+)\)/;
+ alarm 0;
+ };
+ if ($@) {
+ alarm 0;
+ if ($@ =~ /timeout/) {
+ alarm();
+ return "-1";
+ } else {
+ error("$@",0);
+ return "-1";
+ }
+ }
+ return $num_messages;
+}
+
+
+#
+# Subroutine to send a line to the imap server.
+# Block everything after $block.
+#
+sub send_data {
+ my ($line,$block) = (@_);
+ print $handle "$line\r\n";
+ $line =~ s/(.*$block).*/$1 ----/ if ($block);
+ Irssi::print("sent: $line") if Irssi::settings_get_bool('mailcheck_imap_debug');
+ return 1;
+}
+
+
+#
+# Subroutine to get a response from the imap server and print.
+# that response if in debug mode.
+#
+sub receive {
+ my ($response,$success);
+ $response = "";
+ $success = 0;
+ chomp($response = <$handle>);
+ if ($response) {
+ Irssi::print("got: $response") if Irssi::settings_get_bool('mailcheck_imap_debug');
+ $success = 1;
+ } else {
+ Irssi::print("no response!") if Irssi::settings_get_bool('mailcheck_imap_debug');
+ }
+ return ($success,$response);
+}
+
+#
+# Subroutine to display and error message in a text box.
+#
+sub error {
+ my ($error,$fatal) = (@_);
+
+ if ($fatal) {
+ # TODO : Print some useful message and die?
+ Irssi::print("mailcheck_imap FATAL : $error");
+ return 0;
+ } else {
+ Irssi::print("mailcheck_imap error : $error");
+
+ if ($refresh_tag) {
+ Irssi::timeout_remove($refresh_tag)
+ }
+ my $time = Irssi::settings_get_int('mailcheck_imap_interval');
+ $refresh_tag = Irssi::timeout_add($time*1000, 'refresh_mailcheck_imap', undef);
+ $handle = 0;
+ return 0;
+ }
+}
+
+#
+# Subroutine to call when alarm times out.
+#
+sub alarm {
+ Irssi::print("Alarm went off!") if Irssi::settings_get_bool('mailcheck_imap_debug');
+ return 1;
+}
+
+
+#
+# Subroutine to clean up.
+#
+sub cleanup {
+ if ($handle) {
+ send_data("A999 LOGOUT");
+ $handle->close();
+ }
+ Irssi::print("mailcheck_imap logged out.");
+}
+
+
+
+#######################################################################
+# Simply requests a statusbar item redraw.
+
+sub update_statusbar_item {
+ Irssi::statusbar_items_redraw('mailcheck_imap');
+}
+
+
+#######################################################################
+# This is the function called by irssi to obtain the statusbar item.
+
+sub mailcheck_imap {
+ my ($item, $get_size_only) = @_;
+
+ my $theme = Irssi::current_theme();
+ my $format = $theme->format_expand("{sb_mailcheck_imap}");
+
+ if ($format) {
+ # use theme-specific look
+ $format = $theme->format_expand("{sb_mailcheck_imap $new_messages $total_messages}", Irssi::EXPAND_FLAG_IGNORE_REPLACES);
+ } else {
+ # use the default look
+ $format = "{sb Mail: ".$new_messages." new, ".$total_messages." total}";
+ }
+
+ if($new_messages == 0) {
+ if(Irssi::settings_get_bool('mailcheck_imap_show_zero')) {
+ $format = $theme->format_expand("{sb_mailcheck_imap_zero $new_messages $total_messages}", Irssi::EXPAND_FLAG_IGNORE_REPLACES);
+
+ if (!$format) {
+ # use the default look
+ $format = "{sb Mail: None new, ".$total_messages." total}";
+ }
+ } else {
+ $format = "";
+ }
+ }
+
+ if (length($format) == 0) {
+ # nothing to print, so don't print at all
+ if ($get_size_only) {
+ $item->{min_size} = $item->{max_size} = 0;
+ }
+ } else {
+ $item->default_handler($get_size_only, $format, undef, 1);
+ }
+}
+
+
+################################################################################
+# Ensure that all required details are filled in:
+# host, user, password
+sub check_details {
+ my $host = Irssi::settings_get_str('mailcheck_imap_host');
+ my $user = Irssi::settings_get_str('mailcheck_imap_user');
+ my $password = Irssi::settings_get_str('mailcheck_imap_password');
+
+ if(!$host || !$user || !$password) {
+ show_help();
+ return 0;
+ }
+ return 1;
+}
+
+
+################################################################################
+# Immediately check for new mail (updates statusbar item too)
+
+sub cmd_mailcheck_imap {
+ refresh_mailcheck_imap();
+}
+
+
+################################################################################
+# Kill the connection and stop the refresh.
+sub cmd_mailcheck_imap_stop {
+ if ($refresh_tag) {
+ Irssi::timeout_remove($refresh_tag);
+ }
+ cleanup();
+}
+
+# Also close connection on script unload?
+sub sig_command_script_unload ($$$) {
+ my ($script, $server, $witem) = @_;
+
+ if($script =~ /^mailcheck_imap\.pl$/ ||
+ $script =~ /^mailcheck_imap/) {
+ cleanup();
+ }
+}
+
+Irssi::signal_add_first('command script unload', \&sig_command_script_unload);
+
+
+#######################################################################
+# Adding stuff to irssi
+
+Irssi::settings_add_int('mail', 'mailcheck_imap_interval', 120);
+Irssi::settings_add_bool('mail', 'mailcheck_imap_use_ssl', 0);
+Irssi::settings_add_bool('mail', 'mailcheck_imap_debug', 0);
+Irssi::settings_add_bool('mail', 'mailcheck_imap_show_zero', 0);
+Irssi::settings_add_bool('mail', 'mailcheck_imap_echo_new_in_window', 1);
+
+Irssi::settings_add_str('mail', 'mailcheck_imap_host', '');
+Irssi::settings_add_int('mail', 'mailcheck_imap_port', 143);
+Irssi::settings_add_str('mail', 'mailcheck_imap_user', '');
+Irssi::settings_add_str('mail', 'mailcheck_imap_password', '');
+
+
+Irssi::statusbar_item_register('mailcheck_imap', '{sb $0-}', 'mailcheck_imap');
+
+Irssi::command_bind('mailcheck_imap_help','cmd_mailcheck_imap_help');
+Irssi::command_bind('mailcheck_imap','cmd_mailcheck_imap');
+Irssi::command_bind('mailcheck_imap_stop','cmd_mailcheck_imap_stop');
+
+
+#######################################################################
+# Startup functions
+
+# Check that everything is fiiiine and start checking if so
+if(check_details()) {
+ # All is ok, so start running it
+ refresh_mailcheck_imap();
+ update_statusbar_item();
+}
+
+
+#######################################################################
diff --git a/scripts/mailcheck_mbox_flux.pl b/scripts/mailcheck_mbox_flux.pl
new file mode 100644
index 0000000..1964afb
--- /dev/null
+++ b/scripts/mailcheck_mbox_flux.pl
@@ -0,0 +1,126 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Irssi;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.2";
+%IRSSI = (
+ authors => "Erkki Seppälä",
+ contact => "flux\@inside.org",
+ name => "Mail Check",
+ description => "Polls your unix mailbox for new mail",
+ license => "Public Domain",
+ url => "http://xulfad.inside.org/~flux/software/irssi/",
+ changed => "2019-02-23"
+);
+
+sub getMessages( $ ) {
+ local *F;
+ open(F, "<", $_[0]) or return ();
+ my $inHeaders = 0;
+ my $headers;
+ my %result = ();
+ my $time;
+ while (<F>) {
+ chomp;
+ if (/^From /) {
+ my @fields = /^From [^ ]+ (.*)/;
+ $time = $fields[0];
+ $inHeaders = 1;
+ } elsif ($inHeaders) {
+ if ($_ eq "") {
+ $result{$time} = $headers;
+
+ $inHeaders = 0;
+ $headers = {};
+ } else {
+ my @fields = /^([^:]+): (.*)$/;
+ if (@fields == 2) {
+ $headers->{$fields[0]} = $fields[1];
+ }
+ }
+ }
+ }
+ close(F);
+
+ return %result;
+}
+
+# assumes both headers are in time order
+# format: From flux@xulfad.ton.tut.fi Wed Jan 24 23:44:00 2001
+sub newMail ( $$ ) {
+ my ($box, $contents) = @_;
+ my @newMail;
+ foreach my $mail (keys %{$contents}) {
+ if (!exists $box->{contents}->{$mail}) {
+ push @newMail, {%{$contents->{$mail}}, BOX=>$box};
+ }
+ }
+ return @newMail;
+}
+
+sub checkMail( $ ) {
+ my $boxes = shift;
+ my @changed = ();
+ foreach my $box (keys %{$boxes}) {
+# Irssi::print "Checking $box";
+ my @st = stat($box);
+ my $mtime = $st[9];
+ if ($mtime != $boxes->{$box}->{time}) {
+ my %contents = getMessages($box);
+ if ($boxes->{$box}->{time}) {
+ push @changed, newMail($boxes->{$box}, \%contents);
+ }
+ $boxes->{$box}->{contents} = \%contents;
+ $boxes->{$box}->{time} = $mtime;
+ }
+ }
+ return @changed;
+}
+
+sub coalesce {
+ while (@_) {
+ if (defined $_[0]) {
+ return $_[0];
+ }
+ shift;
+ }
+ return undef;
+}
+
+my @boxes;
+my %boxes;
+sub sig_setup_changed {
+ @boxes =split(/:/,Irssi::settings_get_str('mail_check_paths'));
+
+ # ("/var/spool/mail/flux" => {name=>"INBOX", time=>0} );
+ for (my $c = 0; $c < @boxes; ++$c) {
+ $boxes{$boxes[$c]}->{time} = 0;
+ if ($c == 0) {
+ $boxes{$boxes[$c]}->{name} = "INBOX";
+ } else {
+ my @f = $boxes[$c] =~ /([^\/]*)$/;
+ $boxes{$boxes[$c]}->{name} = $f[0];
+ }
+ }
+}
+
+sub check {
+ my @newMail = checkMail(\%boxes);
+ foreach my $mail (@newMail) {
+ my $row = $mail->{BOX}->{name} . " ::: " . $mail->{From} . ": " . coalesce($mail->{Subject}, "(no subject)");
+ Irssi::print($row);
+# active_server()->print($row);
+ }
+}
+
+Irssi::timeout_add(10000, "check", "");
+Irssi::signal_add('setup changed','sig_setup_changed');
+
+Irssi::settings_add_str('mail_check','mail_check_paths','/var/mail/'.$ENV{USER});
+
+sig_setup_changed();
+check();
+
+# vim:set ts=2 sw=2 expandtab:
diff --git a/scripts/mailcheck_pop3_kimmo.pl b/scripts/mailcheck_pop3_kimmo.pl
new file mode 100644
index 0000000..0b2fbaf
--- /dev/null
+++ b/scripts/mailcheck_pop3_kimmo.pl
@@ -0,0 +1,120 @@
+# Provides /mail command for POP3 mail checking
+# for irssi 0.7.98 (tested on CVS) by Kimmo Lehto
+#
+# Requires Net::POP3 module
+# If you don't have it, you can install it using:
+#
+# perl -e shell -MCPAN;
+# >install Net::POP3
+#
+
+use strict;
+use Irssi;
+use Net::POP3;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '0.6';
+%IRSSI = (
+ authors => 'Kimmo Lehto',
+ contact => 'kimmo@a-men.org' ,
+ name => 'Mailcheck-POP3',
+ description => 'POP3 new mail notification and listing of mailbox contents. Use "/mail help" for instructions. Requires Net::POP3.',
+ license => 'Public Domain',
+ changed => '2019-02-23'
+);
+
+
+my (%_mailcount, %_mailchecktimer);
+
+sub cmd_checkmail
+{
+ my $args = shift;
+ my ($user, $pass, $host) = split(/\;/, $args);
+ my ($i, $from, $subject, $head);
+ my $POP3TIMEOUT = Irssi::settings_get_int("pop3_timeout");
+ my $pop = Net::POP3->new( $host, Timeout => $POP3TIMEOUT );
+ my $count = $pop->login($user, $pass);
+
+ if (!$count || !$pop)
+ {
+ Irssi::print("Invalid POP3 user, pass or host.", MSGLEVEL_CLIENTERROR);
+ if (!$_mailcount{"$user\@$host"})
+ {
+ Irssi::timeout_remove($_mailchecktimer{"$user\@$host"});
+ delete $_mailchecktimer{"$user\@$host"};
+ }
+ $pop->quit();
+ return undef;
+ }
+ if (!$_mailcount{"$user\@$host"}) { $_mailcount{"$user\@$host"} = $count; $pop->quit(); return 1; }
+ if ($_mailcount{"$user\@$host"} < $count)
+ {
+ Irssi::print("%R>>%n New Mail for $user\@$host:");
+
+ for( $i = $_mailcount{"$user\@$host"} + 1; $i <= $count; $i++ )
+ {
+ foreach $head (@{$pop->top($i)})
+ {
+ if ($head =~ /^From:\s+(.*)$/i) { $from = $1; chomp($from);}
+ elsif ($head =~ /^Subject:\s+(.*)$/i) { $subject = $1; chomp($subject);}
+ }
+ Irssi::print("From : %W$from%n\nSubject: %W$subject%n");
+ }
+ }
+
+ $_mailcount{"$user\@$host"} = $count;
+ $pop->quit();
+ return 1;
+}
+sub start_check
+{
+ my ($userhost, $pass) = @_;
+ my ($user, $host) = split(/\@/, $userhost);
+ my $INTERVAL = Irssi::settings_get_int("pop3_interval");
+ if (cmd_checkmail("$user;$pass;$host"))
+ {
+ $_mailchecktimer{"$user\@$host"} = Irssi::timeout_add($INTERVAL * 1000, 'cmd_checkmail', "$user;$pass;$host");
+ Irssi::print("Account $user\@$host is now being monitored for new mail.");
+ }
+}
+
+sub cmd_mail
+{
+ my $args = shift;
+ my (@arg) = split(/\s+/, $args);
+
+ if (($arg[0] eq "add") && $arg[1] && $arg[2])
+ {
+ if ($_mailchecktimer{$arg[1]})
+ {
+ Irssi::print("Account " . $arg[1] . " is already being monitored.");
+ }
+ else
+ {
+ start_check($arg[1], $arg[2]);
+ }
+ }
+ elsif ($arg[0] eq "list")
+ {
+ Irssi::print("Active POP3 Accounts Being Monitored:");
+ foreach (keys %_mailchecktimer)
+ {
+ Irssi::print(" %W-%n $_ ($_mailcount{$_} Mail message(s))");
+ }
+ Irssi::print("End of /mail list");
+ }
+ else
+ {
+ Irssi::print("%Wmailcheck.pl%n $VERSION - By KimmoKe\%W@%nircnet\n");
+ Irssi::print("Usage:");
+ Irssi::print("/mail add <user\@host> <password> - add account to be monitored.");
+ Irssi::print("/mail list - list monitored accounts");
+ Irssi::print("\n%WNote:%n Passwords are kept in irssi's memory in %Wplain text%n, and the password will also remain in the command history. The POP3 authorization is currently also plain text.\n");
+ Irssi::print("Check interval and POP3 login timeout are controlled with %W/set pop3_interval%n (default: 60 seconds) and %Wpop3_timeout%n (default: 30 seconds).");
+ }
+}
+
+
+Irssi::settings_add_int("misc","pop3_timeout",30);
+Irssi::settings_add_int("misc","pop3_interval","60");
+Irssi::command_bind('mail', 'cmd_mail');
diff --git a/scripts/mangle.pl b/scripts/mangle.pl
new file mode 100644
index 0000000..f107d5d
--- /dev/null
+++ b/scripts/mangle.pl
@@ -0,0 +1,721 @@
+#!/usr/bin/perl
+#
+# by Szymon Sokol <szymon@hell.pl>
+# ideas taken from BabelIRC by Stefan Tomanek
+#
+
+use strict;
+use locale;
+use utf8;
+use Irssi 20020324;
+use Irssi::TextUI;
+use POSIX;
+use Data::Dumper;
+
+use vars qw($VERSION %IRSSI %HELP %channels %translations);
+$VERSION = '2019071201';
+%IRSSI = (
+ authors => 'Szymon Sokol',
+ contact => 'szymon@hell.pl',
+ name => 'mangle',
+ description => 'translates your messages into Morse code, rot13 and other sillinesses.',
+ sbitems => 'mangle_sb',
+ license => 'GPLv2',
+ url => 'http://irssi.org/scripts/',
+ changed => $VERSION,
+ modules => 'Data::Dumper'
+);
+
+# To work, this help requires scripthelp.pl by Maciek 'fahren' Freudenheim
+$HELP{"mangle add"} = "/mangle add <translation> [<channel>]
+Add a new translation entry for <channel> (default is current channel)";
+$HELP{"mangle del"} = "/mangle del [<channel>]
+Removes the translation for <channel> (default is current channel)";
+$HELP{"mangle say"} = "/mangle say <translation> <message>
+Says something to the current channel using given translation";
+$HELP{"mangle load"} = "/mangle load
+Loads translations from file";
+$HELP{"mangle save"} = "/mangle save
+Saves active translations to file";
+$HELP{"mangle show"} = "/mangle show
+Shows active translations";
+$HELP{"mangle list"} = "/mangle list
+Lists available translations";
+
+# the endless possibilities for extensions here
+%translations = (
+ # CChheecckk yyoouurr dduupplleexx sswwiittcchh
+ "duplex" => sub {
+ my ($text) = @_;
+ $text =~ s/./$&$&/g;
+ return $text;
+ },
+ # TaLk LiKe ThIs - EvErY OtHeR LeTtEr Is UpPeRcAse
+ "funky" => sub {
+ my ($text) = @_;
+ $text =~ s/(\w.)/\u$1/g;
+ return $text;
+ },
+ # TalkLikeThis-NoSpaces,WordBeginsWithUppercase
+ "gnome" => sub {
+ my ($text) = @_;
+ $text =~ s/\b(\w)/\u$1/g;
+ $text =~ s/\s+//g;
+ return $text;
+ },
+
+ # ds mangle by blap - double strike mathematical symbols
+ "ds" => sub {
+ my %ds = (
+ "A" => "ð”¸",
+ "B" => "ð”¹",
+ "C" => "â„‚",
+ "D" => "ð”»",
+ "E" => "ð”¼",
+ "F" => "ð”½",
+ "G" => "ð”¾",
+ "H" => "â„",
+ "I" => "ð•€",
+ "J" => "ð•",
+ "K" => "ð•‚",
+ "L" => "ð•ƒ",
+ "M" => "ð•„",
+ "N" => "â„•",
+ "O" => "ð•†",
+ "P" => "â„™",
+ "Q" => "â„š",
+ "R" => "â„",
+ "S" => "ð•Š",
+ "T" => "ð•‹",
+ "U" => "ð•Œ",
+ "V" => "ð•",
+ "W" => "ð•Ž",
+ "X" => "ð•",
+ "Y" => "ð•",
+ "Z" => "ℤ",
+ "a" => "ð•’",
+ "b" => "ð•“",
+ "c" => "ð•”",
+ "d" => "ð••",
+ "e" => "ð•–",
+ "f" => "ð•—",
+ "g" => "ð•˜",
+ "h" => "ð•™",
+ "i" => "ð•š",
+ "j" => "ð•›",
+ "k" => "ð•œ",
+ "l" => "ð•",
+ "m" => "ð•ž",
+ "n" => "ð•Ÿ",
+ "o" => "ð• ",
+ "p" => "ð•¡",
+ "q" => "ð•¢",
+ "r" => "ð•£",
+ "s" => "ð•¤",
+ "t" => "ð•¥",
+ "u" => "ð•¦",
+ "v" => "ð•§",
+ "w" => "ð•¨",
+ "x" => "ð•©",
+ "y" => "ð•ª",
+ "z" => "ð•«",
+ "0" => "ðŸ˜",
+ "1" => "ðŸ™",
+ "2" => "ðŸš",
+ "3" => "ðŸ›",
+ "4" => "ðŸœ",
+ "5" => "ðŸ",
+ "6" => "ðŸž",
+ "7" => "ðŸŸ",
+ "8" => "ðŸ ",
+ "9" => "ðŸ¡"
+ );
+ my ($text) = @_;
+ $text =~ s/./defined $ds{$&} ? $ds{$&} : "$&"/eg;
+ return $text;
+ },
+
+ # curs cursive by blap - cursive (bold) script
+ "curs" => sub {
+ my %curs = (
+ "A" => "ð“",
+ "B" => "ð“‘",
+ "C" => "ð“’",
+ "D" => "ð““",
+ "E" => "ð“”",
+ "F" => "ð“•",
+ "G" => "ð“–",
+ "H" => "ð“—",
+ "I" => "ð“˜",
+ "J" => "ð“™",
+ "K" => "ð“š",
+ "L" => "ð“›",
+ "M" => "ð“œ",
+ "N" => "ð“",
+ "O" => "ð“ž",
+ "P" => "ð“Ÿ",
+ "Q" => "ð“ ",
+ "R" => "ð“¡",
+ "S" => "ð“¢",
+ "T" => "ð“£",
+ "U" => "ð“¤",
+ "V" => "ð“¥",
+ "W" => "ð“¦",
+ "X" => "ð“§",
+ "Y" => "ð“¨",
+ "Z" => "ð“©",
+ "a" => "ð“ª",
+ "b" => "ð“«",
+ "c" => "ð“¬",
+ "d" => "ð“­",
+ "e" => "ð“®",
+ "f" => "ð“¯",
+ "g" => "ð“°",
+ "h" => "ð“±",
+ "i" => "ð“²",
+ "j" => "ð“³",
+ "k" => "ð“´",
+ "l" => "ð“µ",
+ "m" => "ð“¶",
+ "n" => "ð“·",
+ "o" => "ð“¸",
+ "p" => "ð“¹",
+ "q" => "ð“º",
+ "r" => "ð“»",
+ "s" => "ð“¼",
+ "t" => "ð“½",
+ "u" => "ð“¾",
+ "v" => "ð“¿",
+ "w" => "ð”€",
+ "x" => "ð”",
+ "y" => "ð”‚",
+ "z" => "ð”ƒ"
+ );
+ my ($text) = @_;
+ $text =~ s/./defined $curs{$&} ? $curs{$&} : "$&"/eg;
+ return $text;
+ },
+
+ # vapor double-width by blap - 'vaporwave' script
+ "vapor" => sub {
+ my %vapor = (
+ " " => " ",
+ "A" => "A",
+ "B" => "ï¼¢",
+ "C" => "ï¼£",
+ "D" => "D",
+ "E" => "ï¼¥",
+ "F" => "F",
+ "G" => "G",
+ "H" => "H",
+ "I" => "I",
+ "J" => "J",
+ "K" => "K",
+ "L" => "L",
+ "M" => "ï¼­",
+ "N" => "ï¼®",
+ "O" => "O",
+ "P" => "ï¼°",
+ "Q" => "ï¼±",
+ "R" => "ï¼²",
+ "S" => "ï¼³",
+ "T" => "ï¼´",
+ "U" => "ï¼µ",
+ "V" => "V",
+ "W" => "ï¼·",
+ "X" => "X",
+ "Y" => "ï¼¹",
+ "Z" => "Z",
+ "a" => "ï½",
+ "b" => "b",
+ "c" => "c",
+ "d" => "d",
+ "e" => "ï½…",
+ "f" => "f",
+ "g" => "g",
+ "h" => "h",
+ "i" => "i",
+ "j" => "j",
+ "k" => "k",
+ "l" => "l",
+ "m" => "ï½",
+ "n" => "n",
+ "o" => "ï½",
+ "p" => "ï½",
+ "q" => "q",
+ "r" => "ï½’",
+ "s" => "s",
+ "t" => "ï½”",
+ "u" => "u",
+ "v" => "ï½–",
+ "w" => "ï½—",
+ "x" => "x",
+ "y" => "ï½™",
+ "z" => "z",
+ "0" => "ï¼",
+ "1" => "1",
+ "2" => "ï¼’",
+ "3" => "3",
+ "4" => "ï¼”",
+ "5" => "5",
+ "6" => "ï¼–",
+ "7" => "ï¼—",
+ "8" => "8",
+ "9" => "ï¼™",
+ '[' => 'ï¼»',
+ ']' => 'ï¼½',
+ '{' => 'ï½›',
+ '}' => 'ï½',
+ '(' => '(',
+ ')' => ')',
+ '.' => '.',
+ ',' => ',',
+ '?' => '?',
+ '!' => 'ï¼',
+ '"' => chr(65282),
+ '\'' => ''',
+ '#' => '#',
+ '$' => '$',
+ '%' => 'ï¼…',
+ '^' => 'ï¼¾',
+ '&' => '&',
+ '=' => 'ï¼',
+ '\\' => 'ï¼¼',
+ '/' => 'ï¼',
+ '`' => 'ï½€'
+ );
+ my ($text) = @_;
+ $text =~ s/./defined $vapor{$&} ? $vapor{$&} : "$&"/eg;
+ return $text;
+ },
+
+ # blox cypher by blap
+ "blox" => sub {
+ my %blox = (
+ "a" => "â–ž",
+ "b" => "â–",
+ "c" => "â–Ž",
+ "d" => "â–…",
+ "e" => "â–ƒ",
+ "f" => "â–š",
+ "g" => "â—¼",
+ "h" => "â–‡",
+ "i" => "â–˜",
+ "j" => "â–›",
+ "k" => "┫",
+ "l" => "â–‹",
+ "m" => "â–†",
+ "n" => "â–",
+ "o" => "▜",
+ "p" => "â–ˆ",
+ "q" => "â–",
+ "r" => "â–„",
+ "s" => "▜",
+ "t" => "â–€",
+ "u" => "▌",
+ "v" => "â––",
+ "w" => "â–™",
+ "x" => "â–‚",
+ "y" => "â–—",
+ "z" => "â–Ÿ",
+ "0" => "â–Š",
+ "1" => "â–",
+ "2" => "â–”",
+ "3" => "â–’",
+ "4" => "â–",
+ "5" => "â–‘",
+ "6" => "â–²",
+ "7" => "┣",
+ "8" => "â–“",
+ "9" => "â–¼"
+ );
+ my ($text) = @_;
+ $text = lc($text);
+ $text =~ s/./defined $blox{$&} ? $blox{$&} : "$&"/eg;
+ return "╳".$text;
+ },
+
+ "morse" => sub {
+ my %morse = (
+ " " => "",
+ "a" => ".-",
+ "b" => "-...",
+ "c" => "-.-.",
+ "d" => "-..",
+ "e" => ".",
+ "f" => "..-.",
+ "g" => "--.",
+ "h" => "....",
+ "i" => "..",
+ "j" => ".---",
+ "k" => "-.-",
+ "l" => ".-..",
+ "m" => "--",
+ "n" => "-.",
+ "o" => "---",
+ "p" => ".--.",
+ "q" => "--.-",
+ "r" => ".-.",
+ "s" => "...",
+ "t" => "-",
+ "u" => "..-",
+ "v" => "...-",
+ "w" => ".--",
+ "x" => "-..-",
+ "y" => "-.--",
+ "z" => "--..",
+ # notice: Polish and German diacritical characters have their own
+ # Morse codes; the same probably stands true for other languages
+ # using ISO-8859-2 - if you happen to know them, please send me e-mail
+ "±" => ".-.-",
+ "æ" => "-.-..",
+ "ê" => "..-..",
+ "³" => ".-..-",
+ "ñ" => "--.-",
+ "ó" => "---.".
+ "¶" => "...-...",
+ "¼" => "--..",
+ "¿" => "--..-",
+ 'ä'=>'.-.-',
+ 'ö'=>'---.',
+ 'ü'=>'..--',
+ "0" => "-----",
+ "1" => ".----",
+ "2" => "..---",
+ "3" => "...--",
+ "4" => "....-",
+ "5" => ".....",
+ "6" => "-....",
+ "7" => "--...",
+ "8" => "---..",
+ "9" => "----.",
+ "'" => ".----.",
+ '"' => ".-..-.",
+ '.' => ".-.-.-",
+ ',' => "--..--",
+ '?' => "..--..",
+ ':' => "---...",
+ ';' => "-.-.-.",
+ '-' => "-....-",
+ '_' => "..--.-",
+ '/' => "-..-.",
+ '(' => "-.--.",
+ ')' => "-.--.-",
+ '@' => ".--.-.", # byFlorian Ernst <florian@uni-hd.de>
+ '=' => "-...-"
+ );
+ my ($text) = @_;
+ $text = lc($text);
+ $text =~ s/./defined $morse{$&} ? $morse{$&}." " : ""/eg;
+ return $text.'[morse]';
+ },
+
+ # Fraktur font by blap
+ "frakt" => sub {
+ my %HoA = (
+ 'a' => ["ð–†"],
+ 'b' => ["ð–‡"],
+ 'c' => ["ð–ˆ"],
+ 'd' => ["ð–‰"],
+ 'e' => ["ð–Š"],
+ 'f' => ["ð–‹"],
+ 'g' => ["ð–Œ"],
+ 'h' => ["ð–"],
+ 'i' => ["ð–Ž"],
+ 'j' => ["ð–"],
+ 'k' => ["ð–"],
+ 'l' => ["ð–‘"],
+ 'm' => ["ð–’"],
+ 'n' => ["ð–“"],
+ 'o' => ["ð–”"],
+ 'p' => ["ð–•"],
+ 'q' => ["ð––"],
+ 'r' => ["ð–—"],
+ 's' => ["ð–˜"],
+ 't' => ["ð–™"],
+ 'u' => ["ð–š"],
+ 'v' => ["ð–›"],
+ 'w' => ["ð–œ"],
+ 'x' => ["ð–"],
+ 'y' => ["ð–ž"],
+ 'z' => ["ð–Ÿ"],
+ 'A' => ["ð•¬"],
+ 'B' => ["ð•­"],
+ 'C' => ["ð•®"],
+ 'D' => ["ð•¯"],
+ 'E' => ["ð•°"],
+ 'F' => ["ð•±"],
+ 'G' => ["ð•²"],
+ 'H' => ["ð•³"],
+ 'I' => ["ð•´"],
+ 'J' => ["ð•µ"],
+ 'K' => ["ð•¶"],
+ 'L' => ["ð•·"],
+ 'M' => ["ð•¸"],
+ 'N' => ["ð•¹"],
+ 'O' => ["ð•º"],
+ 'P' => ["ð•»"],
+ 'Q' => ["ð•¼"],
+ 'R' => ["ð•½"],
+ 'S' => ["ð•¾"],
+ 'T' => ["ð•¿"],
+ 'U' => ["ð–€"],
+ 'V' => ["ð–"],
+ 'W' => ["ð–‚"],
+ 'X' => ["ð–ƒ"],
+ 'Y' => ["ð–„"],
+ 'Z' => ["ð–…"]
+ );
+ my ($text) = @_;
+ $text =~ s/./defined $HoA{$&} ? $HoA{$&}[rand(@{$HoA{$&}})] : "$&"/eg;
+ return $text;
+ },
+
+ # Unicode Obfusticator by blap
+ "obfus" => sub {
+ my %HoA = (
+ '0' => ["Ө","Ὀ","Ồ","Ổ","Θ","Ǒ","Ȏ","ϴ","Ò","Õ","Ô","Ǿ"],
+ '1' => ["Ĭ","Ἰ","Ī","Ӏ","Ί","Ι","І","Ї","Ῐ","Ῑ","Ὶ"],
+ '2' => ["ƻ","ƨ"],
+ '3' => ["Æ·","Ó ","Ò˜","Ò™","Óž","з","Õ…","З","É"],
+ '4' => ["Ч"],
+ '5' => ["Ƽ"],
+ '6' => ["Ç","É™"],
+ '7' => ["7"],
+ '8' => ["Õ‘"],
+ '9' => ["9"],
+ 'a' => ["á¼…","á¼","ẚ","Ó“","á½±","á¾·","ᾶ","á¾±","ÇŽ","ÇŸ","ά","É‘"],
+ 'b' => ["ƃ","ƅ","þ","ḃ","ḅ","ḇ","ϸ","ɓ"],
+ 'c' => ["ċ","ć","ƈ","ⅽ","ϛ","ç","ς","ϲ"],
+ 'd' => ["ÆŒ","ḑ","â…¾","ḋ","á¸","á¸","Õª","É—","É–"],
+ 'e' => ["Ñ‘","Ä—","ệ","ѳ","ḕ","á¸","è","ê","ϱ","È©","ε"],
+ 'f' => ["Ò“","Æ’","Å¿","ẛ","Ï","ḟ"],
+ 'g' => ["ÄŸ","Ä£","É¡","Ç¥","ǧ","Ö","Õ£","ǵ","ḡ","É•"],
+ 'h' => ["ĥ","һ","ẖ","ɧ","ɦ","ի","ḩ","ḫ","հ"],
+ 'i' => ["Ä©","Ä«","á¼²","É©","¡","í","ì","Î","ί","ι","ḭ"],
+ 'j' => ["ј","ĵ","Ê","È·","Ç°","Õµ"],
+ 'k' => ["Ò","Æ™","ĸ","Ä·","к","ḱ","ḳ","κ"],
+ 'l' => ["ł","ŀ","ƚ","ľ","ĺ","ɫ","ǀ","ɭ","ɬ","ḻ","ḽ"],
+ 'm' => ["â‚¥","ṃ","á¹","ɱ","ḿ"],
+ 'n' => ["ƞ","ἤ","ṅ","ή","ñ","ɴ","ᾗ","ᾕ","ᾔ","ῇ","ռ","ղ"],
+ 'o' => ["á»›","ở","á½","Å","Å","Æ¡","ὸ","á½¹","ó","ò","ʘ","È«"],
+ 'p' => ["Ñ€","Ò","á¹—","ṕ","ῤ","á¿¥","þ","Õ©"],
+ 'q' => ["Ô›","Ê ","Õ¦","Õ£"],
+ 'r' => ["ŗ","ŕ","ѓ","ӷ","г","ȑ","ɽ","ɼ"],
+ 's' => ["ş","ś","ṧ","ṣ","ԑ","š","ʂ"],
+ 't' => ["†","ṫ","ť","ț","Ւ","ȶ","ʈ"],
+ 'u' => ["ư","ṻ","ṳ","ů","ū","ụ","ủ","ù","µ","ǜ","ǚ"],
+ 'v' => ["ṿ","á½","á½—","á½”","á½»","ѵ","Ò¯","á¿ ","á¿¢","â…´","ΰ"],
+ 'w' => ["Ô","ẉ","ẃ","áº","ŵ","ẇ","ẅ"],
+ 'x' => ["ẋ","Ò³","áº","Ï°"],
+ 'y' => ["у","ƴ","ӯ","ў","ỹ","ỵ","ỷ","ẙ","ÿ"],
+ 'z' => ["ƶ","ž","ż","ź","ẓ","ẑ","ʑ"],
+ 'A' => ["Ẩ","Ậ","Ä„","Ἆ","Ó","á¾»","á¾¹","Α","Ⱥ","Ã","ᾉ","ᾈ"],
+ 'B' => ["Æ","Ḃ","Ḅ","Î’","Ð’"],
+ 'C' => ["Č","Ĉ","Ć","₵","Ҫ","Ͼ","Ç"],
+ 'D' => ["Ä","ÆŠ","Ɖ","Ḓ","Ḋ","Ḍ","Ḏ","Ã"],
+ 'E' => ["Ẹ","Ę","Ẽ","Ä”","Ệ","Æ","Ô","Ḗ","Ḝ","Ὲ","Ȩ"],
+ 'F' => ["Ò’","Æ‘","â‚£","Ï","Ïœ"],
+ 'G' => ["Ĝ","Ğ","Ġ","Ģ","Ǥ","Ḡ","Ǵ"],
+ 'H' => ["Ĥ","Ó‡","Ò¤","Ò¢","Èž","Ð","Ḥ","Ḫ"],
+ 'I' => ["Ỉ","á¼¹","Ī","Ä°","Ȉ","ÈŠ","Ι","Ã","Ḭ","á¿š","Ḯ"],
+ 'J' => ["Ĵ","ʆ","Ј"],
+ 'K' => ["₭","Ƙ","Ķ","Κ","Ḱ","Ḳ","Ḵ","К","Ќ"],
+ 'L' => ["Å","Ľ","â…¬","Ḷ","Ḹ","Ḻ","â„’"],
+ 'M' => ["Ó","Ṃ","á¹€","Îœ","Ðœ","Ḿ"],
+ 'N' => ["Ň","Ņ","Ń","₦","Ṋ","Ṉ","Ñ","Ǹ"],
+ 'O' => ["Ӫ","Ờ","Ổ","Ọ","Θ","Ø","Ò","Õ","Ȭ","Ȯ"],
+ 'P' => ["Ƥ","Ҏ","Ṗ","Ṕ","₱","Ῥ","Ρ"],
+ 'Q' => ["Ôš"],
+ 'R' => ["Ř","Å–","Å”","Ṟ","Ṙ","È"],
+ 'S' => ["ÏŸ","Åž","Åœ","á¹ ","Å ","Ș","Õ"],
+ 'T' => ["Ṱ","Ṯ","Ṫ","Ʈ","Ŧ","Ţ","Т","Τ","Ί"],
+ 'U' => ["Ự","Ų","Ứ","Ử","Ũ","Ȕ","Ȗ","Ǖ","Ǘ","Ǜ","Û","Ú"],
+ 'V' => ["á¹¾","á¹¼","Ѷ","â‹","â…¤"],
+ 'W' => ["Ԝ","Ẉ","Ẃ","Ẁ","Ŵ","Ẇ","Ẅ"],
+ 'X' => ["Ẋ","Ҳ","Ẍ","Х","Χ"],
+ 'Y' => ["Ỹ","Ẏ","Ұ","Ÿ","Ỳ","Ỵ","¥","ϓ","Ȳ","Υ"],
+ 'Z' => ["Ž","Ż","Ź","Ẓ","Ζ","Ȥ"],
+ );
+ my ($text) = @_;
+ $text =~ s/./defined $HoA{$&} ? $HoA{$&}[rand(@{$HoA{$&}})] : "$&"/eg;
+ return $text;
+ },
+
+ # convert text in Polish from ISO-8859-2 to 7-bit approximation
+ # if you know how to do it for other languages using 8859-2,
+ # please let me know
+ "polskawe" => sub {
+ my ($text) = @_;
+ $text =~ y/¡ÆÊ£ÑÓ¦¯¬±æê³ñ󶿼/ACELNOSZZacelnoszz/;
+ return $text;
+ },
+ # Ouch, my eyes!
+ "rainbow" => sub {
+ my ($text) = @_;
+ # colors list
+ # 0 == white
+ # 4 == light red
+ # 8 == yellow
+ # 9 == light green
+ # 11 == light cyan
+ # 12 == light blue
+ # 13 == light magenta
+ my @colors = ('00','04','08','09','11','12','13');
+ my $color;
+ $text = join '', map { push @colors, $color = shift @colors;
+"\003" . $color . ($_ eq "," ? ",," : $_) } split(//,$text);
+ return $text;
+ },
+ # .drawkcab klaT
+ "reverse" => sub {
+ my ($text) = @_;
+ $text = scalar reverse $text;
+ return $text;
+ },
+ # Gnyx va ebg13 rapbqvat.
+ "rot13" => sub {
+ my ($text) = @_;
+ $text =~ y/N-ZA-Mn-za-m/A-Za-z/;
+ return $text.' [rot13]';
+ },
+ # T-T-Talk l-l-like y-y-you h-h-have a s-s-stutter.
+ "stutter" => sub {
+ my ($text) = @_;
+ $text =~ s/(\w)(\w+)/$1-$1-$1$2/g;
+ return $text;
+ },
+ # rmv vwls
+ "vowels" => sub {
+ my ($text) = @_;
+ $text =~ y/aeiouy±ê//d;
+ return $text;
+ }
+);
+
+sub add_channel ($$) {
+ my ($channel,$code) = @_;
+ $channels{$channel} = $code;
+}
+
+sub save_channels {
+ my $filename = Irssi::settings_get_str('mangle_filename');
+ my $fo;
+ open $fo, '>',$filename;
+ my $data = Dumper(\%channels);
+ print $fo $data;
+ close $fo;
+ print CLIENTCRAP "%R>>%n Mangle channels saved";
+}
+
+sub load_channels {
+ my $filename = Irssi::settings_get_str('mangle_filename');
+ return unless (-e $filename);
+ my $fi;
+ open $fi, '<',$filename;
+ my $text;
+ $text .= $_ foreach <$fi>;
+ #no strict "vars";
+ my $VAR1;
+ eval "$text";
+ %channels = %$VAR1;
+}
+
+sub mangle_show ($$) {
+ my ($item, $get_size_only) = @_;
+ my $win = !Irssi::active_win() ? undef : Irssi::active_win()->{active};
+ if (ref $win && ($win->{type} eq "CHANNEL" || $win->{type} eq "QUERY") && $channels{$win->{name}}) {
+ my $code = $channels{$win->{name}};
+ $item->{min_size} = $item->{max_size} = length($code);
+ $code = '%U%g'.$code.'%U%n';
+ my $format = "{sb ".$code."}";
+ $item->default_handler($get_size_only, $format, 0, 1);
+ } else {
+ $item->{min_size} = $item->{max_size} = 0;
+ }
+}
+sub cmd_mangle ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @arg = split(/ +/, $args);
+ if ($arg[0] eq 'add' && defined $arg[1]) {
+ my $code = $arg[1];
+ if(exists $translations{$code}) {
+ if (defined $arg[2]) {
+ add_channel($arg[2], $code);
+ }
+ elsif($witem) {
+ add_channel($witem->{name}, $code);
+ }
+ } else {
+ Irssi::print("There is no such translation as $code !");
+ }
+ } elsif ($arg[0] eq 'del') {
+ if(defined $arg[1]) {
+ delete $channels{$arg[1]} if defined $channels{$arg[1]};
+ } elsif($witem) {
+ delete $channels{$witem->{name}} if defined $channels{$witem->{name}};
+ }
+ } elsif ($arg[0] eq 'say' && defined $arg[1]) {
+ my $code = $arg[1];
+ if(exists $translations{$code}) {
+ if($witem) {
+ say($code, join(' ',@arg[2..$#arg]), $server, $witem);
+ }
+ } else {
+ Irssi::print("There is no such translation as $code !");
+ }
+ } elsif ($arg[0] eq 'save') {
+ save_channels();
+ } elsif ($arg[0] eq 'load') {
+ load_channels();
+ } elsif ($arg[0] eq 'list') {
+ Irssi::print("mangle: available translations are: ".
+ join(" ", sort keys %translations));
+ } elsif ($arg[0] eq 'show') {
+ for (sort keys %channels) {
+ Irssi::print("mangle: ".$_." set to ".$channels{$_});
+ }
+ } else {
+ Irssi::print("mangle v. $VERSION; use /help mangle for help (ensure you have scripthelp.pl loaded!)");
+ }
+ Irssi::statusbar_items_redraw('mangle_sb');
+}
+
+sub say ($$$$) {
+ my ($code, $line, $server, $witem) = @_;
+ my $target = "";
+ if ($line =~ s/^(\w+?: )//) {
+ $target = $1;
+ }
+ $line = $translations{$code}->($line);
+ $server->command('MSG '.$witem->{name}.' '.$target.$line);
+}
+
+sub event_send_text ($$$) {
+ my ($line, $server, $witem) = @_;
+ return unless ($witem &&
+ ($witem->{type} eq "CHANNEL" || $witem->{type} eq "QUERY") &&
+ $channels{$witem->{name}});
+ say($channels{$witem->{name}}, $line, $server, $witem);
+ Irssi::signal_stop();
+ Irssi::statusbar_items_redraw('mangle_sb');
+}
+
+# main
+
+Irssi::command_bind('mangle', \&cmd_mangle);
+foreach my $cmd ('add', 'del', 'save', 'load', 'say', 'list', 'show') {
+ Irssi::command_bind('mangle '.$cmd => sub {
+ cmd_mangle($cmd." ".$_[0], $_[1], $_[2]); });
+}
+
+Irssi::statusbar_item_register('mangle_sb', 0, "mangle_show");
+Irssi::signal_add('setup saved', 'save_channels');
+Irssi::signal_add('send text', \&event_send_text);
+Irssi::signal_add('window changed', sub {Irssi::statusbar_items_redraw('mangle_sb');});
+
+Irssi::settings_add_str($IRSSI{name}, 'mangle_filename', Irssi::get_irssi_dir()."/mangle_channels");
+load_channels();
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /help mangle for help';
+
+# ;-)
diff --git a/scripts/map.pl b/scripts/map.pl
new file mode 100644
index 0000000..1d4c713
--- /dev/null
+++ b/scripts/map.pl
@@ -0,0 +1,129 @@
+# Map - Generates simple tree of IRC network based on the output of the LINKS
+# command.
+#
+# $Id: map.pl,v 1.2 2002/02/01 22:21:20 pasky Exp pasky $
+
+
+use strict;
+
+use vars qw ($VERSION %IRSSI $rcsid);
+
+$rcsid = '$Id: map.pl,v 1.2 2002/02/01 22:21:20 pasky Exp pasky $';
+($VERSION) = '$Revision: 1.2 $' =~ / (\d+\.\d+) /;
+%IRSSI = (
+ name => 'map',
+ authors => 'Petr Baudis',
+ contact => 'pasky@ji.cz',
+ url => 'http://pasky.ji.cz/~pasky/dev/irssi/',
+ license => 'GPLv2, not later',
+ description => 'Generates simple tree of IRC network based on the output of the LINKS command.'
+ );
+
+
+my $root; # The root lc(server)
+my %tree; # Key is lc(server), value is lc(array of downlinks)
+my %rcase; # Key is lc(server), value is server
+my %sname; # Key is lc(server), value is server's name
+my @branches; # Index is level, value is (should_print_'|')
+
+
+use Irssi 20011112;
+use Irssi::Irc;
+
+
+sub cmd_map {
+ my ($data, $server, $channel) = @_;
+
+ # ugly, but no easy way how to distinguish between two mixes links output :/
+ $server->redirect_event('command map', 0, '',
+ (split(/\s+/, $data) > 1), undef,
+ {
+ "event 364", "redir links_line",
+ "event 365", "redir links_done",
+ } );
+
+ $server->send_raw("LINKS $data");
+
+ Irssi::signal_stop();
+}
+
+
+sub event_links_line {
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $to, $from, $hops, $name) = $data =~ /^(\S*)\s+(\S*)\s+(\S*)\s+:(\d+)\s+(.*)$/;
+
+ $rcase{lc($from)} = $from;
+ $rcase{lc($to)} = $to;
+ $sname{lc($to)} = $name;
+
+ if ($hops == 0) {
+ $root = lc($from);
+ } else {
+ push(@{$tree{lc($from)}}, lc($to));
+ }
+
+ Irssi::signal_stop();
+}
+
+sub event_links_done {
+ my ($server, $data, $nick, $address) = @_;
+
+ @branches = (' ');
+
+ print_server($root, 0) if ($root);
+
+ $root = undef;
+}
+
+sub print_server {
+ my ($parent, $level, $last) = @_;
+ my ($i, $str);
+
+ for ($i = 0; $i < $level; $i++) {
+ $str .= " " . $branches[$i];
+ }
+
+ $str .= ($level ? "-" : " ") . " ";
+ $str .= $rcase{$parent};
+ $str = sprintf('%-50s %s', $str, $sname{$parent})
+ if Irssi::settings_get_bool("show_server_names");
+
+ Irssi::print $str;
+
+ return unless ($tree{$parent});
+
+ $branches[$level - 1] = ' '
+ if ($level and $branches[$level - 1] eq '`');
+
+ $branches[$level] = '|';
+
+ while (@{$tree{$parent}}) {
+ my ($server) = shift @{$tree{$parent}};
+
+ $last = not scalar @{$tree{$parent}}; # sounds funny, eh? :^)
+ $branches[$level] = '`' if ($last);
+
+ print_server($server, $level + 1, $last);
+ }
+}
+
+
+Irssi::command_bind("map", "cmd_map");
+Irssi::signal_add("redir links_line", "event_links_line");
+Irssi::signal_add("redir links_done", "event_links_done");
+Irssi::settings_add_bool("lookandfeel", "show_server_names", 1);
+
+Irssi::Irc::Server::redirect_register("command map", 0, 0,
+ {
+ "event 364" => 1, # link line (wait...)
+ },
+ {
+ "event 402" => 1, # not found
+ "event 263" => 1, # try again
+ "event 365" => 1, # end of links
+ },
+ undef,
+ );
+
+
+Irssi::print("Map $VERSION loaded...");
diff --git a/scripts/mass_hilight_blocker.pl b/scripts/mass_hilight_blocker.pl
new file mode 100644
index 0000000..559d02d
--- /dev/null
+++ b/scripts/mass_hilight_blocker.pl
@@ -0,0 +1,62 @@
+# disable hilighting of mass-hilights
+# (messages which contain a lot of nicknames)
+#
+# DESCRIPTION
+# sometimes a jester annoys a channel with a message
+# containing a lot of nicks that are in that channel.
+# this script prevents hilighting of a window in this
+# case. number of nicks in the message is user
+# configurable in the variable mass_highlight_threshold.
+#
+# CHANGELOG
+# * 01.05.2004
+# fixed problems with nicks containing brackets
+# added comments, description and this changelog :)
+# * 30.05.2004
+# first version of the script
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.4";
+%IRSSI = (
+ authors => "Uli Baumann",
+ contact => "f-zappa\@irc-muenster.de",
+ name => "mass_hilight_blocker",
+ description => "Disables hilighting for messages containing a lot of nicknames",
+ license => "GPL",
+ changed => "Sun Nov 11 15:30:00 CET 2018",
+);
+
+
+sub sig_printtext {
+ my ($dest, $text, $stripped) = @_; # our parameters
+ my $window = $dest->{window}; # where irssi wants to output
+ my $num_nicks=-1; # don't count target's nick
+ my $max_num_nicks=Irssi::settings_get_int('mass_hilight_threshold');
+
+ if ($dest->{level} & MSGLEVEL_HILIGHT)# we solely look at hilighted messages
+ {
+ my $server = $dest->{server}; # get server and channel for target
+ my $channel = $server->channel_find($dest->{target});
+
+ foreach my $nick ($channel->nicks()) # walk through nicks
+ {
+ $nick = $nick->{nick};
+ if ($text =~ /\Q$nick/) # does line contain this nick?
+ {$num_nicks++;} # then increase counter
+ }
+
+ if ($num_nicks>=($max_num_nicks)) # all criteria match?
+ {
+ $dest->{level} = MSGLEVEL_CLIENTCRAP;
+ Irssi::signal_continue($dest, $text, $stripped); # continue with changed level
+ $window->print('mass-hilighting in above message ('.$num_nicks.' nicks)',MSGLEVEL_CLIENTCRAP);
+ }
+ }
+}
+
+# tell irssi to use this and initialize variable if necessary
+
+Irssi::signal_add_first('print text', 'sig_printtext');
+Irssi::settings_add_int('misc','mass_hilight_threshold',3);
diff --git a/scripts/miodek.pl b/scripts/miodek.pl
new file mode 100644
index 0000000..ce00bc6
--- /dev/null
+++ b/scripts/miodek.pl
@@ -0,0 +1,368 @@
+# Miodek 1.0.2
+#
+# Lam 10-11.9.2001 + pó¼niejsze zmiany s³ownika (g³ównie YagoDa)
+#
+# Pewnie ten skrypt jest napisany ¼le, co prawdopodobnie wynika z faktu, ¿e
+# to w ogóle mój pierwszy skrypt w perlu, ale có¿, na pewno ludzie, których
+# ten skrypt kopie s± g³upsi od niego :)
+#
+# S³ownik jest wynikiem nocnego przegl±dania logów z irca (g³ównie
+# grepowania po "sh" oraz "kunia") i powiêksza siê podczas ka¿dej rozmowy :)
+#
+# 10:32 <aska|off> hm... to u was za kopiom???????
+# 10:32 <aska|off> ehhee za kcenie??????
+#
+# Miodek 2.0 z obs³ug± regexów i s³owników w plikach by³ w
+# przygotowaniu, ale po padzie dysku straci³em ochotê odzyskiwania go.
+# Na jaki¶ czas.
+
+use Irssi;
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.0.2";
+%IRSSI = (
+ authors => "Leszek Matok, Andrzej Jagodziñski",
+ contact => "lam\@lac.pl",
+ name => "miodek",
+ description => "Simple wordkick system, with extended polish dictionary for channels enforcing correct polish.",
+ license => "GPLv2",
+ changed => "10.3.2002 20:10"
+);
+
+
+my $miodek = '
+# moje w³asne dopiski :> (by yagus)
+
+szypko szybko
+wogule w ogole
+qrva panna lekkich obyczajow
+drobiask drobiazg
+ogladash ogl±dasz
+przeciesh przecie¿
+zeszycikof zeszytów
+widzish widzisz
+JESOOO Jezu
+jesooooooo Jezu
+jesoooooooo Jezu
+jesooooooooo Jezu
+jesoooooooooo Jezu
+jesooooooooooo Jezu
+jesoooooooooooo Jezu
+zgadzash zgadzasz
+jesooo Jezu
+jesoooo Jezu
+jesooooo Jezu
+jesoooooo Jezu
+zobaczysh zobaczysz
+pokonash pokonasz
+nawidzish nawidzisz
+myslish myœlisz
+komplexof kompleksów
+chujq cz³onku
+moofi mówi
+umiesh umiesz
+lubish lubisz
+tilaf T.Love
+wjesz wiesz
+priff priv
+prif priv
+lukof £uków
+lukoof £uków
+kad sk±d
+k¹d sk±d
+wlosoof w³osów
+wlosof w³osów
+dobzie dobrze
+fogóle w ogóle
+fogole w ogóle
+wogóle w ogóle
+wogole w ogóle
+pishesz piszesz
+pishesh piszesz
+mooofish mówisz
+uwazash uwa¿asz
+slyshysh s³yszysz
+zaparofaly zaparowa³y
+wyprafiash wyprawiasz
+wyprafiasz wyprawiasz
+znof znów
+idziesh idziesz
+grash grasz
+moofi³ mówi³
+moofil mówi³
+qlfa kurwa
+dopsie dobrze
+schodof schodów
+pierdolic kochaæ
+pierdoliæ kochaæ
+jebaæ uprawiaæ mi³o¶æ
+jebac uprawiaæ mi³o¶æ
+pierdolec kochanek
+psyjechac przyjechaæ
+kces chcesz
+przyjebal pokocha³
+przyjeba³ pokocha³
+ujebal pokocha³
+zajebal zakocha³
+ujeba³ pokocha³
+zajeba³ zakocha³
+chuja cz³onka
+huja cz³onka
+pierdoli kocha
+odwiezesh odwieziesz
+bedziesh bêdziesz
+mooofiles mówi³e¶
+moofiles mówi³e¶
+mofi mówi
+dogryzash dogryzasz
+terash teraz
+tfooj twój
+dorosniesh doro¶niesz
+pofiem powiem
+poffiem powiem
+dopla dobra
+doblam dobra
+# typowe kretynizmy (90% by Lam)
+tesh te¿
+tesz te¿
+tysh te¿
+tysz te¿
+jush ju¿
+jusz ju¿
+ush ju¿
+mash masz
+cush có¿
+coosh có¿
+cosh có¿
+robish robisz
+jesh jesz
+# qrwa kurwa
+kurfa kurwa
+qrfa kurwa
+kofam kocham
+koffam kocham
+kofany kochany
+koffany kochany
+kofana kochana
+koffana kochana
+moofie mówiê
+moof mów
+moofisz mówisz
+moofish mówisz
+mofie mówiê
+mof mów
+mofisz mówisz
+mofish mówisz
+pofiem powiem
+gadash gadash
+wiesh wiesz
+fiesh wiesz
+fiem wiem
+# tego wprost nienawidzê!
+KCE chcê
+kce chcê
+kcem chcê
+kcesz chcesz
+kcesh chcesz
+moshe mo¿e
+mosze mo¿e
+moshna mo¿na
+# widzia³em jak jaki¶ czik o inteligencji ameby pisa³ "moszna", ale smaczek ;)
+bosh bo¿e
+boshe bo¿e
+boshesh bo¿e
+jesu Jezu
+joosh ju¿
+# no tego to ja bym nie wymy¶li³ :)
+fokle w ogóle
+psheprasham przepraszam
+# a to s³owo ma tyle wersji.. ci ludzie naprawdê siê nudz±.
+dobshe dobrze
+dopshe dobrze
+dopsze dobrze
+dopsz dobrze
+topshe dobrze
+topsze dobrze
+topsz dobrze
+topla dobra
+toplanoc dobranoc
+dopry dobry
+dopra dobra
+# od tego momentu wy³±cznie wy³apane na ircu
+napish napisz
+palish palisz
+trafke trawkê
+trafka trawka
+slofa s³owa
+pishe pisze
+piszem piszê
+moozg mózg
+kref krew
+krfi krwi
+naprafde naprawdê
+zafsze zawsze
+dziendopry dzieñdobry
+snoof snów
+kopiom kopi±
+kcenie chcenie
+kcê chcê
+kórfa kurwa
+kórwa kurwa
+mooj mój
+jesoo Jezu
+loodzie ludzie
+loodzi ludzi
+ktoora która
+ktoory który
+ktoore które
+gloopi g³upi
+gloopia g³upia
+goopi g³upi
+goopia g³upia
+gupi g³upi
+gupia g³upia
+siem siê
+pshesada przesada
+booziak buziak
+booziaki buziaki
+mogem mogê
+bes bez
+spowrotem z powrotem
+poczeba potrzeba
+niepoczeba nie potrzeba
+czeba trzeba
+glofa g³owa
+glofe g³owê
+suonce s³oñce
+fitam witam
+fitaj witaj
+fitajcie witajcie
+slofnik s³ownik
+# usuniête w wyniku batalii o Jerzego Owsiaka. Prawdopodobnie nied³ugo
+# zobaczymy to s³owo w s³owniku. Ciekawe co napisz± pod has³em "siemanie"?
+# siema siê ma
+# siemasz siê masz
+cieshysh cieszysz
+tfierdzish twierdzisz
+jezd jest
+brzytkie brzydkie
+brzytki brzydki
+brzytka brzydka
+otfarty otwarty
+otfarte otwarte
+otfarta otwarta
+leprzy lepszy
+leprze lepsze
+leprza lepsza
+lepshy lepszy
+lepshe lepsze
+lepsha lepsza
+zief ziew
+kfila chwila
+kfile chwilê
+kfilka chwilka
+kfilke chwilkê
+bendem bêdê
+lecem lecê
+pifo piwo
+pifko piwko
+pifkiem piwkiem
+bszytkie brzydkie
+bszytki brzydki
+bszytka brzydka
+goofny g³ówny
+goofno gówno
+muoda m³oda
+miaua mia³a
+miauam mia³am
+tszeba trzeba
+wporzo w porzo
+# na pro¶bê Upiora trochê bluzgów + nowe by yagoda
+kurwa dziewica orleañska
+kurwy panny
+kurwie pannie
+kurewka panienka
+kurwo panno
+qrwa prostytutka
+# eksperymentalne wielkie litery :-)
+CHUJ cz³oneczek
+HUJ cz³oneczek
+KURWA panienka
+KURWY panny
+CIPA pochwa
+PIZDA pochwa
+SKURWYSYN Protas
+chuj cz³onek
+chuje cz³onki
+chujowo cz³onkowsko
+chujowy cz³onkowski
+chujowa cz³onkowska
+chujowe cz³onkowskie
+huj cz³onek
+huje cz³onki
+hujowo cz³onkowsko
+hujowy cz³onkowski
+hujowa cz³onkowska
+hujowe cz³onkowskie
+cipa pochwa
+pizda pochwa
+pierdolony kochany
+pierdolona kochana
+pierdolone kochane
+jebany kochany
+jebana kochana
+jebane kochane
+skurwysyn Protas
+skurwysynu synu prostytutki
+skurwiel Lam
+skurwielu z kur wielu
+pierdole kocham
+jebie kocham
+pierdol kochaj
+kutas penis
+cipka pochewka
+';
+
+my %slowa;
+my $ilosc_slow = 0;
+
+foreach my $linia (split(/\n/, $miodek)) {
+ chomp $linia;
+ next if ($linia =~ /^#/ || $linia eq "");
+
+ my ($org, $popraw) = split(/\s+/, $linia, 2);
+ $slowa{$org} = $popraw;
+ $ilosc_slow++
+}
+
+sub server_event {
+ my ($server, $data, $nick, $address) = @_;
+ my ($type, $data) = split(/ /, $data, 2);
+ return unless ($type =~ /privmsg/i);
+ my ($target, $tekst) = split(/ :/, $data, 2);
+ my $powod;
+
+ # pozbywam siê syfów kontrolnych, oraz ^A z CTCP
+ # mo¿e jest jaka¶ funkcja w irssi do wycinania kolorów mircowych?
+ $tekst =~ s/[]//g;
+
+ foreach my $wyraz (split(/[\s,.;!?\/"`':()_-]/,$tekst)) {
+ my $popraw = $slowa{$wyraz};
+ if ($popraw) {
+ if ($powod) {
+ $powod = $powod . ", ";
+ }
+ $powod = $powod . $popraw;
+ }
+ }
+
+ if ($powod && $target =~ /^[#!+&]/ ) {
+ $server->command("/kick $target $nick $powod");
+ Irssi::print "%Rkop%n ($target): %c$nick%n, powod: $powod";
+ }
+}
+
+# Musia³em siê podczepiæ pod server event zamiast event privmsg, bo irssi
+# wycina CTCP z PRIVMSG (co jest dla mnie zachowaniem dziwnym).
+Irssi::signal_add_last("server event", "server_event");
+Irssi::print "%GMiodek%c:%n ilo¶æ s³ów w s³owniku: $ilosc_slow";
diff --git a/scripts/mkick.pl b/scripts/mkick.pl
new file mode 100644
index 0000000..6903ab2
--- /dev/null
+++ b/scripts/mkick.pl
@@ -0,0 +1,114 @@
+#
+# Usage: /MKICK [options] [mode] [mask] [reason]
+# Options:
+# -n normal kick
+# -6 '2+4' kickmethod
+# Mode:
+# -a all on channel
+# -o chops
+# -v chvoices
+# -d users without op
+# -l users without op and voice
+# Settings.
+# /SET masskick_default_reason [reason]
+# /SET masskick_default_use_6method [On/Off]
+#
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.9";
+%IRSSI = (
+ authors => 'Marcin Rozycki',
+ contact => 'derwan@irssi.pl',
+ name => 'mkick',
+ description => 'Masskick, usage: /mkick [-aovdln6 (hostmask)] <[:]reason>',
+ license => 'GNU GPL v2',
+ url => 'http://derwan.irssi.pl',
+ changed => 'Wed Oct 6 20:58:38 CEST 2004'
+);
+
+Irssi::theme_register([
+ 'mkick_not_connected', 'Mkick: Not connected to server',
+ 'mkick_not_chanwin', 'Mkick: Not joined to any channel',
+ 'mkick_not_chanop', 'Mkick: You\'re not channel operator on {hilight $0}',
+ 'mkick_syntax', 'Mkick: $0, use: /MKICK [-a|-o|-v|-d|-l] [-n|-6] (mask) [reason]',
+ 'mkick_no_users', '%_Mkick:%_ No users matching given criteria',
+ 'mkick_kicklist', '%_Mkick:%_ Send masskick for $1 users on $0: $2-'
+]);
+
+sub cmd_mkick
+{
+ my ($args, $server, $witem) = @_;
+
+ Irssi::printformat(MSGLEVEL_CRAP, "mkick_not_connected"), return if (!$server or !$server->{connected});
+ Irssi::printformat(MSGLEVEL_CRAP, "mkick_not_chanwin"), return if (!$witem or $witem->{type} !~ /^channel$/i);
+ Irssi::printformat(MSGLEVEL_CRAP, "mkick_not_chanop", $witem->{name}), return if (!$witem->{chanop});
+
+ my $reason = Irssi::settings_get_str("masskick_default_reason");
+ my $method = Irssi::settings_get_bool("masskick_default_use_6method");
+ my $servernick = $server->{nick};
+ my $channel = $witem->{name};
+ my $mode = undef;
+ my $mask = "*!*\@*";
+
+ my @kicklist = ();
+ my @nicklist = ();
+ my @args = split(/ +/, $args);
+
+ while ($_ = shift(@args))
+ {
+ /^..*!..*@..*$/ and $mask = "$&", next;
+ /^-(a|o|v|d|l)$/ and s/-//, $mode = $_, next;
+ /^-(n|6)$/ and $method = $_ =~ s/6//, next;
+ /^-/ and Irssi::printformat(MSGLEVEL_CRAP, "mkick_syntax", "Unknown argument: $_"), return;
+ /^:/ and s/^://;
+ $reason = ($#args >= 0) ? $_." ".join(" ", @args) : $_;
+ last;
+ };
+
+ unless ($mode) {
+ Irssi::printformat(MSGLEVEL_CRAP, "mkick_syntax", "Missing argument"), return if ($mask eq '*!*@*');
+ $mode = "a";
+ };
+
+ foreach my $hash ($witem->nicks())
+ {
+ my $nick = $hash->{nick};
+ next if ($nick eq $servernick or !$server->mask_match_address($mask, $nick, $hash->{host}));
+
+ my $isop = $hash->{op};
+ my $isvoice = $hash->{voice};
+
+ if ($mode eq "a" or
+ $mode eq "o" && $isop or
+ $mode eq "v" && $isvoice && !$isop or
+ $mode eq "d" && !$isop or
+ $mode eq "l" && !$isop && !$isvoice) {
+ push(@kicklist, $nick);
+ my $mod = ($isop == 1) ? "\@" : ($isvoice == 1) ? "+" : undef;
+ push(@nicklist, $mod.$nick);
+ };
+ };
+
+ Irssi::printformat(MSGLEVEL_CRAP, "mkick_no_users", $mask, $mode), return if ($#kicklist < 0);
+ Irssi::printformat(MSGLEVEL_CRAP, "mkick_kicklist", $channel, scalar(@nicklist), @nicklist);
+
+ if ($method > 0) {
+ $reason = substr($reason, 0, 15) if (length($reason) > 15);
+ while (@kicklist) {
+ $server->send_raw("KICK $channel ".join(",", @kicklist[0 .. $method])." :$reason");
+ @kicklist = @kicklist[($method + 1)..$#kicklist];
+ $method = ($method == 3 && $#kicklist > 3) ? 1 : 3;
+ };
+ } else {
+ $server->send_raw_split("KICK $channel ".join(",", @kicklist)." :$reason", 2, $server->{max_kicks_in_cmd});
+ };
+};
+
+Irssi::settings_add_str("misc", "masskick_default_reason", "Irssi BaBy!");
+Irssi::settings_add_bool("misc", "masskick_default_use_6method", 0);
+
+Irssi::command_bind("mkick", "cmd_mkick");
diff --git a/scripts/mkshorterlink.pl b/scripts/mkshorterlink.pl
new file mode 100644
index 0000000..6199608
--- /dev/null
+++ b/scripts/mkshorterlink.pl
@@ -0,0 +1,219 @@
+## mkshorterlink.pl -- Irssi interface for makeashorterlink.com
+## (C) 2002 Gergely Nagy <algernon@bonehunter.rulez.org>
+##
+## Released under the GPLv2.
+##
+## ChangeLog:
+## 0.1 -- Initial version
+## 0.2 -- Added support for ignoring URLs matching certain regexps.
+## (Thanks to Ganneff for the idea)
+## 0.3 -- Added help messages.
+
+use Irssi qw();
+use LWP::UserAgent;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+%IRSSI = (
+ 'authors' => 'Gergely Nagy',
+ 'contact' => 'algernon\@bonehunter.rulez.org',
+ 'name' => 'makeashorterlink.com interface',
+ 'description' => 'Automatically filters all http:// links through makeashorterlink.com',
+ 'license' => 'GPL',
+ 'url' => 'ftp://bonehunter.rulez.org/pub/irssi/mkshorterlink.pl',
+ 'changed' => '2002-12-20'
+ );
+
+my %noshort;
+my %help = (
+ "mkshorterlink" =>
+ "mkshorterlink is an Irssi script that filters all " .
+ "http:// links through makeshorterlink.com. " .
+ "Available commands are: mkshorter, mkunshor, " .
+ "mkununshort, and mkunshortlist.",
+
+ "mkshort" => "MKSHORT <text>\n" .
+ "Filters the URLs in <text> through makeashorterlink.com.",
+
+ "mkunshort" => "MKUNSHORT <regexps>\n" .
+ "All URLs matching any of the listed <regexps> will be " .
+ "ignored, and not filtered through makeashorterlink.com.",
+
+ "mkununshort" => "MKUNUNSHORT <regexp>\n" .
+ "Reverses the effect of MKUNSHORT.",
+
+ "mkunshortlist" => "MKUNSHORTLIST lists all the enabled regexps."
+ );
+
+sub cmd_help {
+ my ($args, $server, $win) = @_;
+
+ my $topic = $args;
+ $topic =~s/^\s*(.*)\s+?$/$1/;
+ if (defined ($help{$topic}))
+ {
+ Irssi::signal_stop ();
+ Irssi::print ($help{$topic});
+ return;
+ }
+}
+
+sub makeshorter {
+ my $msg = $_[0];
+ my $ua = LWP::UserAgent->new (env_proxy => 1,
+ keep_alive => 0,
+ timeout => 10,
+ agent => '');
+ my $response = $ua->post ("http://makeashorterlink.com/index.php",
+ ['url' => "$msg"]);
+ if ($response->content =~ /Your shorter link is: <a href=\"([^\"]+)\"/) {
+ return $1;
+ } else {
+ return $msg;
+ }
+}
+
+sub mkshorter {
+ my $msg = $_[0];
+ my $short = 1;
+
+ foreach (keys %noshort)
+ {
+ $short = 0 if ($noshort{$_} && $msg =~ /$_/);
+ }
+
+ if ($msg =~ /(https?:\/\/[^ ]+)/ && $short)
+ {
+ my $t = $1;
+
+ if ($t =~ /([\.\?\!,] ?)$/)
+ {
+ $t=~s/$1//;
+ }
+ $msg =~ s/$t/&makeshorter($t)/e;
+ }
+ return $msg;
+}
+
+sub cmd_mkshorter {
+ my ($msg, undef, $channel) = @_;
+ my $public = 0;
+
+ if ($msg =~ /^-p */)
+ {
+ $public = 1;
+ $msg =~ s/^-p *//;
+ }
+
+ if (defined ($channel) && $channel && $public)
+ {
+ $channel->command("msg $channel->{'name'} " .
+ mkshorter($msg));
+ } else {
+ Irssi::active_win()->printformat(MSGLEVEL_CLIENTCRAP,
+ 'mkshorterlink_crap',
+ mkshorter ($msg));
+ }
+}
+
+sub sig_mkshorter {
+ my ($server, $msg, $nick, $address, $target) = @_;
+ $target = $nick if $target eq "";
+ $nick = $server->{'nick'} if $address eq "";
+ my $newmsg = mkshorter ($msg);
+
+ $server->window_item_find ($target)->print ("[mkshort] <$nick> " .
+ $newmsg, MSGLEVEL_CRAP)
+ if ($newmsg ne $msg);
+}
+
+sub cmd_mkunshort {
+ my @params = split (" ", $_[0]);
+
+ foreach (@params)
+ {
+ $noshort{$_} = 1;
+ }
+}
+
+sub cmd_mkununshort {
+ my @params = split (" ", $_[0]);
+
+ foreach (@params)
+ {
+ $noshort{$_} = 0;
+ }
+}
+
+sub cmd_mkunshortlist {
+ Irssi::active_win()->printformat (MSGLEVEL_CLIENTCRAP,
+ 'mkshorterlink_crap',
+ "URLs matching these are ignored: ");
+ foreach (keys %noshort)
+ {
+ Irssi::active_win()->printformat (MSGLEVEL_CLIENTCRAP,
+ 'mkshorterlink_crap',
+ $_)
+ if ($noshort{$_});
+ }
+}
+
+sub load_unshortlist {
+ my $file = Irssi::get_irssi_dir."/unshortlist";
+ my $count = 0;
+ local *CONF;
+
+ open CONF, "<", $file;
+ while (<CONF>)
+ {
+ $noshort{$_} = 1;
+ $count++;
+ }
+ close CONF;
+
+ Irssi::printformat (MSGLEVEL_CLIENTCRAP, 'mkshorterlink_crap',
+ "Loaded $count ignore-regexps from $file.");
+}
+
+sub save_unshortlist {
+ my $file = Irssi::get_irssi_dir."/unshortlist";
+ local *CONF;
+
+ open CONF, ">", $file;
+ foreach (keys %noshort)
+ {
+ print CONF $_ if ($noshort{$_});
+ }
+ close CONF;
+
+ Irssi::printformat (MSGLEVEL_CLIENTCRAP, 'mkshorterlink_crap',
+ "Saved ignore-regexps to $file.");
+}
+
+sub sig_setup_rered {
+ load_unshortlist ();
+}
+
+sub sig_setup_save {
+ save_unshortlist ();
+}
+
+Irssi::command_bind ('mkshorter', 'cmd_mkshorter');
+Irssi::command_bind ('mkunshort', 'cmd_mkunshort');
+Irssi::command_bind ('mkununshort', 'cmd_mkununshort');
+Irssi::command_bind ('mkunshortlist', 'cmd_mkunshortlist');
+Irssi::command_bind ('help', 'cmd_help');
+Irssi::signal_add_last ('message own_public', 'sig_mkshorter');
+Irssi::signal_add_last ('message public', 'sig_mkshorter');
+Irssi::signal_add_last ('message own_private', 'sig_mkshorter');
+Irssi::signal_add_last ('message private', 'sig_mkshorter');
+Irssi::signal_add ('setup reread', 'sig_setup_reread');
+Irssi::signal_add ('setup saved', 'sig_setup_save');
+
+Irssi::theme_register(
+ [
+ 'mkshorterlink_crap',
+ '{line_start}{hilight mkshorterlink:} $0'
+ ]);
+
+load_unshortlist ();
diff --git a/scripts/mldonkey_bandwidth.pl b/scripts/mldonkey_bandwidth.pl
new file mode 100644
index 0000000..c382395
--- /dev/null
+++ b/scripts/mldonkey_bandwidth.pl
@@ -0,0 +1,51 @@
+use strict;
+require LWP::UserAgent;
+use Irssi;
+use HTTP::Request::Common;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "20180123";
+%IRSSI = (
+ authors => "Carsten Otto",
+ contact => "c-otto\@gmx.de",
+ name => "mldonkey bandwidth script",
+ description => "Shows your mldonkey's current down- and upload rate",
+ license => "GPLv2",
+ url => "http://www.c-otto.de",
+ changed => "$VERSION",
+ commands => "mlbw"
+);
+
+Irssi::settings_add_str('mldonkey_bandwidth', 'mldonkey_bandwidth_host' ,'127.0.0.1:4080');
+my $host = Irssi::settings_get_str('mldonkey_bandwidth_host');
+
+sub cmd_mlbw
+{
+ my ($args, $server, $target) = @_;
+ my $ua = LWP::UserAgent->new(timeout => 5);
+ my $req = GET "http://$host/submit?q=bw_stats";
+ my $resp = $ua->request($req);
+ my $output = $resp->content();
+ my $down = $output;
+ my $up = $output;
+ $down =~ s/.*Down: ([0-9]*\.*[0-9]) KB.*/$1/s;
+ $up =~ s/.*Up: ([0-9]*\.*[0-9]) KB.*/$1/s;
+ if ($down eq "") { $down = "(off)"; }
+ if ($up eq "") { $up = $down; }
+ $output = "-MLdonkey bandwidth stats- Down: $down - Up: $up";
+ if (!$server || !$server->{connected} || !$target)
+ {
+ Irssi::print $output;
+ } else
+ {
+ Irssi::active_win() -> command('say ' . $output);
+ }
+}
+
+sub cmd_changed
+{
+ $host = Irssi::settings_get_str('mldonkey_bandwidth_host');
+}
+
+Irssi::command_bind('mlbw', 'cmd_mlbw');
+Irssi::signal_add('setup changed', 'cmd_changed');
diff --git a/scripts/modelist-r.pl b/scripts/modelist-r.pl
new file mode 100644
index 0000000..cce6059
--- /dev/null
+++ b/scripts/modelist-r.pl
@@ -0,0 +1,468 @@
+# $Id: modelist-r.pl,v 0.8.0-rc4 2004/11/04 19:56 derwan Exp $
+#
+# This script creates cache of channel invites, ban exceptions and reops.
+# Reop list is included only in ircd >= 2.11.0 (in IRCnet) - for other servers
+# and networks use modelist.pl ( http://derwan.irssi.pl/modelist.pl).
+#
+# Script commands:
+# /si - shows channel invites
+# /se - shows ban exception
+# /sr - shows reop list
+#
+# /uninvite [<index and masks separated with spaces>]
+# - removes the specified invite(s) from the channel
+# /unexcept [<index and masks separated with spaces>]
+# - removes the specified ban exception(s) from the channel
+# /unreop [<index and masks separated with spaces>]
+# - removes the specified reop(s) from the channel
+#
+# Examples:
+# /si
+# /uninvite 1
+# /unexcept *!*@127.0.0.1
+# /unreop 1 *!*@127.0.0.1 5
+#
+# After loading modelist-r.pl run command
+# /statusbar window add -priority 0 -after usercount modelist
+#
+# You can customize the look of this item from theme file:
+# sb_modelist = "{sb $0 modes ($1-)}";
+# sb_ml_b = "b/%r$*%n"; # bans
+# sb_ml_e = "e/%c$*%n"; # ban exceptions
+# sb_ml_I = "I/%G$*%n"; # invites
+# sb_ml_R = "R/%R$*%n"; # reops
+# sb_ml_space = " "; # separator
+#
+# Theme formats:
+# modelist $0 - index, $1 - channel, $2 - hostmask, 3 - mode
+# modelist_long $4 - nick, $5 - time
+# modelist_empty $0 - channel, $1 - mode
+# modelist_chan_not_synced $0 - channel
+# modelist_not_joined
+# modelist_server_version $0 - version
+#
+
+use strict;
+use vars ('$VERSION', '%IRSSI');
+
+use Irssi 20020600 ();
+use Irssi::Irc;
+use Irssi::TextUI;
+
+$VERSION = '0.8.0-rc4';
+%IRSSI =
+(
+ 'authors' => 'Marcin Rozycki',
+ 'contact' => 'derwan@irssi.pl',
+ 'name' => 'modelist-r',
+ 'description' => 'Cache of invites, ban exceptions and reops in channel. Script commands: '.
+ '/si, /se, /sr, /unexcept, /uninvite, /unreop (version only for ircd >= 2.11.0).',
+ 'sbitems' => 'modelist',
+ 'license' => 'GNU GPL v2',
+ 'modules' => '',
+ 'url' => 'http://derwan.irssi.pl',
+ 'changed' => 'Thu Nov 4 17:56:17 2004',
+);
+
+Irssi::theme_register
+([
+ # $0 - index, $1 - channel name, $2 - hostmask, $3 - mode (invite, ban exception, reop)
+ 'modelist', '$0 - {channel $1}: $3 {ban $2}',
+ # $0 - index, $1 - channel name, $2 - hostmask, $3 - mode, $4 - nick, $5 - time
+ 'modelist_long', '$0 - {channel $1}: $3 {ban $2} {comment by {nick $4}, $5 secs ago}',
+ # $0 - channel name, $1 - mode
+ 'modelist_empty', 'No $1s in channel {channel $0}',
+ # $0 - channel name
+ 'modelist_chan_not_synced', 'Channel not fully synchronized yet, try again after a while',
+ # $0 - channel name
+ 'modelist_chan_no_modes', 'Channel {channel $0} doesn\'t support modes',
+ 'modelist_not_joined', 'Not joined to any channel',
+ # $0 - version
+ 'modelist_server_version', 'This script working only in ircd {hilight >= 2.11.0} with reop list {comment active ircd $0}'
+]);
+
+# $modelist{str servertag}->{lc str channel}->{str mode} = [ $moderec, ... ]
+# $moderec = [ str hostmask, str nick, str time ]
+my %modelist = ();
+
+# $synced{str servertag}->{lc str channel} = int synced
+my %synced = ();
+
+# $visible{str mode} = str list
+my %visible =
+(
+ 'e' => 'ban exception',
+ 'I' => 'invite',
+ 'R' => 'reop'
+);
+
+# $sb->{str mode} = int modes
+my $sb = {};
+
+# server redirections:
+# 'modelist I' ( 346, 347, 403, 442, 472, 479, 482)
+# 'modelist e' ( 348, 349, 403, 442, 472, 479, 482)
+# 'modelist R' ( 344, 345, 403, 442, 472, 479, 482)
+Irssi::Irc::Server::redirect_register('modelist I', 0, 0, { 'event 346' => 1 }, {
+ 'event 347' => 1, # end of channel invite list
+ 'event 403' => 1, # no such channel
+ 'event 442' => 1, # you're not on that channel
+ 'event 472' => 1, # unknown mode
+ 'event 479' => 1, # illegal channel name
+ 'event 482' => 1 # you're not channel operator
+}, undef );
+
+Irssi::Irc::Server::redirect_register('modelist e', 0, 0, { 'event 348' => 1 }, {
+ 'event 349' => 1, # end of channel exception list
+ 'event 403' => 1,
+ 'event 442' => 1,
+ 'event 472' => 1,
+ 'event 479' => 1,
+ 'event 482' => 1
+}, undef );
+
+Irssi::Irc::Server::redirect_register('modelist R', 0, 0, { 'event 344' => 1 }, {
+ 'event 345' => 1, # end of channel reop list
+ 'event 403' => 1,
+ 'event 442' => 1,
+ 'event 472' => 1,
+ 'event 479' => 1,
+ 'event 482' => 1
+}, undef );
+
+# create_channel (rec channel, int sync)
+sub create_channel ($;$)
+{
+ destroy_channel($_[0]);
+ sb_update();
+
+ my ($server, $tag, $channel) = ($_[0]->{server}, $_[0]->{server}->{tag}, lc $_[0]->{name});
+
+
+ if ( !test_version($server) or $_[0]->{no_modes} )
+ {
+ $synced{$tag}->{$channel} = 1;
+ return;
+ }
+ $synced{$tag}->{$channel} = ( defined $_[1] ) ? $_[1] : 0;
+
+ $modelist{$tag}->{$channel}->{I} = [];
+ $server->redirect_event('modelist I', 1, $channel, 0, undef, {
+ 'event 346' => 'redir modelist invite',
+ '' => 'event empty'
+ });
+ $server->send_raw(sprintf('mode %s +I', $channel));
+
+ $modelist{$tag}->{$channel}->{e} = [];
+ $server->redirect_event('modelist e', 1, $channel, 0, undef, {
+ 'event 348' => 'redir modelist except',
+ '' => 'event empty'
+ });
+ $server->send_raw(sprintf('mode %s +e', $channel));
+
+ $modelist{$tag}->{$channel}->{R} = [];
+ $server->redirect_event('modelist R', 1, $channel, 0, undef, {
+ 'event 344' => 'redir modelist reop',
+ 'event 345' => 'redir modelist sync',
+ 'event 403' => 'redir modelist sync',
+ 'event 442' => 'redir modelist sync',
+ 'event 472' => 'redir modelist sync',
+ 'event 479' => 'redir modelist sync',
+ 'event 482' => 'redir modelist sync',
+ '' => 'event empty'
+ });
+ $server->send_raw(sprintf('mode %s +R', $channel));
+}
+
+# destroy_channel (rec channel)
+sub destroy_channel ($)
+{
+ my ($tag, $channel) = ($_[0]->{server}->{tag}, lc $_[0]->{name});
+ delete $synced{$tag}->{$channel};
+ delete $modelist{$tag}->{$channel};
+ sb_update();
+}
+
+# sig_redir_modelist (rec server, str data, str mode)
+sub sig_redir_modelist ($$$)
+{
+ my $chanrec = $_[0]->channel_find(((split(' ', $_[1], 3))[1]));
+ if ( ref $chanrec )
+ {
+ mode($chanrec, 1, $_[2], ((split(/ +/, $_[1], 4))[2]), undef);
+ }
+}
+
+# mode (rec channel, int type, str mode, str hostmask, str setby)
+sub mode ($$$$$)
+{
+ my $rec = get_list($_[0], $_[2]);
+ if ( ref $rec and $_[1] eq 1 )
+ {
+ push @{$rec}, [ $_[3], $_[4], time ];
+ }
+ elsif ( ref $rec and $_[1] eq 0 )
+ {
+ for ( my $idx = 0; $idx <= $#{$rec}; $idx++ )
+ {
+ if ( lc $rec->[$idx]->[0] eq lc $_[3] )
+ {
+ splice @{$rec}, $idx, 1;
+ last;
+ }
+ }
+ }
+ sb_update();
+}
+
+# sig_channel_sync (rec channel)
+sub sig_channel_sync ($)
+{
+ if ( ++$synced{$_[0]->{server}->{tag}}->{lc $_[0]->{name}} < 2 )
+ {
+ Irssi::signal_stop();
+ }
+}
+
+# sig_modelist_sync (rec server, str data)
+sub sig_modelist_sync ($$)
+{
+ my $chanrec = $_[0]->channel_find(((split(/ +/, $_[1], 3))[1]));
+ if ( ref $chanrec )
+ {
+ Irssi::signal_emit('channel sync', $chanrec);
+ sb_update();
+ }
+}
+
+# sig_message_irc_mode (rec server, str channel, str nick, str userhost, str mode)
+sub sig_message_irc_mode ($$$$$)
+{
+ my $chanrec = $_[0]->channel_find($_[1]);
+ unless ( ref $chanrec )
+ {
+ return;
+ }
+
+ my ($q, $mods, @a) = (1, split(/ +/, $_[4]));
+ foreach my $mod ( split('', $mods) )
+ {
+ ( $mod eq '+' ) and $q = 1, next;
+ ( $mod eq '-' ) and $q = 0, next;
+ my $a = ( rindex('beIkloRvhx', $mod) >= 0 && $q eq 1 or rindex('beIkoRvhx', $mod) >= 0 && $q eq 0 ) ? shift(@a) : undef;
+ if ( rindex('eIR', $mod) >= 0 )
+ {
+ mode($chanrec, $q, $mod, $a, $_[2]);
+ }
+ }
+}
+
+# get_list (rec channel, str mode), rec list
+sub get_list ($$)
+{
+ if ( ref $_[0] and defined $modelist{$_[0]->{server}->{tag}}->{lc $_[0]->{name}}->{$_[1]} )
+ {
+ return $modelist{$_[0]->{server}->{tag}}->{lc $_[0]->{name}}->{$_[1]};
+ }
+}
+
+# test_version (rec server), bool 0/1
+sub test_version ($)
+{
+ if ( $_[0] and ref $_[0] and $_[0]->{version} =~ m/^(\d+\.\d+)\./ and $1 >= 2.11 )
+ {
+ return 1;
+ }
+ return 0;
+}
+
+
+# test_channel (rec channel, bool quiet), bool 0/1
+sub test_channel ($;$)
+{
+ unless ( ref $_[0] and $_[0]->{type} eq 'CHANNEL' )
+ {
+ Irssi::printformat(MSGLEVEL_CRAP, 'modelist_not_joined') unless ( $_[1] );
+ return 0;
+ }
+ if ( $_[0]->{no_modes} )
+ {
+ $_[0]->printformat(MSGLEVEL_CRAP, 'modelist_chan_no_modes', $_[0]->{name}) unless ( $_[1] );
+ return 0;
+ }
+ if ( !test_version($_[0]->{server}) )
+ {
+ $_[0]->printformat(MSGLEVEL_CRAP, 'modelist_server_version', $_[0]->{server}->{version}) unless ( $_[1] );
+ return 0;
+
+ }
+ if ( $synced{$_[0]->{server}->{tag}}->{lc $_[0]->{name}} < 2 )
+ {
+ $_[0]->printformat(MSGLEVEL_CRAP, 'modelist_chan_not_synced', $_[0]->{name}) unless ( $_[1] );
+ return 0;
+ }
+ return 1;
+}
+
+# cmd_modelist_show (str mode)
+sub cmd_modelist_show ($)
+{
+ my $chanrec = Irssi::active_win() ? Irssi::active_win()->{active} : undef;
+ unless ( test_channel($chanrec) )
+ {
+ return;
+ }
+ my $rec = get_list($chanrec, $_[0]);
+ unless ( $#{$rec} >= 0 )
+ {
+ $chanrec->printformat
+ (
+ MSGLEVEL_CRAP, 'modelist_empty', $chanrec->{name}, $visible{$_[0]}
+ );
+ return;
+ }
+ for ( my $idx = 0; $idx <= $#{$rec}; $idx++ )
+ {
+ $chanrec->printformat
+ (
+ MSGLEVEL_CRAP, ( defined $rec->[$idx]->[1] ? 'modelist_long' : 'modelist'),
+ ($idx + 1), $chanrec->{name}, visible($rec->[$idx]->[0]), $visible{$_[0]},
+ $rec->[$idx]->[1], (time() - $rec->[$idx]->[2])
+ );
+ }
+}
+
+# cmd_modelist_del (str mode, str data)
+sub cmd_modelist_del ($$)
+{
+ my $chanrec = Irssi::active_win() ? Irssi::active_win()->{active} : undef;
+ unless ( test_channel($chanrec) )
+ {
+ return;
+ }
+ my ($rec, @m) = (get_list($chanrec, $_[0]));
+ foreach my $search ( split /[,;\s]+/, $_[1] )
+ {
+ if ( $search =~ m/^\d+$/ )
+ {
+ next unless ( $search-- and $search <= $#{$rec} );
+ $search = $rec->[$search]->[0];
+ }
+ push @m, $search;
+ }
+ if ( $#m >= 0 )
+ {
+ $chanrec->{server}->command(sprintf("mode %s -%s %s", $chanrec->{name}, $_[0] x scalar(@m), join(' ', @m)));
+ }
+}
+
+# visible (str data), str data
+sub visible ($)
+{
+ my $str = shift();
+ $str =~ tr/\240\002\003\037\026/\206\202\203\237\226/;
+ return $str;
+}
+
+# sb_update ()
+sub sb_update ()
+{
+ $sb->{b} = $sb->{e} = $sb->{I} = $sb->{R} = $sb->{T} = 0;
+
+ my $chanrec = Irssi::active_win() ? Irssi::active_win()->{active} : undef;
+ unless ( test_channel($chanrec, 1) )
+ {
+ return;
+ }
+
+ $sb->{b} = scalar @{[$chanrec->bans]};
+ $sb->{e} = scalar @{get_list($chanrec, 'e')};
+ $sb->{I} = scalar @{get_list($chanrec, 'I')};
+ $sb->{R} = scalar @{get_list($chanrec, 'R')};
+ $sb->{T} = $sb->{b} + $sb->{e} + $sb->{I} + $sb->{R};
+
+ Irssi::statusbar_items_redraw('modelist');
+}
+
+# sb_modelist(rec item, bool get_size_only)
+# tahnks usercount.pl!
+sub sb_modelist ($$)
+{
+ unless ( $sb->{T} )
+ {
+ $_[0]->{min_size} = $_[0]->{max_size} = 0 if ( ref $_[0] );
+ return;
+ }
+
+ my $theme = Irssi::current_theme();
+ my $format = $theme->format_expand('{sb_modelist}');
+
+ if ( $format )
+ {
+ my ($str, $space) = ('', $theme->format_expand('{sb_ml_space}'));
+ foreach my $mod ( 'b', 'e', 'I', 'R' )
+ {
+ next unless ( $sb->{$mod} > 0 );
+ my $tmp = $theme->format_expand
+ (
+ sprintf('{sb_ml_%s %d}', $mod, $sb->{$mod}), Irssi::EXPAND_FLAG_IGNORE_EMPTY
+ );
+ $str .= $tmp . $space;
+ }
+ $str =~ s/\Q$space\E$//;
+ $format = $theme->format_expand
+ (
+ sprintf('{sb_modelist %d %s}', $sb->{T}, $str), Irssi::EXPAND_FLAG_IGNORE_REPLACES
+ );
+ }
+ else
+ {
+ my $str = undef;
+ foreach my $mod ( 'b', 'e', 'I', 'R' )
+ {
+ next unless ( $sb->{$mod} > 0 );
+ $str .= sprintf('%s%d ', $mod, $sb->{$mod})
+ }
+ chop($str);
+ $format = sprintf('{sb \%%_%d\%%_ modes ', $sb->{T});
+ $format .= sprintf('\%%c(\%%n%s\%%c)', $str) if ( $str );
+ }
+
+ $_[0]->default_handler($_[1], $format, undef, 1);
+}
+
+Irssi::signal_add_first('channel sync', 'sig_channel_sync');
+Irssi::signal_add('channel joined' => sub { create_channel($_[0], 0) });
+Irssi::signal_add('channel destroyed' => sub { destroy_channel($_[0]) });
+Irssi::signal_add('redir modelist invite' => sub { sig_redir_modelist($_[0], $_[1], 'I'); });
+Irssi::signal_add('redir modelist except' => sub { sig_redir_modelist($_[0], $_[1], 'e'); });
+Irssi::signal_add('redir modelist reop' => sub { sig_redir_modelist($_[0], $_[1], 'R'); });
+Irssi::signal_add('redir modelist sync', 'sig_modelist_sync');
+Irssi::signal_add('message irc mode', 'sig_message_irc_mode');
+Irssi::signal_add_last('ban new', 'sb_update');
+Irssi::signal_add_last('ban remove', 'sb_update');
+Irssi::signal_add_last('window changed', 'sb_update');
+Irssi::signal_add_last('window item changed', 'sb_update');
+Irssi::command_bind('si' => sub { cmd_modelist_show('I') });
+Irssi::command_bind('se' => sub { cmd_modelist_show('e') });
+Irssi::command_bind('sr' => sub { cmd_modelist_show('R') });
+Irssi::command_bind('uninvite' => sub { cmd_modelist_del('I', $_[0]) });
+Irssi::command_bind('unexcept' => sub { cmd_modelist_del('e', $_[0]) });
+Irssi::command_bind('unreop' => sub { cmd_modelist_del('R', $_[0]) });
+
+sb_update();
+
+Irssi::statusbar_item_register('modelist', undef, 'sb_modelist');
+Irssi::statusbars_recreate_items();
+
+foreach my $server ( Irssi::servers )
+{
+ foreach my $chanrec ( $server->channels )
+ {
+ create_channel($chanrec, 1);
+ }
+}
+
+
+
+
diff --git a/scripts/modelist.pl b/scripts/modelist.pl
new file mode 100644
index 0000000..eadc639
--- /dev/null
+++ b/scripts/modelist.pl
@@ -0,0 +1,153 @@
+# modelist.pl v 0.7.2 by Marcin Rozycki (derwan@irssi.pl) changed at Sat Jun 5 22:38:59 CEST 2004
+#
+# Usage:
+# /se
+# /si
+# /unexcept [index] ( ex. /unexcept 1 5 17)
+# /uninvite [index] ( ex. /uninvite 3 8)
+#
+
+use strict;
+use Irssi 20020600 ();
+use Irssi::Irc;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.7.2";
+%IRSSI = (
+ authors => 'Marcin Rozycki',
+ contact => 'derwan@irssi.pl',
+ name => 'modelist',
+ description => 'Cache of invites and ban exceptions in channel. Usage: /si, /se, '.
+ '/unexcept [indexes], /uninvite [indexes]',
+ license => 'GNU GPL v2',
+ url => 'http://derwan.irssi.pl',
+ changed => 'Sat Jun 5 22:38:59 CEST 2004'
+);
+
+Irssi::theme_register([
+ 'modelist', '$0 - {hilight $1}: $2 %c$3%n $4'
+]);
+
+my %modelist = ();
+
+sub channel_create
+{
+ my ($server, $channel) = (@_[0], lc($_[1]));
+ delete $modelist{lc($server->{tag})}{$channel};
+
+ $server->redirect_event("mode I", 1, "$channel", 0, undef, {
+ 'event 346' => 'redir modelist invite',
+ '' => 'event empty' });
+ $server->send_raw("MODE $channel I");
+
+ $server->redirect_event("mode e", 1, "$channel", 0, undef, {
+ 'event 348' => 'redir modelist except',
+ '' => 'event empty' });
+ $server->send_raw("MODE $channel e");
+}
+
+sub sig_channel_created
+{
+ channel_create($_[0]->{server}, $_[0]->{name}) unless ($_[0]->{no_modes});
+}
+
+
+sub sig_redir_modelist_invite
+{
+ my ($nick, $chan, $mode) = split(/ +/, $_[1], 3);
+ message_irc_mode($_[0], $chan, undef, undef, "+I $mode");
+}
+
+sub sig_redir_modelist_except
+{
+ my ($nick, $chan, $mode) = split(/ +/, $_[1], 3);
+ message_irc_mode($_[0], $chan, undef, undef, "+e $mode");
+}
+
+sub message_irc_mode
+{
+ my ($mode, @args) = split(/ +/, $_[4]);
+ return unless $_[0]->ischannel($_[1]);
+ my ($tag, $chan, $mod) = (lc($_[0]->{tag}), lc($_[0]->channel_find($_[1])->{name}), "+");
+ foreach ( split //, $mode )
+ {
+ /([+-])/ and $mod = $_, next;
+ my $arg = ( $mod eq '+' && $_ =~ m/[beIkloRvh]/ or $mod eq '-' && $_ =~ m/[beIkoRvh]/ ) ? shift(@args) : undef;
+ next unless ( $_ =~ m/[eI]/ );
+ ( $mod eq '+' ) and push(@{$modelist{$tag}{$chan}{$_}}, [$arg, $_[2], time]), next;
+ for (my $idx = 0; $idx <= $#{$modelist{$tag}{$chan}{$_}}; $idx++) {
+ splice(@{$modelist{$tag}{$chan}{$_}}, $idx, 1) if ($modelist{$tag}{$chan}{$_}[$idx][0] eq $arg);
+ }
+ }
+}
+
+sub proc_modelist_show
+{
+ my ($arg, $server, $channel, $list, $mode) = @_;
+
+ Irssi::print("You\'re not connected to server"), return unless ($server and $server->{connected});
+
+ $arg =~ s/\s.*//;
+ if ($arg) {
+ Irssi::print("Bad channel name: $arg"), return unless ($server->ischannel($arg));
+ unless ($channel = $server->channel_find($arg)) {
+ Irssi::print("You\'re not in channel $arg --> sending request to server");
+ $server->send_raw("MODE $arg $list");
+ return;
+ }
+ }
+
+ Irssi::print("Not joined to any channel"), return unless ($channel and $channel->{type} eq "CHANNEL");
+ Irssi::print("Channel not fully synchronized yet, try again after a while"), return unless ($channel->{synced});
+ Irssi::print("Channel doesn\'t support modes"), return if ($channel->{no_modes});
+
+ my ($tag, $name) = (lc($server->{tag}), $channel->{name});
+ my $chan = lc($name);
+ my $items = $#{$modelist{$tag}{$chan}{$list}};
+
+ Irssi::print("No $mode\s in channel %_$name%_"), return if ($items < 0);
+
+ for (my $idx = 0; $idx <= $items; $idx++)
+ {
+ my ($mask, $who) = ($modelist{$tag}{$chan}{$list}[$idx]->[0], $modelist{$tag}{$chan}{$list}[$idx]->[1]);
+ $mask =~ tr/\240\002\003\037\026/\206\202\203\237\226/;
+ my $setby = ($who) ? "\00314[\003by \002$who\002, ".(time - $modelist{$tag}{$chan}{$list}[$idx]->[2])." secs ago\00314]\003" : undef;
+ $channel->printformat(MSGLEVEL_CRAP, 'modelist', ($idx+1), $name, $mode, $mask, $setby);
+ }
+}
+
+sub cmd_si { proc_modelist_show @_, "I", "invite"; }
+sub cmd_se { proc_modelist_show @_, "e", "ban exception"; }
+
+sub cmd_modelist {
+ my ( $type, $data, $server, $witem) = @_;
+ Irssi::print("You\'re not connected to server"), return unless ($server and $server->{connected});
+ Irssi::print("Not joined to any channel"), return unless ( $witem and $witem->{type} eq "CHANNEL" );
+ my ($tag, $chan, @masks) = (lc($server->{tag}), lc($server->channel_find($witem->{name})->{name}));
+ while ( $data =~ m/(\d+)/g ) {
+ my $idx = $1 - 1;
+ next unless ( exists $modelist{$tag}{$chan}{$type}[$idx] );
+ push(@masks, $modelist{$tag}{$chan}{$type}[$idx]->[0]);
+ }
+ return unless ( $#masks >= 0 );
+ $witem->command(sprintf("MODE %s -%s %s", $chan, $type x scalar(@masks), join(" ", @masks)));
+}
+
+Irssi::signal_add("channel created", "sig_channel_created");
+Irssi::signal_add("redir modelist invite", "sig_redir_modelist_invite");
+Irssi::signal_add("redir modelist except", "sig_redir_modelist_except");
+Irssi::signal_add("message irc mode", "message_irc_mode");
+
+Irssi::command_bind("si", "cmd_si");
+Irssi::command_bind("se", "cmd_se");
+Irssi::command_bind("uninvite" => sub { cmd_modelist("I", @_); });
+Irssi::command_bind("unexcept" => sub { cmd_modelist("e", @_); });
+
+foreach my $server (Irssi::servers)
+{
+ foreach my $channel ($server->channels())
+ {
+ channel_create($server, $channel->{name}) unless ($channel->{no_modes});
+ }
+}
diff --git a/scripts/mood.pl b/scripts/mood.pl
new file mode 100644
index 0000000..660daba
--- /dev/null
+++ b/scripts/mood.pl
@@ -0,0 +1,202 @@
+#!/usr/bin/perl
+#
+# This script tracks the general mood in a channel.
+#
+#
+# Changelog:
+# 19.03.2002
+# *first release
+#
+# 20.03.2002
+# *some regexp tweaking
+#
+# 07.04.2002
+# *own messages can be interpreted
+#
+# 05.01.2019
+# *some regexp tweaking
+
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "20190105";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "Mood",
+ description => "Keeps track of the channel mood",
+ license => "GPLv2",
+ sbitems => "moodbar",
+ changed => "$VERSION",
+);
+
+use Irssi;
+use Irssi::TextUI;
+use vars qw(%channels $eye $refresh $shouting $bored_mouth);
+
+sub find_smiley {
+ my ($msg) = @_;
+ my $eyes = '[:=8;]';
+ my $noses = '[\-o]?';
+ my $sad = '[\(\<\[]';
+ my $happy = '[\)\>\]D]';
+ my %smiley = ($eyes.$noses.$happy => 10,
+ $sad.$noses.$eyes => 10,
+ $eyes.$noses.$sad => -10,
+ $happy.$noses.$eyes => -10,
+ $eyes.'\.+'.$noses.$sad => -20,
+ $happy.$noses.'\.+'.$eyes => -20,
+ );
+ foreach (keys(%smiley)) {
+ return($smiley{$_}) if ($msg =~ m/.*($_).*/);
+ }
+ return 0;
+}
+
+sub event_event_privmsg {
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $msg) = split(/ :/, $data,2);
+ change_mood($target, find_smiley($msg));
+}
+
+sub event_message_own_public {
+ my ($server, $msg, $target) = @_;
+ change_mood($target, find_smiley($msg));
+}
+
+sub event_message_kick {
+ my ($server, $channel, $nick, $kicker, $address, $reason) = @_;
+ change_mood($channel, -20);
+}
+
+sub event_ban_new {
+ my ($channel, $ban) = @_;
+ my $name = $channel->{name};
+ change_mood($name, -20);
+}
+
+sub event_ban_remove {
+ my ($channel, $ban) = @_;
+ my $name = $channel->{name};
+ change_mood($name, 20);
+}
+
+sub event_netsplit_new {
+ my ($netsplit) = @_;
+ #FIXME Not Idea :)
+ #Irssi::print $netsplit->{nick};
+}
+
+sub event_window_hilight {
+ my ($window) = @_;
+ open_mouth();
+}
+
+sub change_mood {
+ my ($name, $points) = @_;
+ if (not exists $channels{$name}) {
+ $channels{lc $name} = 0;
+ }
+ $channels{lc $name} += $points;
+ mood_refresh();
+}
+
+sub draw_smiley {
+ my ($points) = @_;
+
+ my $mouth = $bored_mouth;
+ my $nose = Irssi::settings_get_str('mood_nose');
+
+ if ($points > 20) { $mouth = 'D'; }
+ elsif ($points > 0) { $mouth = ')'; }
+ elsif ($points <-20) { $mouth = '<'; }
+ elsif ($points < 0) { $mouth = '('; }
+ if ($shouting) { $mouth = 'O' };
+ return $eye.$nose.$mouth;
+}
+
+sub mood_show {
+ my ($item, $get_size_only) = @_;
+ my $win = !Irssi::active_win() ? undef : Irssi::active_win()->{active};
+
+ if (ref $win && ($win->{type}) and $win->{type} eq "CHANNEL") {
+ my $target = lc $win->{name};
+ my $face = draw_smiley($channels{$target});
+ my $format = "{sb ".$face."}";
+ $item->{min_size} = $item->{max_size} = length($face);
+ $item->default_handler($get_size_only, $format, 0, 1);
+ } else {
+ $item->{min_size} = $item->{max_size} = 0;
+ }
+}
+
+sub mood_decay {
+ foreach (keys %channels) {
+ if ($channels{$_} < 0) {
+ $channels{$_}++;
+ mood_refresh() if (! draw_smiley($channels{$_}) eq draw_smiley($channels{$_}-1));
+ } elsif ($channels{$_} > 0) {
+ $channels{$_}--;
+ mood_refresh() if (! draw_smiley($channels{$_}) eq draw_smiley($channels{$_}+1));
+ }
+ }
+}
+
+sub close_eyes {
+ ($refresh) && Irssi::timeout_remove($refresh);
+ $eye = '|';
+ mood_refresh();
+ $refresh=Irssi::timeout_add(200, 'open_eyes' , undef);
+}
+
+sub open_eyes {
+ ($refresh) && Irssi::timeout_remove($refresh);
+ $eye = ':';
+ mood_refresh();
+ my $min_delay = Irssi::settings_get_int('mood_blink');
+ my $next_close = int( rand()*6000 + $min_delay );
+ $refresh=Irssi::timeout_add($next_close, 'close_eyes', undef);
+}
+
+sub open_mouth {
+ $shouting = 1;
+ mood_refresh();
+ Irssi::timeout_add(2000, 'close_mouth', undef);
+}
+
+sub close_mouth {
+ Irssi::timeout_remove('close_mouth');
+ $shouting = 0;
+ mood_refresh();
+}
+
+sub mood_refresh {
+ Irssi::statusbar_items_redraw('moodbar');
+}
+
+sub change_bored_mouth {
+ $bored_mouth = ('\\\\\\\\', '|', '/')[int( rand(3) )];
+}
+
+#Irssi::signal_add('window item hilight', 'event_window_hilight');
+Irssi::signal_add('event privmsg', 'event_event_privmsg');
+Irssi::signal_add('message own_public', 'event_message_own_public');
+Irssi::signal_add('message kick','event_message_kick');
+Irssi::signal_add('ban new','event_ban_new');
+Irssi::signal_add('ban remove','event_ban_remove');
+Irssi::signal_add('netsplit new','event_netsplit_new');
+
+Irssi::settings_add_int('misc', 'mood_blink', 6000);
+Irssi::settings_add_str('misc', 'mood_nose', '-');
+
+Irssi::statusbar_item_register('moodbar', 0, 'mood_show');
+
+Irssi::timeout_add(5000, 'mood_decay', undef);
+Irssi::timeout_add(10000, 'change_bored_mouth', undef);
+
+close_mouth;
+change_bored_mouth();
+open_eyes();
+
+# vim:set ts=8 sw=4:
diff --git a/scripts/morse.pl b/scripts/morse.pl
new file mode 100644
index 0000000..d60e01a
--- /dev/null
+++ b/scripts/morse.pl
@@ -0,0 +1,347 @@
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "2004021901";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "morse",
+ description => "turns your messages into morse or spelling code",
+ license => "GPLv2",
+ changed => "$VERSION",
+ commands => "morse spell"
+);
+
+use Irssi 20020324;
+
+use vars qw(%codes %spell);
+
+%codes = (
+ A=>".-",
+ B=>"-...",
+ C=>"-.-.",
+ D=>"-..",
+ E=>".",
+ F=>"..-.",
+ G=>"--.",
+ H=>"....",
+ I=>"..",
+ J=>".---",
+ K=>"-.-",
+ L=>".-..",
+ M=>"--",
+ N=>"-.",
+ O=>"---",
+ P=>".--.",
+ Q=>"--.-",
+ R=>".-.",
+ S=>"...",
+ T=>"-",
+ U=>"..-",
+ V=>"...-",
+ W=>".--",
+ X=>"-..-",
+ Y=>"-.--",
+ Z=>"--..",
+ 0=>"-----",
+ 1=>".----",
+ 2=>"..---",
+ 3=>"...--",
+ 4=>"....-",
+ 5=>".....",
+ 6=>"-....",
+ 7=>"--...",
+ 8=>"---..",
+ 9=>"----.",
+ ' '=>" ",
+ '.'=>".-.-.-",
+ ','=>"--..--",
+ '?'=>"..--..",
+ ':'=>"---...",
+ ';'=>"-.-.-.",
+ '-'=>"-....-",
+ '_'=>"..--.-",
+ '"'=>".-..-.",
+ "'"=>".----.",
+ '/'=>"-..-.",
+ '('=>"-.--.",
+ ')'=>"-.--.-",
+ '='=>"-...-",
+ 'Ä'=>'.-.-',
+ 'Ö'=>'---.',
+ 'Ü'=>'..--',
+ '@'=>'.--.-.'
+);
+my %spell = (
+ 'intern.' => {
+ 'A' => 'Amsterdam',
+ 'B' => 'Baltimore',
+ 'C' => 'Casablanca',
+ 'D' => 'Danemark',
+ 'E' => 'Edison',
+ 'F' => 'Florida',
+ 'G' => 'Gallipoli',
+ 'H' => 'Havana',
+ 'I' => 'Italia',
+ 'J' => 'Jérusalem',
+ 'K' => 'Kilogramme',
+ 'L' => 'Liverpool',
+ 'M' => 'Madagaskar',
+ 'N' => 'New York',
+ 'O' => 'Oslo',
+ 'P' => 'Paris',
+ 'Q' => 'Québec',
+ 'R' => 'Roma',
+ 'S' => 'Santiago',
+ 'T' => 'Tripoli',
+ 'U' => 'Upsala',
+ 'V' => 'Valencia',
+ 'W' => 'Washington',
+ 'X' => 'Xanthippe',
+ 'Y' => 'Yokohama',
+ 'Z' => 'Zürich'
+ },
+ 'GB' => {
+ 'A' => 'Andrew',
+ 'B' => 'Benjamin',
+ 'C' => 'Charlie',
+ 'D' => 'David',
+ 'E' => 'Edward',
+ 'F' => 'Frederick',
+ 'G' => 'George',
+ 'H' => 'Harry',
+ 'I' => 'Isaac',
+ 'J' => 'Jack',
+ 'K' => 'King',
+ 'L' => 'Lucy',
+ 'M' => 'Mary',
+ 'N' => 'Nellie',
+ 'O' => 'Oliver',
+ 'P' => 'Peter',
+ 'Q' => 'Queenie',
+ 'R' => 'Robert',
+ 'S' => 'Sugar',
+ 'T' => 'Tommy',
+ 'U' => 'Uncle',
+ 'V' => 'Victor',
+ 'W' => 'William',
+ 'X' => 'Xmas',
+ 'Y' => 'Yellow',
+ 'Z' => 'Zebra'
+ },
+ 'USA' => {
+ 'A' => 'Abel',
+ 'B' => 'Baker',
+ 'C' => 'Charlie',
+ 'D' => 'Dog',
+ 'E' => 'Easy',
+ 'F' => 'Fox',
+ 'G' => 'George',
+ 'H' => 'How',
+ 'I' => 'Item',
+ 'J' => 'Jig',
+ 'K' => 'King',
+ 'L' => 'Love',
+ 'M' => 'Mike',
+ 'N' => 'Nan',
+ 'O' => 'Oboe',
+ 'P' => 'Peter',
+ 'Q' => 'Queen',
+ 'R' => 'Roger',
+ 'S' => 'Sugar',
+ 'T' => 'Tare',
+ 'U' => 'Uncle',
+ 'V' => 'Victor',
+ 'W' => 'William',
+ 'X' => 'X',
+ 'Y' => 'Yoke',
+ 'Z' => 'Zebra'
+ },
+ 'ICAO' => {
+ 'A' => 'Alfa',
+ 'B' => 'Bravo',
+ 'C' => 'Charlie',
+ 'D' => 'Delta',
+ 'E' => 'Echo',
+ 'F' => 'Foxtrot',
+ 'G' => 'Golf',
+ 'H' => 'Hotel',
+ 'I' => 'India',
+ 'J' => 'Juliett',
+ 'K' => 'Kilo',
+ 'L' => 'Lima',
+ 'M' => 'Mike',
+ 'N' => 'November',
+ 'O' => 'Oscar',
+ 'P' => 'Papa',
+ 'Q' => 'Quebec',
+ 'R' => 'Romeo',
+ 'S' => 'Sierra',
+ 'T' => 'Tango',
+ 'U' => 'Uniform',
+ 'V' => 'Victor',
+ 'W' => 'Whiskey',
+ 'X' => 'X-Ray',
+ 'Y' => 'Yankee',
+ 'Z' => 'Zulu'
+ },
+ 'D' => {
+ 'A' => 'Anton',
+ 'B' => 'Berta',
+ 'C' => 'Cäsar',
+ 'D' => 'Dora',
+ 'E' => 'Emil',
+ 'F' => 'Friedrich',
+ 'G' => 'Gustav',
+ 'H' => 'Heinrich',
+ 'I' => 'Ida',
+ 'J' => 'Julius',
+ 'K' => 'Kaufmann',
+ 'L' => 'Ludwig',
+ 'M' => 'Martha',
+ 'N' => 'Nordpol',
+ 'O' => 'Otto',
+ 'P' => 'Paula',
+ 'Q' => 'Quelle',
+ 'R' => 'Richard',
+ 'S' => 'Samuel',
+ 'T' => 'Theodor',
+ 'U' => 'Ulrich',
+ 'V' => 'Viktor',
+ 'W' => 'Wilhelm',
+ 'X' => 'Xanthippe',
+ 'Y' => 'Ypsilon',
+ 'Z' => 'Zacharias'
+ }
+);
+
+sub text2morse ($) {
+ my ($text) = @_;
+ my $result;
+ my %deumlaut = ('ä' => 'Ä',
+ 'ö' => 'Ö',
+ 'ü' => 'Ü',
+ 'ß' => 'ss'
+ );
+ $text =~ s/$_/$deumlaut{$_}/ foreach keys %deumlaut;
+ foreach (split(//, $text)) {
+ if (defined $codes{uc $_}) {
+ $result .= $codes{uc $_}." ";
+ } elsif (Irssi::settings_get_bool('morse_kill_unknown_characters')) {
+ $result .= " ";
+ } else {
+ $result .= $_." ";
+ }
+ }
+ return $result;
+}
+
+sub morse2text ($) {
+ my ($morse) = @_;
+ my (%table, $result);
+ $table{$codes{$_}} = $_ foreach keys %codes;
+ foreach (split(/ /, $morse)) {
+ if (defined $table{$_}) {
+ $result .= $table{$_};
+ } else {
+ $result .= $_." ";
+ }
+ }
+ $result =~ s/ +/ /g;
+ return $result;
+}
+
+sub morse_decode ($$$) {
+ my ($server, $target, $text) = @_;
+ return unless ($text =~ /(^|.*? )([\.\-]+ [\.\- ]+)($| .*)/g);
+ my $witem = $server->window_item_find($target);
+
+ return unless ($witem);
+ $witem->print("%B[morse]>>%n ".$1."%U".morse2text($2)."%U ".$3, MSGLEVEL_CLIENTCRAP);
+}
+
+sub spell_decode ($$$) {
+ my ($server, $target, $text) = @_;
+ my $codes;
+ foreach my $type (keys %spell) {
+ $codes .= $spell{$type}{$_}.'|' foreach keys %{ $spell{$type} };
+ }
+ $codes =~ s/\|$//;
+ return unless ($text =~ /^($codes| |[\:\,\.\-\?\!\(\)])+$/);
+ return unless ($text =~ /($codes)/);
+ my $witem = $server->window_item_find($target);
+ return unless ($witem);
+ $witem->print("%B[spell]>>%n ".despell($text), MSGLEVEL_CLIENTCRAP);
+}
+
+sub despell ($) {
+ my ($input) = @_;
+ my %data;
+ foreach my $type (keys %spell) {
+ $data{ $spell{$type}{$_} } = $_ foreach keys %{ $spell{$type} };
+ }
+ my $output;
+ foreach (split / /, $input) {
+ if (defined $data{$_}) {
+ $output .= $data{$_};
+ } else {
+ $output .= $_." ";
+ }
+ }
+ return $output;
+}
+
+sub cmd_morse ($$$) {
+ my ($arg, $server, $witem) = @_;
+ if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) {
+ $witem->command('MSG '.$witem->{name}.' '.text2morse($arg));
+ } else {
+ print CLIENTCRAP "%B>>%n ".text2morse($arg);
+ }
+}
+
+sub cmd_spell ($$$) {
+ my ($args, $server, $witem) = @_;
+ my $type = Irssi::settings_get_str('morse_spelling_alphabet');
+ return unless defined $spell{$type};
+ my $encode;
+ foreach (split(//, $args)) {
+ if (defined $spell{$type}{uc $_}) {
+ $encode .= $spell{$type}{uc $_}." ";
+ } else {
+ $encode .= $_;
+ }
+ }
+ if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) {
+ $witem->command('MSG '.$witem->{name}.' '.$encode);
+ } else {
+ print CLIENTCRAP "%B>>%n ".$encode;
+ }
+
+}
+
+sub cmd_despell ($$$) {
+ my ($args, $server, $witem) = @_;
+ print CLIENTCRAP "%B>>%n ".despell($args);
+}
+
+sub cmd_demorse ($$$) {
+ my ($arg, $server, $witem) = @_;
+ print CLIENTCRAP "%B>>%n ".morse2text($arg);
+}
+
+Irssi::command_bind('morse', \&cmd_morse);
+Irssi::command_bind('spell', \&cmd_spell);
+Irssi::command_bind('despell', \&cmd_despell);
+Irssi::command_bind('demorse', \&cmd_demorse);
+
+Irssi::settings_add_bool($IRSSI{name}, 'morse_kill_unknown_characters', 0);
+Irssi::settings_add_str($IRSSI{name}, 'morse_spelling_alphabet', "ICAO");
+
+Irssi::signal_add('message public', sub { morse_decode($_[0], $_[4], $_[1]); });
+Irssi::signal_add('message own_public', sub { morse_decode($_[0], $_[2], $_[1]); });
+
+Irssi::signal_add('message public', sub { spell_decode($_[0], $_[4], $_[1]); });
+Irssi::signal_add('message own_public', sub { spell_decode($_[0], $_[2], $_[1]); });
+print "%B>>%n ".$IRSSI{name}." ".$VERSION." loaded";
+
diff --git a/scripts/mouse.pl b/scripts/mouse.pl
new file mode 100644
index 0000000..d9debc7
--- /dev/null
+++ b/scripts/mouse.pl
@@ -0,0 +1,168 @@
+# See http://wouter.coekaerts.be/site/irssi/mouse
+# based on irssi mouse patch by mirage: http://darksun.com.pt/mirage/irssi/
+
+# Copyright (C) 2005-2009 Wouter Coekaerts <wouter@coekaerts.be>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+use strict;
+use Irssi qw(signal_emit settings_get_str active_win signal_stop settings_add_str settings_add_bool settings_get_bool signal_add signal_add_first);
+use Math::Trig;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.1.2';
+%IRSSI = (
+ authors => 'Wouter Coekaerts',
+ contact => 'wouter@coekaerts.be',
+ name => 'mouse',
+ description => 'control irssi using mouse clicks and gestures',
+ license => 'GPLv2 or later',
+ url => 'http://wouter.coekaerts.be/irssi/',
+ changed => '2021-03-05',
+);
+
+my @BUTTONS = ('', '_middle', '_right');
+
+my $mouse_xterm_status = -1; # -1:off 0,1,2:filling mouse_xterm_combo
+my @mouse_xterm_combo = (3, 0, 0); # 0:button 1:x 2:y
+my @mouse_xterm_previous; # previous contents of mouse_xterm_combo
+
+sub mouse_enable {
+ print STDERR "\e[?1000h"; # start tracking
+}
+
+sub mouse_disable {
+ print STDERR "\e[?1000l"; # stop tracking
+}
+
+# Handle mouse event (button press or release)
+sub mouse_event {
+ my ($b, $x, $y, $oldb, $oldx, $oldy) = @_;
+ my ($xd, $yd);
+ my ($distance, $angle);
+
+ # uhm, in the patch the scrollwheel didn't work for me, but this does:
+ if ($b == 64) {
+ cmd("mouse_scroll_up");
+ } elsif ($b == 65) {
+ cmd("mouse_scroll_down")
+ }
+
+ # proceed only if a button is being released
+ return if ($b != 3);
+
+ return unless (0 <= $oldb && $oldb <= 2);
+ my $button = $BUTTONS[$oldb];
+
+ # if it was a mouse click of the left button (press and release in the same position)
+ if ($x == $oldx && $y == $oldy) {
+ cmd("mouse" . $button . "_click");
+ return;
+ }
+
+ # otherwise, find mouse gestures
+ $xd = $x - $oldx;
+ $yd = -1 * ($y - $oldy);
+ $distance = sqrt($xd*$xd + $yd*$yd);
+ # ignore small gestures
+ if ($distance < 3) {
+ return;
+ }
+ $angle = asin($yd/$distance) * 180 / 3.14159265358979;
+ if ($angle < 20 && $angle > -20 && $xd > 0) {
+ if ($distance <= 40) {
+ cmd("mouse" . $button . "_gesture_right");
+ } else {
+ cmd("mouse" . $button . "_gesture_bigright");
+ }
+ } elsif ($angle < 20 && $angle > -20 && $xd < 0) {
+ if ($distance <= 40) {
+ cmd("mouse" . $button . "_gesture_left");
+ } else {
+ cmd("mouse" . $button . "_gesture_bigleft");
+ }
+ } elsif ($angle > 40) {
+ cmd("mouse" . $button . "_gesture_up");
+ } elsif ($angle < -40) {
+ cmd("mouse" . $button . "_gesture_down");
+ }
+}
+
+# executes the command configured in the given setting
+sub cmd
+{
+ my ($setting) = @_;
+ signal_emit("send command", settings_get_str($setting), active_win->{'active_server'}, active_win->{'active'});
+}
+
+
+signal_add_first("gui key pressed", sub {
+ my ($key) = @_;
+ if ($mouse_xterm_status != -1) {
+ if ($mouse_xterm_status == 0 && ($mouse_xterm_previous[0] != $mouse_xterm_combo[0])) { # if combo is starting, and previous what not a move (button not changed)
+ @mouse_xterm_previous = @mouse_xterm_combo;
+ }
+ $mouse_xterm_combo[$mouse_xterm_status] = $key-32;
+ $mouse_xterm_status++;
+ if ($mouse_xterm_status == 3) {
+ $mouse_xterm_status = -1;
+ # match screen coordinates
+ $mouse_xterm_combo[1]--;
+ $mouse_xterm_combo[2]--;
+ mouse_event($mouse_xterm_combo[0], $mouse_xterm_combo[1], $mouse_xterm_combo[2], $mouse_xterm_previous[0], $mouse_xterm_previous[1], $mouse_xterm_previous[2]);
+ }
+ signal_stop();
+ }
+});
+
+sub UNLOAD {
+ mouse_disable();
+}
+
+if ($ENV{"TERM"} !~ /^rxvt|screen|xterm|tmux(-(256)?(color|kitty))?$/) {
+ die "Your terminal doesn't seem to support this.";
+}
+
+mouse_enable();
+
+Irssi::command("/^bind meta-[M /mouse_xterm"); # FIXME evil
+Irssi::command_bind("mouse_xterm", sub {$mouse_xterm_status = 0;});
+Irssi::command_bind 'mouse' => sub {
+ my ($data, $server, $item) = @_;
+ $data =~ s/\s+$//g;
+ Irssi::command_runsub('mouse', $data, $server, $item);
+};
+
+# temporarily disable mouse handling. Useful for copy-pasting without touching the keyboard (pressing shift)
+Irssi::command_bind 'mouse tempdisable' => sub {
+ my ($data, $server, $item) = @_;
+ my $seconds = ($data eq '') ? 5 : $data; # optional argument saying how many seconds, defaulting to 5
+ mouse_disable();
+ Irssi::timeout_add_once($seconds * 1000, 'mouse_enable', undef); # turn back on after $second seconds
+};
+
+for my $button (@BUTTONS) {
+ settings_add_str("lookandfeel", "mouse" . $button . "_click", "/mouse tempdisable 5");
+ settings_add_str("lookandfeel", "mouse" . $button . "_gesture_up", "/window last");
+ settings_add_str("lookandfeel", "mouse" . $button . "_gesture_down", "/window goto active");
+ settings_add_str("lookandfeel", "mouse" . $button . "_gesture_left", "/window prev");
+ settings_add_str("lookandfeel", "mouse" . $button . "_gesture_bigleft", "/eval window prev;window prev");
+ settings_add_str("lookandfeel", "mouse" . $button . "_gesture_right", "/window next");
+ settings_add_str("lookandfeel", "mouse" . $button . "_gesture_bigright", "/eval window next;window next");
+}
+
+settings_add_str("lookandfeel", "mouse_scroll_up", "/scrollback goto -10");
+settings_add_str("lookandfeel", "mouse_scroll_down", "/scrollback goto +10");
diff --git a/scripts/mpg123.pl b/scripts/mpg123.pl
new file mode 100644
index 0000000..f0d4d21
--- /dev/null
+++ b/scripts/mpg123.pl
@@ -0,0 +1,86 @@
+# Display current mpg123 track to channel
+# you should run mpg123 as,
+# mpg123 --verbose file1 file2 2> ~/.irssi/scripts/mpg123.log
+# or just put this on a file
+
+# #--- mpg123a file ---#
+# #!/bin/sh
+# mpg123 --verbose * 2> ~/.irssi/scripts/mpg123.log
+
+# save it as mpg123a and make it executable
+# chmod a+x mpg123a
+#
+# execute it on the directory you have your mp3 files
+# ./mpg123a
+
+
+#
+# HOWTO use "mpg123 script" from Irssi:
+# /mpg123 [#channel] [-h|--help]
+#
+# This script works with no problems on mpg123 Version 0.59r
+# bugs: if u call it from the "status" window, it ill crash the script, since you arent currently on a channel.
+# It ill crash the script not the Irssi program, so u shall re-run it.
+
+
+use Irssi;
+use Irssi::Irc;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.01+1";
+%IRSSI = (
+ authors => 'Ricardo Mesquita',
+ contact => 'ricardomesquita@netcabo.pt',
+ name => 'mpg123',
+ description => 'Display current mpg123 track',
+ url => 'http://pwp.netcabo.pt/ricardomesquita/irssi',
+ license => 'GPLv2',
+ changed => 'Mon Nov 27 18:00:00 CET 2006'
+);
+
+my $mpg123file = glob "~/.irssi/scripts/mpg123.log";
+
+
+sub cmd_mpg123 {
+ my ($data, $server, $witem) = @_;
+ my ($mpg123msg, $mpg123linha, $channel);
+
+ my $showhelp="mpg123 irssi script version $VERSION\n/mpg123 [#channel] [-h|--help]";
+
+ if ($data=~/-h|--help/) {
+ Irssi::print($showhelp);
+ return
+ } else {
+ if ($data=~ /#./) {
+ $channel = $data;
+ } else {
+ if ($witem->{name} ne "") {
+ $channel = $witem->{name};
+ }
+ }
+
+ open (f, "<", $mpg123file) || return;
+
+ while ($mpg123linha=<f>) {
+
+ chomp($mpg123linha);
+ if ($mpg123linha=~/playing/i) {
+ $mpg123linha =~s/(.*)stream from\s(.*)\.(.*)\s(.*)/\2\.\3/;
+ $mpg123msg="on MPG123 playing $mpg123linha";
+ }
+
+ chomp($mpg123linha);
+ if ($mpg123linha =~/time:\s/i) {
+ $mpg123linha=~s/[\s]frame#.*,\s(.*),/\1/i;
+ $mpg123linha=~s/time:\s(\d\d).(\d\d).(\d\d)..(\d\d).(\d\d).(\d\d)./\[\1:\2.\3\]/i;
+ $mpg123msg.=" $mpg123linha";
+ }
+ }
+ close(f);
+ $mpg123msg =~ s/[\r\n]/ /g;
+ $server->command("action ". $channel . " $mpg123msg");
+ }
+}
+
+Irssi::command_bind('mpg123', 'cmd_mpg123');
diff --git a/scripts/multipaste.pl b/scripts/multipaste.pl
new file mode 100644
index 0000000..a4a6e5a
--- /dev/null
+++ b/scripts/multipaste.pl
@@ -0,0 +1,151 @@
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "2003120617";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "multipaste",
+ description => "Helps pasting multiple lines to a channel",
+ license => "GPLv2",
+ url => "",
+ changed => "$VERSION",
+ modules => "",
+ commands => "multipaste"
+);
+
+use Irssi 20020324;
+use vars qw(%item);
+
+sub sig_send_text ($$$) {
+ my ($line, $server, $witem) = @_;
+ return unless (Irssi::settings_get_bool('multipaste_auto'));
+ return unless (ref $server);
+ return unless ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY'));
+ $line =~ s/\t/ /g;
+ if (%item && $item{waiting}) {
+ %item = ();
+ }
+ if ($witem->{name} eq $item{channel} && $server->{tag} eq $item{server}) {
+ Irssi::timeout_remove($item{timeout});
+ #Irssi::command("BIND -delete tab");
+ my $timeout = 10;
+ chomp($line);
+ $item{text} .= $line."\n";
+ $item{timeout} = Irssi::timeout_add($timeout, \&send_item, undef);
+ Irssi::signal_stop();
+ } else {
+ unless ($line eq '') {
+ Irssi::signal_stop();
+ paste($line, $server, $witem);
+ }
+ }
+}
+
+sub sig_send_command ($$$) {
+ my ($line, $server, $witem) = @_;
+ return if ($line =~ /^.multipaste/);
+ return unless (Irssi::settings_get_bool('multipaste_auto'));
+ return unless (ref $witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY'));
+ if (%item && $item{waiting}) {
+ %item = ();
+ return;
+ }
+ # This does not work when the first line starts with
+ return unless $item{text};
+ $line =~ s/\t/ /g;
+ if ($witem->{name} eq $item{channel} && $server->{tag} eq $item{server}) {
+ Irssi::timeout_remove($item{timeout});
+ #Irssi::command("BIND -delete tab");
+ my $timeout = 10;
+ chomp($line);
+ $item{text} .= $line."\n";
+ $item{timeout} = Irssi::timeout_add($timeout, \&send_item, undef);
+ Irssi::signal_stop();
+ } else {
+ Irssi::signal_stop();
+ paste($line, $server, $witem);
+ }
+}
+
+
+sub send_item {
+ my $limit = Irssi::settings_get_int('multipaste_limit');
+ my $server = Irssi::server_find_tag($item{server});
+ my $channel = $server->window_item_find($item{channel});
+ my $lines = scalar( split(/\n/, $item{text}) );
+ if ($limit > 0 && $lines > $limit) {
+ unless ($item{confirmed}) {
+ $channel->print('%B>>%n Do you want to paste '.$lines.' lines? Enter "/multipaste" to proceed', MSGLEVEL_CLIENTCRAP);
+ $item{waiting} = 1;
+ Irssi::timeout_remove($item{timeout});
+ return;
+ }
+ }
+ my $prefix = Irssi::settings_get_str('multipaste_prefix');
+ my $prefix2 = '';
+ $prefix = $item{prefix}.': '.$prefix if $item{prefix};
+ $prefix2 = $item{prefix}.': ' if $item{prefix};
+ if (scalar( split(/\n/, $item{text}) ) > 1) {
+ #Irssi::command("BIND tab word_completion");
+ my $embrace = Irssi::settings_get_bool('multipaste_embrace');
+ $server->command('MSG -- '.$channel->{name}.' '.$prefix2.',--8<-') if $embrace;
+ foreach (split(/\n/, $item{text})) {
+ $server->command('MSG -- '.$channel->{name}.' '.$prefix.$_);
+ }
+ $server->command('MSG -- '.$channel->{name}.' '.$prefix2.'`-->8-') if $embrace;
+ } else {
+ my $text = join("", split(/\n/, $item{text}));
+ my $prefix = $item{prefix} ? $item{prefix}.': ' : '';
+ unless ($prefix.$text eq "\n") {
+ $server->command('MSG -- '.$channel->{name}.' '.$prefix.$text);
+ }
+ }
+ Irssi::timeout_remove($item{timeout});
+ %item = ();
+}
+
+sub paste ($$$) {
+ my ($args, $server, $witem) = @_;
+ return unless ref $witem;
+ return if (%item);
+ chomp($args);
+ my $timeout = 10;
+ if ($args =~ /^(.+?): (.*)/ && $witem->{type} eq 'CHANNEL' && $witem->nick_find($1)) {
+ $item{prefix} = $1;
+ $item{text} .= $2."\n";
+ } else {
+ $item{text} .= $args."\n";
+ }
+ $item{server} = $server->{tag};
+ $item{channel} = $witem->{name};
+ $item{timeout} = Irssi::timeout_add($timeout, \&send_item, undef);
+}
+
+sub cmd_multipaste ($$$) {
+ my ($args, $server, $witem) = @_;
+ return unless (%item && $item{waiting});
+ $item{confirmed} = 1;
+ send_item();
+}
+
+
+sub sig_word_complete ($$$$$) {
+ my ($list, $window, $word, $linestart, $want_space) = @_;
+ my $lines = scalar( split(/\n/, $item{text}) );
+ if (%item && ( not $item{waiting} ) ) {
+ push @$list, $linestart.$word.' ';
+ Irssi::signal_stop();
+ }
+}
+
+Irssi::settings_add_bool($IRSSI{name}, 'multipaste_auto', 1);
+Irssi::settings_add_int($IRSSI{name}, 'multipaste_limit', 0);
+Irssi::settings_add_bool($IRSSI{name}, 'multipaste_embrace', 1);
+Irssi::settings_add_str($IRSSI{name}, 'multipaste_prefix', '|');
+Irssi::command_bind('multipaste', \&cmd_multipaste);
+Irssi::signal_add('send text', 'sig_send_text');
+Irssi::signal_add('send command', 'sig_send_command');
+Irssi::signal_add_first('complete word', 'sig_word_complete');
+
+print CLIENTCRAP "%B>>%n ".$IRSSI{name}." ".$VERSION." loaded";
diff --git a/scripts/my_beep.pl b/scripts/my_beep.pl
new file mode 100644
index 0000000..7723e75
--- /dev/null
+++ b/scripts/my_beep.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/irssi
+#
+# irssi beep with-command-script
+# (C) 2003 Remco den Breeje
+# inspired by Georg Lukas
+
+# howtoinstall:
+# copy this file to ~/.irssi/scripts/
+# in irssi:
+# $/script load my_beep.pl
+# change the settings
+# $/set beep_msg_level HILIGHT
+# $/set beep_cmd beep
+
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.10";
+%IRSSI = (
+ authors => "Remco den Breeje",
+ contact => "stacium or stek (most of the time) @ quakenet.org",
+ name => "my_beep",
+ description => "runs arbitrary command instead of system beep, includes flood protection",
+ license => "Public Domain",
+ url => "http://www.xs4all.nl/~stacium/irssi/my_beep.html",
+);
+
+use Irssi;
+
+my $can_I_beep = 1;
+my ($timeout_tag);
+
+sub beep_overflow_timeout() {
+ $can_I_beep = 1;
+}
+
+sub my_beep() {
+ my $beep_cmd = Irssi::settings_get_str("beep_cmd");
+ if ($beep_cmd) {
+ my $beep_flood = Irssi::settings_get_int('beep_flood');
+ # check on given beep_flood
+ if($beep_flood < 0) {
+ Irssi::print("Warning! Wrong value for beep_flood (time in milisecs)");
+ Irssi::signal_stop();
+ return;
+ }
+ if (defined $timeout_tag) {
+ Irssi::timeout_remove($timeout_tag);
+ $timeout_tag= undef;
+ }
+ $timeout_tag = Irssi::timeout_add_once($beep_flood, 'beep_overflow_timeout', undef);
+ if ($can_I_beep) {
+ $can_I_beep = 0;
+ system($beep_cmd);
+ }
+ Irssi::signal_stop();
+ }
+}
+
+Irssi::settings_add_str("lookandfeel", "beep_cmd", "echo INeedToBeSet > /dev/null");
+Irssi::settings_add_int("lookandfeel", "beep_flood", 2000);
+Irssi::signal_add("beep", "my_beep");
diff --git a/scripts/mygoogle.pl b/scripts/mygoogle.pl
new file mode 100644
index 0000000..b2d0cc1
--- /dev/null
+++ b/scripts/mygoogle.pl
@@ -0,0 +1,114 @@
+#######################################################################
+# mygoogle.pl
+#
+# Author: Tim Van Wassenhove <timvw@users.sourceforge.net>
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. The name of the author may not be used to endorse or promote products
+# derived from this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+#######################################################################
+
+use strict;
+use Irssi;
+use LWP::UserAgent;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.01';
+%IRSSI = (
+ authors => 'Tim Van Wassenhove',
+ contact => 'timvw@users.sourceforge.net',
+ name => 'mygoogle',
+ description => 'Query Google',
+ license => 'BSD',
+ url => 'http://home.mysth.be/~timvw',
+ changed => '13-03-04 01:35',
+);
+
+# Perform the query and return the results
+sub google_query {
+
+ my $query = shift;
+
+ my $ua = LWP::UserAgent->new;
+ $ua->agent("irssi/0.1");
+
+ # Request the page
+ my $request = HTTP::Request->new(GET => "http://www.google.com/search?hl=en&q=$query");
+ my $result = $ua->request($request);
+ my $content = $result->content;
+
+ # Parse the returned page
+ my @lines = split("<br>",$content);
+ my @results = ();
+ push(@results,"Results for $query on Google:");
+ my $counter = 0;
+ foreach(@lines) {
+ if ($counter < 3 && $_ =~ /^\<font color=#008000\>(.*?)\s+(.*?)\s+\-\s+\<\/font\>(.*)$/) {
+ push(@results,"http://$1");
+ ++$counter;
+ }
+ }
+ push(@results,"--");
+
+ return @results;
+}
+
+# Output the results
+sub results_write {
+ my ($server,$target,@lines) = @_;
+ foreach(@lines) {
+ $server->command("MSG $target $_");
+ }
+}
+
+# Handle what others say in public
+sub message_public {
+ my ($server,$msg,$nick,$address,$target) = @_;
+ if ($msg =~ /^\!google\s+(.+)$/) {
+ my @lines = google_query($1);
+ results_write($server,$target,@lines);
+ }
+}
+
+# Handle what we say in public
+sub message_own_public {
+ my ($server,$msg,$target) = @_;
+ message_public($server,$msg,$server->{nick},0,$target);
+}
+
+# Handle what others say in private
+sub message_private {
+ my ($server,$msg,$nick,$address) = @_;
+ message_public($server,$msg,$nick,$address,$nick);
+}
+
+# Handle what we say in private
+sub message_own_private {
+ my ($server,$msg,$target,$otarget) = @_;
+ message_public($server,$msg,$server->{nick},0,$target);
+}
+
+# Connect the signals with the functions
+Irssi::signal_add('message public','message_public');
+Irssi::signal_add('message own_public','message_own_public');
+Irssi::signal_add('message private','message_private');
+Irssi::signal_add('message own_private','message_own_private'); \ No newline at end of file
diff --git a/scripts/myimdb.pl b/scripts/myimdb.pl
new file mode 100644
index 0000000..5d8b855
--- /dev/null
+++ b/scripts/myimdb.pl
@@ -0,0 +1,114 @@
+#######################################################################
+# myimdb.pl
+#
+# Author: Tim Van Wassenhove <timvw@users.sourceforge.net>
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. The name of the author may not be used to endorse or promote products
+# derived from this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+#######################################################################
+
+use strict;
+use Irssi;
+use LWP::UserAgent;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.01';
+%IRSSI = (
+ authors => 'Tim Van Wassenhove',
+ contact => 'timvw@users.sourceforge.net',
+ name => 'myimdb',
+ description => 'Query imdb',
+ license => 'BSD',
+ url => 'http://home.mysth.be/~timvw',
+ changed => '13-03-04 01:43',
+);
+
+# Perform the query and return the results
+sub imdb_query {
+
+ my $query = shift;
+
+ my $ua = LWP::UserAgent->new;
+ $ua->agent("irssi/0.1 ");
+
+ # Request the page
+ my $request = HTTP::Request->new(GET => "http://us.imdb.com/Title?=$query");
+ my $result = $ua->request($request);
+ my $content = $result->content;
+
+ # Parse the returned page
+ my @lines = split("<LI>",$content);
+ my @results = ();
+ push(@results,"Results for $query on imdb:");
+ my $counter = 1;
+ foreach(@lines) {
+ if ($counter < 4 && $_ =~ /^\<A HREF=\"\/title\/tt(\d+)\/\"\>(.*?)\<\/A\>\<\/LI\>$/) {
+ push(@results,"http://us.imdb.com/title/tt$1 $2");
+ ++$counter;
+ }
+ }
+ push(@results,"--");
+
+ return @results;
+}
+
+# Output the results
+sub results_write {
+ my ($server,$target,@lines) = @_;
+ foreach(@lines) {
+ $server->command("MSG $target $_");
+ }
+}
+
+# Handle what others say in public
+sub message_public {
+ my ($server,$msg,$nick,$address,$target) = @_;
+ if ($msg =~ /^\!imdb\s+(.+)$/) {
+ my @lines = imdb_query($1);
+ results_write($server,$target,@lines);
+ }
+}
+
+# Handle what we say in public
+sub message_own_public {
+ my ($server,$msg,$target) = @_;
+ message_public($server,$msg,$server->{nick},0,$target);
+}
+
+# Handle what others say in private
+sub message_private {
+ my ($server,$msg,$nick,$address) = @_;
+ message_public($server,$msg,$nick,$address,$nick);
+}
+
+# Handle what we say in private
+sub message_own_private {
+ my ($server,$msg,$target,$otarget) = @_;
+ message_public($server,$msg,$server->{nick},0,$target);
+}
+
+# Connect the signals with the functions
+Irssi::signal_add('message public','message_public');
+Irssi::signal_add('message own_public','message_own_public');
+Irssi::signal_add('message private','message_private');
+Irssi::signal_add('message own_private','message_own_private');
diff --git a/scripts/mysqlurllogger.pl b/scripts/mysqlurllogger.pl
new file mode 100644
index 0000000..ea9b74a
--- /dev/null
+++ b/scripts/mysqlurllogger.pl
@@ -0,0 +1,82 @@
+#
+# Logs URLs this script is just a hack. hack it to suit you
+# if you want to.
+#
+# table format;
+#
+#+-----------+---------------+------+-----+---------+-------+
+#| Field | Type | Null | Key | Default | Extra |
+#+-----------+---------------+------+-----+---------+-------+
+#| insertime | timestamp(14) | YES | | NULL | |
+#| nick | char(10) | YES | | NULL | |
+#| target | char(255) | YES | | NULL | |
+#| line | char(255) | YES | | NULL | |
+#+-----------+---------------+------+-----+---------+-------+
+
+use strict;
+use DBI;
+use Irssi;
+use Irssi::Irc;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.1";
+%IRSSI = (
+ authors => "Riku Voipio, lite",
+ contact => "riku.voipio\@iki.fi",
+ name => "myssqlurllogger",
+ description => "logs url's to mysql database",
+ license => "GPLv2",
+ url => "http://nchip.ukkosenjyly.mine.nu/irssiscripts/",
+ );
+
+my $dsn; # 'DBI:mysql:ircurl:localhost';
+my $db_user_name;
+my $db_password;
+
+sub cmd_logurl {
+ my ($server, $data, $nick, $mask, $target) = @_;
+ my $d = $data;
+ if (($d =~ /(.{1,2}tp\:\/\/.+)/) or ($d =~ /(www\..+)/)) {
+ db_insert($nick, $target, $1);
+ }
+ return 1;
+}
+
+sub cmd_own {
+ my ($server, $data, $target) = @_;
+ return cmd_logurl($server, $data, $server->{nick}, "", $target);
+}
+sub cmd_topic {
+ my ($server, $target, $data, $nick, $mask) = @_;
+ return cmd_logurl($server, $data, $nick, $mask, $target);
+}
+
+sub db_insert {
+ my ($nick, $target, $line)=@_;
+ my $dbh = DBI->connect($dsn, $db_user_name, $db_password);
+ my $sql="insert into urlevent (insertime, nick, target,line) values (NOW()".",". $dbh->quote($nick) ."," . $dbh->quote($target) ."," . $dbh->quote($line) .")";
+ my $sth = $dbh->do($sql);
+ $dbh->disconnect();
+ }
+
+sub sig_setup_changed {
+ $dsn=Irssi::settings_get_str($IRSSI{name}.'_dsn');
+ $db_user_name=Irssi::settings_get_str($IRSSI{name}.'_user');
+ $db_password=Irssi::settings_get_str($IRSSI{name}.'_password');
+}
+
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_dsn', 'DBI:mysql:ircurl:localhost');
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_user', 'tunnus');
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_password', 'salakala');
+
+Irssi::signal_add_last('message public', 'cmd_logurl');
+Irssi::signal_add_last('message own_public', 'cmd_own');
+Irssi::signal_add_last('message topic', 'cmd_topic');
+Irssi::signal_add("setup changed", "sig_setup_changed");
+
+sig_setup_changed();
+
+Irssi::print("URL logger by lite/nchip loaded.");
+
+# vim:set ts=8 sw=8:
diff --git a/scripts/nact.pl b/scripts/nact.pl
new file mode 100644
index 0000000..7f4cfab
--- /dev/null
+++ b/scripts/nact.pl
@@ -0,0 +1,335 @@
+use Irssi;
+use Irssi::TextUI;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION="0.2.6";
+%IRSSI = (
+ authors=> 'BC-bd',
+ contact=> 'bd@bc-bd.org',
+ name=> 'nact',
+ description=> 'Adds an item which displays the current network activity. Needs /proc/net/dev.',
+ sbitems=> 'nact',
+ license=> 'GPL v2 or later',
+ url=> 'https://bc-bd.org/svn/repos/irssi/trunk/',
+);
+
+#########
+# INFO
+###
+#
+# Currently running on Linux, OpenBsd and FreeBsd.
+#
+# Type this to add the item:
+#
+# /statusbar window add nact
+#
+# See
+#
+# /help statusbar
+#
+# for more help on how to custimize your statusbar.
+# Add something like this to your theme file to customize to look of the item
+#
+# nact_display = "$0%R>%n%_$1%_%G>%n$2";
+#
+# where $0 is the input, $1 the device and $2 the output. To customize the
+# outout of the /bw command add something like
+#
+# nact_command = "$0)in:$1:out($2";
+#
+# to your theme file.
+#
+##########
+# THEME
+####
+#
+# This is the complete list of parameters passed to the format:
+#
+# $0: incomming rate
+# $1: name of the device, eg. eth0
+# $2: outgoing rate
+# $3: total bytes received
+# $4: total bytes sent
+# $5: sum of $4 and $5
+#
+#########
+# TODO
+###
+#
+# Make this script work on other unices, For that i need some infos on where
+# to find the total amount of sent bytes on other systems. You may be so kind
+# as to send me the name of such a file and a sample output of it.
+#
+# or
+#
+# you can be so kind as to send me a patch. Fort that _please_ check that you
+# do have the latest nact.pl and use these diff switches:
+#
+# diff -uN nact.pl.new nact.pl.old
+#
+############
+# OPTIONS
+######
+#
+# /set nact_command <command>
+# command: command to execute on /bw. example:
+#
+# /set nact_command /say
+#
+# /set nact_devices <devices>
+# devices: space seperated list of devices to display
+#
+# /set nact_interval <n>
+# n: number of mili-seconds to wait before an update of the item
+#
+# /set nact_format <format>
+# format: a format string like the one with sprintf. examples:
+#
+# /set nact_format %d no digits after the point at all
+# /set nact_format %.3f 3 digits after the point
+# /set nact_format %.5f 5 digits after the point
+#
+# /set nact_unit <n>
+# n: set the unit to KiB, MiB, or GiB. examples:
+#
+# /set nact_unit 0 calculate dynamically
+# /set nact_unit 1 set to KiB/s
+# /set nact_unit 2 set to MiB/s
+# /set nact_unit 3 set to GiB/s
+#
+###
+################
+
+my $outString = "nact...";
+my $outCmd = "nact...";
+my (%in,%out,$timeout,$getBytes);
+
+sub getBytesLinux() {
+ my @list;
+ my $ignore = 2;
+
+ open(FID, "<", "/proc/net/dev");
+
+ while (<FID>) {
+ if ($ignore > 0) {
+ $ignore--;
+ next;
+ }
+
+ my $line = $_;
+ $line =~ s/[\s:]/ /g;
+ @list = split(" ", $line);
+ $in{$list[0]} = $list[1];
+ $out{$list[0]} = $list[9];
+ }
+
+ close (FID);
+}
+
+sub getBytesOBSD() {
+ my @list;
+
+ open(FID, "-|", "/usr/bin/netstat -nib");
+
+ while (<FID>) {
+ my $line = $_;
+ @list = split(" ", $line);
+ $in{$list[0]} = $list[4];
+ $out{$list[0]} = $list[5];
+ }
+
+ close (FID);
+}
+
+sub getBytesFBSD() {
+ my @list;
+ my $olddev="";
+
+ open(FID, "-|", "/usr/bin/netstat -nib");
+ while (<FID>) {
+ my $line = $_;
+ @list = split(" ", $line);
+ next if $list[0] eq $olddev;
+ $in{$list[0]} = $list[6];
+ $out{$list[0]} = $list[9];
+ $olddev=$list[0];
+ }
+
+ close (FID);
+}
+
+sub make_kilo($$$) {
+ my ($what,$format,$unit) = @_;
+ my ($effective);
+
+ # determine the effective unit, either from forcing, or from dynamically
+ # checking the size of the value
+ if ($unit == 0) {
+ if ($what >= 1024*1024*1024) {
+ $effective = 3
+ } elsif ($what >= 1024*1024) {
+ $effective = 2
+ } elsif ($what >= 1024) {
+ $effective = 1
+ } else {
+ $effective = 0;
+ }
+ } else {
+ $effective = $unit;
+ }
+
+ if ($effective >= 3) {
+ return sprintf($format."%s", $what/(1024*1024*1024), "G");
+ } elsif ($effective == 2) {
+ return sprintf($format."%s", $what/(1024*1024), "M");
+ } elsif ($effective == 1) {
+ return sprintf($format."%s", $what/(1024), "K");
+ } else {
+ return sprintf($format, $what);
+ }
+}
+
+sub sb_nact() {
+ my ($item, $get_size_only) = @_;
+
+ $item->default_handler($get_size_only, "{sb $outString}", undef, 1);
+}
+
+sub timeout_nact() {
+ my ($out,$char);
+ my $slice = Irssi::settings_get_int('nact_interval');
+ my $format = Irssi::settings_get_str('nact_format');
+ my $unit = Irssi::settings_get_int('nact_unit');
+ my $theme = Irssi::current_theme();
+ my %oldIn = %in;
+ my %oldOut = %out;
+
+ &$getBytes();
+
+ $out = "";
+ $outCmd = "";
+
+ foreach (split(" ", Irssi::settings_get_str('nact_devices'))) {
+ my $b_in = $in{$_};
+ my $b_out = $out{$_};
+ my $deltaIn = make_kilo(($b_in -$oldIn{$_})*1000/$slice,$format,$unit);
+ my $deltaOut = make_kilo(($b_out -$oldOut{$_})*1000/$slice,$format,$unit);
+ my $i = make_kilo($b_in,$format,$unit);
+ my $o = make_kilo($b_out,$format,$unit);
+ my $s = make_kilo($b_in +$b_out,$format,$unit);
+
+ $out .= Irssi::current_theme->format_expand(
+ "{nact_display $deltaIn $_ $deltaOut $i $o $s}",Irssi::EXPAND_FLAG_IGNORE_REPLACES);
+
+ $outCmd .= Irssi::current_theme->format_expand(
+ "{nact_command $deltaIn $_ $deltaOut $i $o $s}",Irssi::EXPAND_FLAG_IGNORE_REPLACES);
+ }
+
+ # perhaps this usage of $out as temp variable does fix those nasty
+ # display errors
+ $outString = $out;
+ Irssi::statusbar_items_redraw('nact');
+}
+
+sub nact_setup() {
+ my $slice = Irssi::settings_get_int('nact_interval');
+
+ Irssi::timeout_remove($timeout);
+
+ if ($slice < 10) {
+ Irssi::print("nact.pl, ERROR nact_interval must be greater than 10");
+ return;
+ }
+
+ $timeout = Irssi::timeout_add($slice, 'timeout_nact' , undef);
+}
+
+sub cmd_bw {
+ my ($data, $server, $witem) = @_;
+
+ if ($witem && ($witem->{type} eq "CHANNEL" || $witem->{type} eq "QUERY")) {
+ $witem->command(Irssi::settings_get_str('nact_command')." ".$outCmd);
+ } else {
+ Irssi::print("nact: command needs window of type channel or query.");
+ }
+}
+
+Irssi::command_bind('bw','cmd_bw');
+
+Irssi::signal_add('setup changed','nact_setup');
+
+# register our item
+Irssi::statusbar_item_register('nact', undef, 'sb_nact');
+
+# register our os independant settings
+Irssi::settings_add_int('misc', 'nact_interval', 10000);
+Irssi::settings_add_str('misc', 'nact_format', '%.0f');
+Irssi::settings_add_int('misc', 'nact_unit', 0);
+Irssi::settings_add_str('misc', 'nact_command', 'me looks at the gauges:');
+
+# os detection
+my $os = `uname`;
+if ($os =~ /Linux/) {
+ Irssi::print("nact.pl, running on Linux, using /proc/net/dev");
+ $getBytes = \&getBytesLinux;
+ Irssi::settings_add_str('misc', 'nact_devices', "eth0 lo");
+} elsif ($os =~ /OpenBSD/) {
+ Irssi::print("nact.pl, running on OpenBSD, using netstat -nbi");
+ $getBytes = \&getBytesOBSD;
+ Irssi::settings_add_str('misc', 'nact_devices', "tun0");
+} elsif ($os =~ /FreeBSD/) {
+ Irssi::print("nact.pl, running on FreeBSD, using netstat -nbi");
+ $getBytes = \&getBytesFBSD;
+ Irssi::settings_add_str('misc', 'nact_devices', "rl0");
+} else {
+ Irssi::print("nact.pl, sorry no support for OS:$os");
+ Irssi::print("nact.pl, If you know how to collect the needed data on your OS, mail me :)");
+ $os = "";
+}
+
+if ($os ne "") {
+ &$getBytes();
+ nact_setup();
+}
+
+################
+###
+# Changelog
+#
+# Version 0.2.5
+# - added nact_command
+# - added /bw
+#
+# Version 0.2.4
+# - added FreeBSD support (by senneth)
+#
+# Version 0.2.3
+# - stray ' ' in the item (reported by darix). Add a " " at the end of your
+# nact_display if you have more than one interface listed.
+#
+# Version 0.2.2
+# - added missing use Irssi::TextUI (reported by darix)
+# - small parameter switch bug (reported by darix)
+#
+# Version 0.2.1
+# - added total number of bytes sent/received
+#
+# Version 0.2.0
+# - runs now from autorun/ on openbsd
+# - changed nact_interval to mili-seconds
+# - added nact_format, nact_unit
+#
+# Version 0.1.2
+# - small typo in the docs
+#
+# Version 0.1.1
+# - introduced multiple os support
+# - added a theme thingie to make sascha happy ;)
+#
+# Version 0.1.0
+# - initial release
+#
+###
+################
diff --git a/scripts/news.pl b/scripts/news.pl
new file mode 100644
index 0000000..b8d8609
--- /dev/null
+++ b/scripts/news.pl
@@ -0,0 +1,282 @@
+#
+# This script requires external perl module News::NNTPClient. You can download
+# sources of this module from:
+# http://www.cpan.org/authors/id/RVA/NNTPClient-0.37.tar.gz
+# http://derwan.irssi.pl/perl-modules/NNTPClient-0.37.tar.gz
+# Usage:
+# /ARTICLE [-s <server>] [-p <port>] [-P <password> -U <login>] [-l <group> <count>] [-a] [-L <index>] <Message-ID>
+# Settings:
+# /SET news_nntp_server [server] (default environment variable 'NNTPSERVER' is used (or news.tpi.pl if variable not set))
+# /SET news_nntp_port [port] (default is 119)
+# /SET news_show_headers [headers] (default: from newsgroups subject message-id date lines)
+# /SET news_use_news_window [On/Off] (default is On)
+# /SET news_show_signature [On/Off] (default is On)
+# /SET news_use_body_colors [On/Off] (default is On)
+# /SET news_check_count [count] (default is 5)
+# /SET news_use_auth [On/Off] (default is Off)
+# /SET news_auth_user [login]
+# /SET news_auth_password [password]
+
+use strict;
+use Irssi;
+use 5.6.0;
+use POSIX;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.5.9";
+%IRSSI = (
+ 'authors' => 'Marcin Rozycki, Mathieu Doidy',
+ 'contact' => 'derwan@irssi.pl',
+ 'name' => 'news',
+ 'description' => 'News reader, usage: /article [-s <server>] [-p <port>] [-P <password> -U <login>] [-l <group> <count>] [-a] [-L <index>] <message-id>',
+ 'url' => 'http://derwan.irssi.pl',
+ 'license' => 'GNU GPL v2',
+ 'changed' => 'Fri Feb 6 21:26:57 CET 2004',
+);
+
+use News::NNTPClient;
+
+my $debug_level = 0;
+my $nntp_server = $ENV{'NNTPSERVER'}; $nntp_server = 'news.tpi.pl' unless $nntp_server;
+my $nntp_port = '119';
+my $default_headers = 'from newsgroups';
+my $check_count = 5;
+my %pipe_tag = ();
+my $news_window_name = 'news';
+my @colors = (15, 12, 03, 06, 05, 07, 14);
+my @articles = ();
+
+Irssi::command_bind article => sub {
+ my $usage = '/article [-s <server>] [-p <port>] [-P <password> -U <login>] [-l <group> <count>] [-a] [-L <index>] <Message-ID>';
+
+ my $window;
+ if (Irssi::settings_get_bool('news_use_news_window')) {
+ $window = Irssi::window_find_name($news_window_name);
+ if (!$window) {
+ Irssi::command('^window new hide');
+ Irssi::command('^window name '.$news_window_name);
+ $window = Irssi::window_find_name($news_window_name);
+ }
+ } else {
+ $window = Irssi::active_win();
+ }
+
+ my $server = Irssi::settings_get_str('news_nntp_server');
+ $server = $nntp_server unless $server;
+ my $port = Irssi::settings_get_int('news_nntp_port');
+ $port = $nntp_port unless ($port > 0);
+ my $count = Irssi::settings_get_int('news_check_count');
+ $count = $check_count unless ($count > 0);
+
+ my ($connection, $artid, $group, $strip, $showall, @article);
+ my ($auth, $user, $password);
+ my $yes = 0;
+
+ @_ = split(/ +/, $_[0]);
+ while ($_ = shift(@_))
+ {
+ /^-a$/ and $showall = 1, next;
+ /^-s$/ and $server = shift(@_), next;
+ /^-p$/ and $port = shift(@_), next;
+ /^-P$/ and $password = shift(@_), next;
+ /^-U$/ and $user = shift(@_), next;
+ /^-l$/ and do {
+ $group = shift(@_);
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_group_missing', $usage), return unless ($group);
+ $_ = shift(@_);
+ $count = $_, next if ($_ =~ /^\d+$/ and $_ > 0);
+ };
+ /^-yes$/i and ++$yes, next;
+ /^-L$/ and do {
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_no_artids'), return if ($#articles < 0);
+ if ($artid = shift(@_)) {
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_unknown_argument', $artid, $usage), return if ($artid !~ /^\d+/ or $artid < 0 or $artid > 10);
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_unknown_artid', ++$artid), return unless ($articles[--$artid]);
+ $_ = $articles[$artid]->[0];
+ } else {
+ for (my $idx = 0; $idx <= $#articles; $idx++) {
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_artid_show',
+ ($idx + 1), $articles[$idx]->[0], $articles[$idx]->[1], $articles[$idx]->[2]);
+ }
+ return;
+ }
+ };
+ /^-/ and $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_unknown_argument', $_, $usage), return;
+ $artid = ($_ =~ /^<.*>$/) ? $_ : '<'.$_.'>';
+ last;
+ }
+
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_server_unknown', $server), return if (!$server or $server !~ /^..*\...*/);
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_port_unknown', $port), return if (!$port or $port !~ /^\d+$/ or $port == 0 or $port > 65535);
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_missing_argument', $usage), return if (!$group and !$artid);
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_article_unknown', $artid), return if (!$group and $artid !~ /^<..*\@..*>$/);
+
+ my ($rh, $wh);
+ pipe($rh, $wh);
+
+ my $pid = fork();
+ unless (defined $pid) {
+ close($rh); close($wh);
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_cannot_fork');
+ return;
+
+ } elsif ($pid) {
+ close ($wh);
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_server_connecting', $server, $port, $artid);
+ Irssi::pidwait_add($pid);
+ $pipe_tag{$rh} = Irssi::input_add(fileno($rh), INPUT_READ, \&news_fork, $rh);
+ return;
+ }
+
+ close($rh);
+
+ $connection = new News::NNTPClient($server, $port, $debug_level);
+ print($wh "not_connected $server $port\n"), goto END unless ($connection->{CODE} =~ /^(200|201)$/);
+ print($wh "connected ".$connection->{MESG}."\n");
+
+ if ($user && $password or Irssi::settings_get_bool('news_use_auth')) {
+ $user = Irssi::settings_get_str('news_auth_user') unless defined $user;
+ $password = Irssi::settings_get_str('news_auth_password') unless defined $password;
+ $connection->authinfo($user,$password);
+ }
+
+
+ if ($group) {
+ print($wh "listgroup_yes $count\n"), goto END if ($count > 10 and !$yes);
+ print($wh "listgroup_request $server $group\n");
+ my @list = $connection->listgroup($group);
+ print($wh "listgroup_error $server ".$connection->{MESG}."\n"), goto END if ($#list < 0);
+
+ my $num = $#list;
+ print($wh "listgroup_num $group $num $count\n");
+ @list = @list[($num - $count) .. $num] if ($num > --$count);
+
+ N: while ($_ = shift(@list))
+ {
+ chomp;
+ print($wh "space\n");
+ foreach my $xhdr ("From", "Subject", "Message-ID")
+ {
+ my @reply = $connection->xhdr($xhdr, $_);
+ chomp $reply[0]; $reply[0] =~ s/^\d+ //;
+ goto N unless ($reply[0]);
+ if ($xhdr eq "Message-ID") {
+ print($wh "memo $reply[0]\,news.pl: listgroup,$group\n");
+ } elsif ($xhdr eq "From") {
+ $reply[0] = "\002" . $reply[0] . "\002";
+ }
+ print($wh "listgroup_header $xhdr $reply[0]\n");
+ }
+ }
+ print($wh "space\n");
+
+ } else {
+ my $show_headers = $default_headers .' '. Irssi::settings_get_str('news_show_headers');
+ my ($head, $idx, $usecolors, $bodycolor) = (1, 0, Irssi::settings_get_bool('news_use_body_colors'), $colors[0]);
+
+ print($wh "article_request $server $artid\n");
+ foreach ($connection->article($artid))
+ {
+ unless ($idx++) {
+ print($wh "space\n");
+ print($wh "memo $artid\,news.pl: read,$server\n");
+ }
+ chomp; s/\t/ /g;
+ /^-- / and do {
+ last if (!$showall and !Irssi::settings_get_bool('news_show_signature'));
+ $bodycolor = $colors[6], $usecolors = 0 if $usecolors;
+ };
+ unless ($head) {
+ /^$/ and next if (!$showall and $strip++);
+ /^..*$/ and $strip = 0;
+ if ($usecolors) {
+ $_ =~ /^[>| ]+/;
+ my $prefix = $&; $prefix =~ s/ //g;
+ $bodycolor = ($_ =~ /^[>]+/) ? $colors[(((length($prefix)-1) %5)+1)] : $colors[0];
+ }
+ print($wh "article_body \003$bodycolor$_\n");
+ next;
+ }
+ /^$/ and print($wh "space\n"), $head = 0, next;
+ my ($header, $text) = split(/: /, $_, 2);
+ print($wh "article_header $header $text\n") if ($showall or $show_headers =~ /\b$header\b/i);
+ }
+ print($wh "article_notexist $server $artid\n") unless ($idx);
+ print($wh "space\n") unless ($strip);
+ }
+
+ END: print($wh "close\n");
+ close($wh);
+ POSIX::_exit(1);
+};
+
+sub memo {
+ my ($text, $who, $where) = @_;
+ G: while ($text =~ /<[A-Za-z0-9\S]+\@[A-Za-z0-9\S]+>/g)
+ {
+ my $artid = $&;
+ foreach my $array (@articles) { goto G if ($artid eq $array->[0]); }
+ unshift @articles, [$artid, $who, $where];
+ }
+ $#articles = 9 if ($#articles > 9);
+}
+
+sub news_fork {
+ my $rh = shift;
+ while (<$rh>)
+ {
+ chomp;
+ /^close/ and last;
+ /^memo / and memo(split(",", $', 3)), next;
+ my ($theme, @args) = split / +/, $_, 5;
+ my $window = Irssi::window_find_name($news_window_name);
+ $window = Irssi::active_win() unless $window;
+ $window->printformat(MSGLEVEL_CLIENTCRAP, 'news_' . $theme, @args);
+ }
+
+ Irssi::input_remove($pipe_tag{$rh});
+ close($rh);
+}
+
+Irssi::signal_add_last 'message private' => sub { memo($_[1], $_[2], $_[3]); };
+Irssi::signal_add_last 'message public' => sub { memo($_[1], $_[2], $_[4]); };
+Irssi::signal_add_last 'dcc chat message' => sub { memo($_[1], $_[0]->{nick}, "chat"); };
+
+Irssi::theme_register([
+ 'news_server_unknown', 'NNTP %_server unknown%_ or not defined, use: /set news_nntp_server [server], to set it',
+ 'news_server_bad', '%_Bad%_ NNTP server {hilight $0} (bad hostname or addres)',
+ 'news_port_unknown', '%_NNTP port%_ unknown or not defined, use: /set news_nntp_port [port], to set it',
+ 'news_missing_argument', 'Missing argument, usage: $0-',
+ 'news_unknown_argument', 'Unknown argument \'$0\', usage: $1-',
+ 'news_server_connecting', 'Connecting to {hilight $0} on port {hilight $1}, wait...',
+ 'news_not_connected', '%_Cannot connect%_ to NNTP server $0 on port $1',
+ 'news_connected', '%_Connected%_; $0-',
+ 'news_article_unknown', 'Unknown message-id {hilight $0}',
+ 'news_article_notexist', 'No article {hilight $1} on $0',
+ 'news_article_request', 'Sending query about article {hilight $1} to $0, wait...',
+ 'news_article_body', '$0-',
+ 'news_article_header', '%c$0:%n %_$1-%_',
+ 'news_group_missing', 'Missing argument: newsgroup, usage: $0-',
+ 'news_listgroup_request', 'Looking for %_new articles%_ in {hilight $1}, wait...',
+ 'news_listgroup_error', 'Listgroup result: $1-',
+ 'news_listgroup_num', '$1 articles in group $0; fetching headers (max in $2 articles), wait...',
+ 'news_listgroup_header', '%c$0:%n $1-',
+ 'news_listgroup_yes', 'Count > 10 ($0). Doing this is not a good idea. Add -YES option to command if you really mean it',
+ 'news_no_artids', 'Sorry, list of logged message-id\'s is empty :/',
+ 'news_cannot_fork', 'Cannot fork process',
+ 'news_artid_show', '[%_$[!-2]0%_] article %c$1%n [by {hilight $2} ($3-)]',
+ 'news_unknown_artid', 'Article {hilight $0} not found, type /article -L, to displays list of logged message-id\'s',
+ 'news_space', ' '
+]);
+
+# registering settings
+Irssi::settings_add_bool('misc', 'news_use_news_window', 1);
+Irssi::settings_add_str('misc', 'news_nntp_server', $nntp_server);
+Irssi::settings_add_int('misc', 'news_nntp_port', $nntp_port);
+Irssi::settings_add_str('misc', 'news_show_headers', $default_headers.' subject message-id date lines content-transfer-encoding');
+Irssi::settings_add_bool('misc', 'news_show_signature', 1);
+Irssi::settings_add_bool('misc', 'news_use_body_colors', 1);
+Irssi::settings_add_bool('misc', 'news_use_auth', 0);
+Irssi::settings_add_str('misc', 'news_auth_user', '');
+Irssi::settings_add_str('misc', 'news_auth_password', '');
+Irssi::settings_add_int('misc', 'news_check_count', $check_count);
diff --git a/scripts/newsline.pl b/scripts/newsline.pl
new file mode 100644
index 0000000..b37cfcc
--- /dev/null
+++ b/scripts/newsline.pl
@@ -0,0 +1,453 @@
+# by Stefan "tommie" Tomanek
+#
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '2017040101';
+%IRSSI = (
+ authors => 'Stefan \'tommie\' Tomanek',
+ contact => 'stefan@pico.ruhr.de',
+ name => 'Newsline',
+ description => 'brings various newstickers to Irssi (Slashdot, Freshmeat, Heise etc.)',
+ license => 'GPLv2',
+ changed => $VERSION,
+ modules => 'Data::Dumper XML::RSS LWP::UserAgent Unicode::String Text::Wrap',
+ depends => 'openurl',
+ sbitems => 'newsline_ticker',
+ commands => 'newsline'
+);
+
+use Irssi 20020324;
+use Irssi::TextUI;
+
+use Data::Dumper;
+use XML::RSS;
+use LWP::UserAgent;
+use POSIX;
+use Unicode::String qw(utf8 latin1);
+use Text::Wrap;
+
+use vars qw(@ticker $timestamp $slide $index $timer_cycle $timer_update %sites $forked);
+
+$index = 0;
+# Just to have some data for the first startup
+%sites = ( Heise=>{page => 'http://www.heise.de/newsticker/heise.rdf', enable => 1, title=>'', description=>'', maxnews=>0},
+ 'Freshmeat'=>{'page' => 'http://freshmeat.net/backend/fm.rdf', 'enable' => 1, title=>'', description=>'', maxnews=>0}
+);
+
+sub show_help() {
+ my $help = "newsline $VERSION
+/newsline
+ List the downloaded headlines
+/newsline <number>
+ Open the entry indicated by <number> via openurl.
+ Openurl.pl is available at http://irssi.org/scripts/.
+/newsline description <number>
+ Display a brief summary of the article if available
+/newsline paste <number>
+ Write the headline and link to the current channel or query,
+ add 'description' to a diplay the description as well
+/newsline fetch
+ Retrieve new data from all enabled sources
+/newsline reload
+ Reload configuration and sites
+/newsline save
+ Save configration to ~/.irssi/newsline_sites
+/newsline list
+ List all available sources
+/newsline toggle <Source>
+ Enable or disable the source
+/newsline add <name> <url-to-rdf>
+ Add a new source
+";
+ my $text='';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP &draw_box("Newsline", $text, "newsline help", 1);
+}
+
+sub fork_get() {
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ return if $forked;
+ $forked = 1;
+ my $pid = fork();
+ if ($pid > 0) {
+ close $wh;
+ Irssi::pidwait_add($pid);
+ my $pipetag;
+ my @args = ($rh, \$pipetag);
+ $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
+ } else {
+ my (%siteinfo, @items);
+ eval {
+ foreach (sort keys %sites) {
+ eval {
+ my $site = $sites{$_};
+ next unless $site->{'enable'};
+ my $maxnews = -1;
+ $maxnews = $site->{maxnews} if defined $site->{maxnews};
+ my $url = $site->{'page'};
+ my $ua = LWP::UserAgent->new(env_proxy=>1, keep_alive=>1, timeout=>30);
+ my $request = HTTP::Request->new('GET', $url);
+ #$request->if_modified_since($timestamp) if $timestamp;
+ my $response = $ua->request($request);
+ if ($response->is_success) {
+ my $data = $response->content();
+ ### FIXME I hate myself for this :)
+ $data =~ s/encoding="ISO-8859-15"/encoding="ISO-8859-1"/i;
+ my $rss = new XML::RSS();
+ $rss->parse($data);
+ my $title = $rss->{channel}->{title};
+ my $description = de_umlaut($rss->{channel}->{description});
+ my $link = de_umlaut($rss->{channel}->{link});
+ $siteinfo{$_} = {title=>$title, description=>$description, link=>$link};
+ foreach my $item (@{$rss->{items}}) {
+ next unless defined($item->{title}) && defined($item->{'link'});
+ my $title = de_umlaut($item->{title});
+ $title =~ s/\n/ /g;
+ my %story = ('title' => $title, 'link' => $item->{link}, 'source' => $_);
+ $story{description} = de_umlaut($item->{description}) if $item->{description};
+ push @items, \%story;
+ $maxnews--;
+ last if $maxnews == 0;
+ }
+ };
+ }
+ }
+ my %result = (news=>\@items, siteinfo=>\%siteinfo);
+ my $dumper = Data::Dumper->new([\%result]);
+ $dumper->Purity(1)->Deepcopy(1);
+ my $data = $dumper->Dump;
+ print($wh $data);
+ };
+ close($wh);
+ POSIX::_exit(1);
+ }
+}
+
+sub pipe_input {
+ my ($rh, $pipetag) = @{$_[0]};
+ my $text;
+ $text .= $_ foreach (<$rh>);
+ close($rh);
+ Irssi::input_remove($$pipetag);
+ return unless($text);
+ no strict;
+ my %result = %{ eval "$text" };
+ my @items = @{$result{news}};
+ my %siteinfo = %{$result{siteinfo}};
+ @ticker = @items;
+ foreach (sort keys %siteinfo) {
+ $sites{$_}->{title} = $siteinfo{$_}->{title};
+ $sites{$_}->{description} = $siteinfo{$_}->{description};
+ $sites{$_}->{link} = $siteinfo{$_}->{link};
+ }
+ $forked = 0;
+}
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub cmd_newsline ($$$) {
+ my ($args, $server, $witem) = @_;
+ $args =~ s/^\ +//;
+ my @arg = split(/\ +/, $args);
+ if (scalar(@arg) == 0) {
+ show_ticker(@ticker);
+ } elsif ($arg[0] eq 'paste') {
+ # paste tickernews
+ shift(@arg);
+ my $desc = 0;
+ if (defined $arg[0] && $arg[0] eq 'description') {
+ $desc = 1;
+ shift(@arg);
+ }
+ foreach (@arg) {
+ if (defined $ticker[$_-1]) {
+ my $message = $ticker[$_-1]->{'title'};
+ my $text = '['.$ticker[$_-1]->{'source'}.'] "'.$message.'" -> '.$ticker[$_-1]->{'link'};
+ $Text::Wrap::columns = 50;
+ my $article = wrap("","",$ticker[$_-1]->{description}) if ($desc && defined $ticker[$_-1]->{description});
+ my $text2 = draw_box($message, $article, $ticker[$_-1]->{source}, 0) if (defined $article);
+ if (($witem) and (($witem->{type} eq "CHANNEL") or ($witem->{type} eq "QUERY"))) {
+ $witem->command("MSG ".$witem->{name}." ".$text);
+ if (defined $text2) {
+ $witem->command("MSG ".$witem->{name}." ".$_) foreach (split /\n/, $text2);
+ }
+ }
+ }
+ }
+ } elsif ($arg[0] eq 'description') {
+ shift(@arg);
+ foreach (@arg) {
+ next unless defined $ticker[$_-1] and defined $ticker[$_-1]->{description};
+ $Text::Wrap::columns = 50;
+ my $filter = $ticker[$_-1]->{description};
+ $filter =~ s/<.*?>//g;
+ my $article = wrap("", "", $filter);
+ my $text = '';
+ print CLIENTCRAP draw_box($ticker[$_-1]->{title}, $article, $ticker[$_-1]->{source}, 1);
+ }
+ } elsif ($arg[0] eq 'help') {
+ show_help();
+ } elsif ($arg[0] eq 'fetch') {
+ fork_get()
+ } elsif ($arg[0] eq 'reload') {
+ reload_config();
+ } elsif ($arg[0] eq 'save') {
+ save_config();
+ } elsif ($arg[0] eq 'add') {
+ if (defined($arg[1]) && defined($arg[2])) {
+ my $source = $arg[1];
+ my $page = $arg[2];
+ $sites{$source} = {page => $page, enable => 1, maxnews=>0};
+ print CLIENTCRAP '%R>>%n Added new source "'.$arg[1].'"';
+ $timestamp = undef;
+ }
+ } elsif ($arg[0] eq 'delete') {
+ if (defined $arg[1] && defined $sites{$arg[1]}) {
+ delete $sites{$arg[1]};
+ print CLIENTCRAP "%R>>%n ".$arg[1]." deleted";
+ }
+ } elsif ($arg[0] eq 'toggle') {
+ # Toggle site
+ if (defined $arg[1] && defined $sites{$arg[1]}) {
+ if ($sites{$arg[1]}{'enable'} == 0) {
+ $sites{$arg[1]}{'enable'} = 1;
+ print CLIENTCRAP "%R>>%n ".$arg[1]." enabled";
+ } else {
+ $sites{$arg[1]}{'enable'} = 0;
+ print CLIENTCRAP "%R>>%n ".$arg[1]." disabled";
+ }
+ }
+ } elsif ($arg[0] eq 'limit') {
+ if (defined $arg[1] && defined $sites{$arg[1]}) {
+ if (defined $arg[2] && $arg[2] =~ /\d+/) {
+ $sites{$arg[1]}{'maxnews'} = $arg[2];
+ print CLIENTCRAP "%R>>%n ".$arg[1]." limited to ".$arg[2]." articles";
+ }
+ }
+ } elsif ($arg[0] eq 'list') {
+ my $text = "";
+ foreach (sort keys %sites) {
+ my %site = %{$sites{$_}};
+ $text .= "%9[".$_.']%9'."\n";
+ $text .= " %9|-[page ]->%9 ".$site{'page'}."\n";
+ #$text .= " %9|-[desc ]->%9 ".$site{'description'}."\n" if defined $site{'description'};
+ $Text::Wrap::columns = 60;
+ my $filter = $site{'description'};
+ $filter =~ s/<.*?>//;
+ my $desc = wrap(" %9|-[desc ]->%9 ",' %9|%9<tab>', $filter);
+ $desc =~ s/<tab>/ /g;
+ $text .= $desc."\n" if $site{'description'};
+ $text .= " %9|-[limit ]->%9 ".$site{'maxnews'}."\n";
+ $text .= " %9`-[enable]->%9 ".$site{'enable'}."\n";
+ }
+ print CLIENTCRAP draw_box("Newsline", $text, "newsline sources", 1);
+
+ } else {
+ foreach (@arg) {
+ if (defined $sites{$_}) {
+ call_openurl($sites{$_}->{'link'}) if defined $sites{$_}->{'link'};
+ } elsif (/\d+/ && defined $ticker[$_-1]) {
+ call_openurl($ticker[$_-1]->{'link'});
+ }
+ }
+ }
+}
+
+sub show_ticker (@) {
+ my (@ticker) = @_;
+ my $i = 1;
+ my $text = '';
+ foreach (@ticker) {
+ my $space = ' 'x(length(scalar(@ticker))-length($i));
+ my $newsitem = '%r'.$space.$i.'->%n['.$$_{source}.'] %9'.$$_{title}.'%9';
+ $newsitem .= ' %9[*]%9' if defined($$_{description});
+ $text .= $newsitem."\n";
+ $text .= " %B`->%n%U".$$_{link}."%U \n" if Irssi::settings_get_bool('newsline_show_url');
+ $i++;
+ }
+ print CLIENTCRAP draw_box("Newsline", $text, "headlines", 1);
+}
+
+sub call_openurl ($) {
+ my ($url) = @_;
+ no strict "refs";
+ # check for a loaded openurl
+ if (my $code = Irssi::Script::openurl::->can('launch_url')) {
+ $code->($url);
+ } else {
+ print CLIENTCRAP "%R>>%n Please install openurl.pl";
+ }
+ use strict "refs";
+}
+sub newsline_ticker ($$) {
+ my ($item, $get_size_only) = @_;
+ if (Irssi::settings_get_bool('newsline_ticker_scroll')) {
+ draw_tape($item, $get_size_only);
+ } else {
+ draw_ticker($item, $get_size_only);
+ }
+}
+
+sub draw_ticker ($$) {
+ my ($item, $get_size_only) = @_;
+ if ($index >= scalar(@ticker)) {
+ $index = 0
+ }
+ my $tape;
+ $tape .= '%F%Y<Fetching>%n' if $forked;
+ if (scalar(@ticker) > 0) {
+ my $title = $ticker[$index]->{'title'};
+ my $source = $ticker[$index]->{'source'};
+ $tape .= '>'.($index+1).': ['.$source.'] '.$title;
+ $tape .= ' [*]' if defined($ticker[$index]->{description});
+ $tape .= '<';
+ } else {
+ $tape .= '>Enter "/newsline fetch" to retrieve tickerdata>' unless $forked;
+ }
+ $tape = substr($tape, 0, Irssi::settings_get_int('newsline_ticker_max_width'));
+ my $format = "{sb ".$tape."}";
+ $item->{min_size} = $item->{max_size} = length($tape)+2;
+ $item->default_handler($get_size_only, $format, 0, 1);
+}
+
+sub rotate ($$) {
+ my ($text, $rot) = @_;
+ return($text) if length($text) < 1;
+ for (0..$rot) {
+ my $letter = substr($text, 0, 1);
+ $text = substr($text, 1);
+ $text = $text.$letter;
+ }
+ return($text);
+}
+
+sub draw_tape ($$) {
+ my ($item, $get_size_only) = @_;
+ my $tape;
+ if (scalar(@ticker) > 0) {
+ my $i=1;
+ foreach (@ticker) {
+ my $title = $_->{'title'};
+ my $source = $_->{'source'};
+ $tape .= '>'.($i).': ['.$source.'] '.$title.'|';
+ $i++;
+ }
+ $tape = $tape;
+ $slide = 0 if $slide >= length($tape);
+ $tape = rotate($tape, $slide);
+ $tape = substr($tape, 0, Irssi::settings_get_int('newsline_ticker_max_width'));
+ } else {
+ $tape .= 'Use "/newsline -f" to fetch tickerdata';
+ }
+ my $format = "{sb ".$tape."}";
+ $item->{min_size} = $item->{max_size} = length($tape)+2;
+ $item->default_handler($get_size_only, $format, 0, 1);
+}
+
+sub cycle_ticker () {
+ $index++;
+ if ($index >= scalar(@ticker)) {
+ $index = 0
+ }
+ $slide++;
+ Irssi::statusbar_items_redraw('newsline_ticker');
+}
+
+sub update_ticker () {
+ fork_get();
+}
+
+sub reload_config() {
+ my $filename = Irssi::settings_get_str('newsline_sites_file');
+ my $text;
+ if (-e $filename) {
+ local *F;
+ open F, "<",$filename;
+ $text .= $_ foreach (<F>);
+ close F;
+ if ($text) {
+ no strict;
+ my %pages = %{ eval "$text" };
+ if (%pages) {
+ %sites = ();
+ foreach (keys %pages) {
+ $sites{$_} = $pages{$_};
+ }
+ }
+ }
+ }
+ Irssi::timeout_remove($timer_cycle) if defined $timer_cycle;
+ Irssi::timeout_remove($timer_update) if defined $timer_update;
+ $timer_cycle = Irssi::timeout_add(Irssi::settings_get_int('newsline_ticker_cycle_delay'), 'cycle_ticker', undef) if Irssi::settings_get_int('newsline_ticker_cycle_delay') > 0;
+ $timer_update = Irssi::timeout_add(Irssi::settings_get_int('newsline_fetch_interval')*1000, 'update_ticker', undef) if Irssi::settings_get_int('newsline_fetch_interval') > 0;
+ Irssi::statusbar_items_redraw('newsline_ticker');
+ print CLIENTCRAP '%R>>%n Newsline sites loaded from '.$filename;
+}
+
+sub save_config() {
+ local *F;
+ my $filename = Irssi::settings_get_str('newsline_sites_file');
+ open(F, '>',$filename);
+ my $dumper = Data::Dumper->new([\%sites], ['sites']);
+ $dumper->Purity(1)->Deepcopy(1);
+ my $data = $dumper->Dump;
+ print (F $data);
+ close(F);
+ print CLIENTCRAP '%R>>%n Newsline sites saved to '.$filename;
+}
+
+sub de_umlaut ($) {
+ my ($data) = @_;
+ Unicode::String->stringify_as('utf8');
+ my $s = new Unicode::String($data);
+ my $result = $s->latin1();
+ return($result);
+}
+
+sub sig_complete_word ($$$$$) {
+ my ($list, $window, $word, $linestart, $want_space) = @_;
+ return unless $linestart =~ /^.newsline (toggle|delete|add|limit)/;
+ foreach (keys %sites) {
+ push @$list, $_ if /^(\Q$word\E.*)?$/;
+ }
+ Irssi::signal_stop();
+}
+
+Irssi::signal_add_first('complete word', \&sig_complete_word);
+Irssi::signal_add('setup saved', \&save_config);
+
+Irssi::command_bind('newsline', \&cmd_newsline);
+foreach my $cmd ('description', 'paste', 'paste description', 'fetch', 'reload', 'save', 'list', 'toggle', 'add', 'delete', 'help', 'limit') {
+ Irssi::command_bind('newsline '.$cmd =>
+ sub { cmd_newsline("$cmd ".$_[0], $_[1], $_[2]); } );
+}
+
+Irssi::settings_add_int($IRSSI{'name'}, 'newsline_fetch_interval', 600);
+
+Irssi::settings_add_int($IRSSI{'name'}, 'newsline_ticker_max_width', 50);
+
+Irssi::settings_add_int($IRSSI{'name'}, 'newsline_ticker_cycle_delay', 3000);
+Irssi::settings_add_str($IRSSI{'name'}, 'newsline_sites_file', Irssi::get_irssi_dir()."/newsline_sites");
+Irssi::settings_add_bool($IRSSI{'name'}, 'newsline_show_url', 1);
+Irssi::settings_add_bool($IRSSI{'name'}, 'newsline_ticker_scroll', 0);
+
+Irssi::statusbar_item_register('newsline_ticker', 0, 'newsline_ticker');
+
+reload_config();
+update_ticker();
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /newsline help for help';
diff --git a/scripts/nickban.pl b/scripts/nickban.pl
new file mode 100644
index 0000000..e1a134d
--- /dev/null
+++ b/scripts/nickban.pl
@@ -0,0 +1,66 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.2";
+%IRSSI = (
+ authors => "Roeland 'Trancer' Nieuwenhuis",
+ contact => "irssi\@trancer.nl",
+ name => "nickban",
+ description => "A simple nick banner. If it encounters a nick it bans its host",
+ license => "Public Domain"
+);
+
+use Irssi;
+
+# The channels the nicks are banned on (on which this script is active)
+my @channels;
+
+# The banned nicks
+my @nicks;
+
+# Your kickreason
+my $kickreason;
+
+sub nick_banner {
+
+ my($server, $channel, $nick, $address) = @_;
+
+ # Are we opped?
+ return unless $server->channel_find($channel)->{chanop};
+
+ # If the nick is a server, stop it.
+ return if $nick eq $server->{nick};
+
+ # Is the user a banned nick?
+ my $nono = 0;
+ foreach (@nicks) { $nono = 1 if lc($nick) eq lc($_) }
+ return unless $nono;
+
+ # Is the user on one of the banned channels?
+ my $react = 0;
+ foreach (@channels) { $react = 1 if lc($channel) eq lc($_) }
+ return unless $react;
+
+ # User voiced or op'd?
+ # Pretty useless, but ok
+ return if $server->channel_find($channel)->nick_find($nick)->{op} || $server->channel_find($channel)->nick_find($nick)->{voice};
+
+ $server->command("kickban $channel $nick $kickreason");
+ Irssi::print("Nick banning $nick on $channel. Banned.");
+}
+
+sub sig_setup_changed {
+ @channels = split(/\s+/,Irssi::settings_get_str($IRSSI{name}.'_channels'));
+ @nicks = split(/\s+/,Irssi::settings_get_str($IRSSI{name}.'_nicks'));
+ $kickreason = Irssi::settings_get_str($IRSSI{name}.'_reason');
+}
+
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_channels', '#worldchat #chat-world #php');
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_nicks', 'evildude evilgirl');
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_reason', "Not welcome here.");
+
+Irssi::signal_add_last('message join', 'nick_banner');
+Irssi::signal_add('setup changed', 'sig_setup_changed');
+
+sig_setup_changed();
+
+# vim:set ts=4 sw=4 expandtab:
diff --git a/scripts/nickcolor_expando.pl b/scripts/nickcolor_expando.pl
new file mode 100644
index 0000000..60d9c9f
--- /dev/null
+++ b/scripts/nickcolor_expando.pl
@@ -0,0 +1,1065 @@
+use strict;
+use warnings;
+
+our $VERSION = '0.4.0'; # c274f630aff9967
+our %IRSSI = (
+ authors => 'Nei',
+ name => 'nickcolor_expando',
+ description => 'colourise nicks',
+ license => 'GPL v2',
+ );
+
+# inspired by bc-bd's nm.pl and mrwright's nickcolor.pl
+
+# Usage
+# =====
+# after loading the script, add the colour expando to the format
+# (themes' abstracts are not supported)
+#
+# /format pubmsg {pubmsgnick $2 {pubnick $nickcolor$0}}$1
+#
+# alternatively, use it together with nm2 script
+
+# Options
+# =======
+# /set neat_colors <list of colours>
+# * the list of colours for automatic colouring (you can edit it more
+# conveniently with /neatcolor colors)
+#
+# /set neat_ignorechars <regex>
+# * regular expression of characters to remove from nick before
+# calculating the hash function
+#
+# /set neat_color_reassign_time <time>
+# * if the user has not spoken for so long, the assigned colour is
+# forgotten and another colour may be picked next time the user
+# speaks
+#
+# /set neat_global_colors <ON|OFF>
+# * more strongly prefer one global colour per nickname regardless of
+# channel
+
+# Commands
+# ========
+# /neatcolor
+# * show the current colour distribution of nicks
+#
+# /neatcolor set [<network>/<#channel>] <nick> <colour>
+# * set a fixed colour for nick
+#
+# /neatcolor reset [<network>/<#channel>] <nick>
+# * remove a set colour of nick
+#
+# /neatcolor get [<network>/<#channel>] <nick>
+# * query the current or set colour of nick
+#
+# /neatcolor re [<network>/<#channel>] <nick>
+# * force change the colour of nick to a random other colour (to
+# manually resolve clashes)
+#
+# /neatcolor save
+# * save the colours to ~/.irssi/saved_nick_colors
+#
+# /neatcolor reset --all
+# * re-set all colours
+#
+# /neatcolor colors
+# * show currently configured colours, in colour
+#
+# /neatcolor colors add <list of colours>
+# /neatcolor colors remove <list of colours>
+# * add or remove these colours from the neat_colors setting
+
+
+sub cmd_help_neatcolor {
+ print CLIENTCRAP <<HELP
+%9Syntax:%9
+
+NEATCOLOR
+NEATCOLOR SET [<network>/<#channel>] <nick> <colour>
+NEATCOLOR RESET [<network>/<#channel>] <nick>
+NEATCOLOR GET [<network>/<#channel>] <nick>
+NEATCOLOR RE [<network>/<#channel>] <nick>
+NEATCOLOR SAVE
+NEATCOLOR RESET --all
+NEATCOLOR COLORS
+NEATCOLOR COLORS ADD <list of colours>
+NEATCOLOR COLORS REMOVE <list of colours>
+
+%9Parameters:%9
+
+ SET: set a fixed colour for nick
+ RESET: remove a set colour of nick
+ GET: query the current or set colour of nick
+ RE: force change the colour of nick to a random other
+ colour (to manually resolve clashes)
+ SAVE: save the colours to ~/.irssi/saved_nick_colors
+ RESET --all: re-set all colours
+ COLORS: show currently configured colours, in colour
+ COLORS ADD/REMOVE: add or remove these colours from the
+ neat_colors setting
+
+ If no parameters are given, the current colour distribution of
+ nicks is shown.
+
+%9Description:%9
+
+ Manages nick based colouring
+
+HELP
+}
+
+use Hash::Util qw(lock_keys);
+use Irssi;
+
+
+{ package Irssi::Nick }
+
+my @action_protos = qw(irc silc xmpp);
+my (%set_colour, %avoid_colour, %has_colour, %last_time, %netchan_hist);
+my ($expando, $iexpando, $ignore_re, $ignore_setting, $global_colours, $retain_colour_time, @colours, $exited, $session_load_time);
+($expando, $iexpando) = ('', ''); # Initialise to empty
+
+# the numbers for the scoring system, highest colour value will be chosen
+my %scores = (
+ set => 200,
+ keep => 5,
+ global => 4,
+ hash => 3,
+
+ avoid => -20,
+ hist => -10,
+ used => -2,
+ );
+lock_keys(%scores);
+
+my $history_lines = 40;
+my $global_mode = 1; # start out with global nick colour
+
+my @colour_bags = (
+ [qw[20 30 40 50 04 66 0C 61 60 67 6L]], # RED
+ [qw[37 3D 36 4C 46 5C 56 6C 6J 47 5D 6K 6D 57 6E 5E 4E 4K 4J 5J 4D 5K 6R]], # ORANGE
+ [qw[3C 4I 5I 6O 6I 06 4O 5O 3U 0E 5U 6U 6V 6P 6Q 6W 5P 4P 4V 4W 5W 4Q 5Q 5R 6Y 6X]], # YELLOW
+ [qw[26 2D 2C 3I 3O 4U 5V 2J 3V 3P 3J 5X]], # YELLOW-GREEN
+ [qw[16 1C 2I 2U 2O 1I 1O 1V 1P 02 0A 1U 2V 4X]], # GREEN
+ [qw[1D 1J 1Q 1W 1X 2Y 2S 2R 3Y 3Z 3S 3R 2K 3K 4S 5Z 5Y 4R 3Q 2Q 2X 2W 3X 3W 2P 4Y]], # GREEN-TURQUOIS
+ [qw[17 1E 1L 1K 1R 1S 03 1M 1N 1T 0B 1Y 1Z 2Z 4Z]], # TURQUOIS
+ [qw[28 2E 18 1F 19 1G 1A 1B 1H 2N 2H 09 3H 3N 2T 3T 2M 2G 2A 2F 2L 3L 3F 4M 3M 3G 29 4T 5T]], # LIGHT-BLUE
+ [qw[11 12 23 25 24 13 14 01 15 2B 4N]], # DARK-BLUE
+ [qw[22 33 44 0D 45 5B 6A 5A 5H 3B 4H 3A 4G 39 4F 6S 6T 5L 5N]], # VIOLET
+ [qw[21 32 42 53 63 52 43 34 35 55 65 6B 4B 4A 48 5G 6H 5M 6M 6N]], # PINK
+ [qw[38 31 05 64 54 41 51 62 69 68 59 5F 6F 58 49 6G]], # ROSE
+ [qw[7A 00 10 7B 7C 7D 7E 7G 7F]], # DARK-GRAY
+ [qw[7H 7I 27 7K 7J 08 7L 3E 7O 7Q 7N 7M 7P]], # GRAY
+ [qw[7S 7T 7R 4L 7W 7U 7V 5S 07 7X 6Z 0F]], # LIGHT-GRAY
+ );
+my %colour_bags;
+{ my $idx = 0;
+ for my $bag (@colour_bags) {
+ @colour_bags{ @$bag } = ($idx)x@$bag;
+ }
+ continue {
+ ++$idx;
+ }
+}
+my @colour_list = map { @$_ } @colour_bags;
+my @bases = split //, 'kbgcrmywKBGCRMYW04261537';
+my %base_map = map { $bases[$_] => sprintf '%02X', ($_ % 0x10) } 0..$#bases;
+my %ext_to_base_map = map { (sprintf '%02X', $_) => $bases[$_] } 0..15;
+
+sub expando_neatcolour {
+ return $expando;
+}
+
+sub expando_neatcolour_inv {
+ return $iexpando;
+}
+
+# one-at-a-time hash
+sub simple_hash {
+ use integer;
+ my $hash = 0x5065526c + length $_[0];
+ for my $ord (unpack 'U*', $_[0]) {
+ $hash += $ord;
+ $hash += $hash << 10;
+ $hash &= 0xffffffff;
+ $hash ^= $hash >> 6;
+ }
+ $hash += $hash << 3;
+ $hash &= 0xffffffff;
+ $hash ^= $hash >> 11;
+ $hash = $hash + ($hash << 15);
+ $hash &= 0xffffffff;
+}
+
+{ my %lut1;
+ my @z = (0 .. 9, 'A' .. 'Z');
+ for my $x (16..255) {
+ my $idx = $x - 16;
+ my $col = 1+int($idx / @z);
+ $lut1{ $col . @z[(($col > 6 ? 10 : 0) + $idx) % @z] } = $x;
+ }
+ for my $idx (0..15) {
+ $lut1{ (sprintf "%02X", $idx) } = ($idx&8) | ($idx&4)>>2 | ($idx&2) | ($idx&1)<<2;
+ }
+
+ sub debug_ansicolour {
+ my ($col, $bg) = @_;
+ return '' unless defined $col && exists $lut1{$col};
+ $bg = $bg ? 48 : 38;
+ "\e[$bg;5;$lut1{$col}m"
+ }
+}
+sub debug_colour {
+ my ($col, $bg) = @_;
+ defined $col ? (debug_ansicolour($col, $bg) . $col . "\e[0m") : '(none)'
+}
+sub debug_score {
+ my ($score) = @_;
+ if ($score == 0) {
+ return $score
+ }
+ my @scale = $score > 0 ? (qw(16 1C 1I 1U 2V 4X)) : (qw(20 30 40 60 67 6L));;
+ my $v = (log 1+ abs $score)*(log 20);
+ debug_ansicolour($scale[$v >= $#scale ? -1 : $v], 1) . $score . "\e[0m"
+}
+sub debug_reused {
+ my ($netchan, $nick, $col) = @_;
+ my $chc = simple_hash($netchan);
+ my $hashcolour = @colours ? $colours[ $chc % @colours ] : 0;
+}
+sub debug_scores {
+ my ($netchan, $nick, $col, $prios, $colours) = @_;
+ my $inprogress;
+ unless (ref $prios) {
+ $inprogress = $prios;
+ $prios = [ sort { $colours->{$b} <=> $colours->{$a} } grep { exists $colours->{$_} } @colour_list ];
+ }
+ my $chc = simple_hash($netchan);
+ my $hashcolour = @colours ? $colours[ $chc % @colours ] : 0;
+ unless ($inprogress) {
+ }
+ else {
+ }
+ for my $i (0..$#$prios) {
+ }
+}
+
+sub colourise_nt {
+ my ($netchan, $nick, $weak) = @_;
+ my $time = time;
+
+ my $g_or_n = $global_colours ? '' : $netchan;
+
+ my $old_colour = $has_colour{$g_or_n}{$nick} // $has_colour{$netchan}{$nick};
+ my $last_time = $last_time{$g_or_n}{$nick} // $last_time{$netchan}{$nick};
+
+ my $keep_score = $weak ? $scores{keep} + $scores{set} : $scores{keep};
+
+ unless ($weak) {
+ $last_time{$netchan}{$nick}
+ = $last_time{''}{$nick} = $time;
+ }
+ else {
+ $last_time{$netchan}{$nick} ||= 0;
+ }
+
+ my $colour;
+ if (defined $old_colour && ($weak || (defined $last_time
+ && ($last_time + $retain_colour_time > $time
+ || ($last_time > 0 && grep { $_->[0] eq $nick } @{ $netchan_hist{$netchan} // [] }))))) {
+ $colour = $old_colour;
+ }
+ else {
+ # search for a suitable colour
+ my %colours = map { $_ => 0 } @colours;
+ my $hashnick = $nick;
+ $hashnick =~ s/$ignore_re//g if (defined $ignore_re && length $ignore_re);
+ my $hash = simple_hash($global_mode ? "/$hashnick" : "$netchan/$hashnick");
+
+ if (exists $set_colour{$netchan} && exists $set_colour{$netchan}{$nick}) {
+ $colours{ $set_colour{$netchan}{$nick} } += $scores{set};
+ }
+ elsif (exists $set_colour{$netchan} && exists $set_colour{$netchan}{$hashnick}) {
+ $colours{ $set_colour{$netchan}{$hashnick} } += $scores{set};
+ }
+ elsif (exists $set_colour{''} && exists $set_colour{''}{$nick}) {
+ $colours{ $set_colour{''}{$nick} } += $scores{set};
+ }
+ elsif (exists $set_colour{''} && exists $set_colour{''}{$hashnick}) {
+ $colours{ $set_colour{''}{$hashnick} } += $scores{set};
+ }
+
+ if (exists $avoid_colour{$netchan} && exists $avoid_colour{$netchan}{$nick}) {
+ for (@{ $avoid_colour{$netchan}{$nick} }) {
+ $colours{ $_ } += $scores{avoid} if exists $colours{ $_ };
+ }
+ }
+ elsif (exists $avoid_colour{$g_or_n} && exists $avoid_colour{$g_or_n}{$nick}) {
+ for (@{ $avoid_colour{$g_or_n}{$nick} }) {
+ $colours{ $_ } += $scores{avoid} if exists $colours{ $_ };
+ }
+ }
+
+ if (defined $old_colour) {
+ $colours{$old_colour} += $keep_score
+ if exists $colours{$old_colour};
+ }
+ elsif (exists $has_colour{''}{$nick}) {
+ $colours{ $has_colour{''}{$nick} } += $scores{global}
+ if exists $colours{ $has_colour{''}{$nick} };
+ }
+
+ if (@colours) {
+ my $hashcolour = $colours[ $hash % @colours ];
+ if (!defined $old_colour || $hashcolour ne $old_colour) {
+ $colours{ $hashcolour } += $scores{hash};
+ }
+ }
+
+ { my @netchans = $global_mode ? keys %has_colour : $netchan;
+ my $total;
+ my %colour_pens;
+ for my $gnc (@netchans) {
+ for my $onick (keys %{ $has_colour{$gnc} }) {
+ next if $gnc ne $netchan && exists $has_colour{$netchan}{$onick};
+ next unless exists $last_time{$gnc}{$onick};
+ if ($last_time{$gnc}{$onick} + $retain_colour_time > $time # XXX
+ || ($last_time{$gnc}{$onick} == 0 && $session_load_time + $retain_colour_time > $time)) {
+ if (exists $colours{ $has_colour{$gnc}{$onick} }) {
+ $colour_pens{ $has_colour{$gnc}{$onick} } += $scores{used};
+ ++$total;
+ }
+ }
+ }
+ }
+ for (keys %colour_pens) {
+ $colours{ $_ } += $colour_pens{ $_ } / $total * @colours
+ if @colours;
+ }
+ }
+
+ { my $fac = 1;
+ for my $gnetchan ($netchan, '') {
+ my $idx = exp(-log($history_lines)/$scores{hist});
+ for my $hent (reverse @{ $netchan_hist{$gnetchan} // [] }) {
+ next unless defined $hent->[1];
+ if ($hent->[0] ne $nick) {
+ my $pen = 1;
+ $pen *= 3 if length $nick == length $hent->[0];
+ $pen *= 2 if (substr $nick, 0, 1) eq (substr $hent->[0], 0, 1)
+ || 1 == abs +(length $nick) - (length $hent->[0]);
+ $colours{ $hent->[1] } -= log($pen*$history_lines)/log($idx) / $fac
+ if exists $colours{ $hent->[1] };
+ }
+ ++$idx;
+ last if $idx > $history_lines;
+ }
+ ++$fac;
+ }
+ }
+
+ { my %bag_pens;
+ for my $co (keys %colours) {
+ $bag_pens{ $colour_bags{$co} } -= $colours{$co}/2 if $colours{$co} < 0;
+ }
+ for my $bag (keys %bag_pens) {
+ for my $co (@{ $colour_bags[$bag] }) {
+ $colours{$co} -= $bag_pens{$bag} / @colours
+ if @colours && exists $colours{$co};
+ }
+ }
+ }
+
+ my @prio_colours = sort { $colours{$b} <=> $colours{$a} } grep { exists $colours{$_} } @colour_list;
+ my $stop_at = 0;
+ while ($stop_at < $#prio_colours
+ && $colours{ $prio_colours[$stop_at] } <= $colours{ $prio_colours[$stop_at + 1] }) {
+ ++$stop_at;
+ }
+ $colour = $prio_colours[ $hash % ($stop_at + 1) ]
+ if @prio_colours;
+
+ }
+
+ unless ($weak) {
+ expire_hist($netchan, '');
+
+ my $ent = [$nick, $colour];
+ push @{ $netchan_hist{$netchan} }, $ent;
+ push @{ $netchan_hist{''} }, $ent;
+ }
+
+ defined $colour ? ($has_colour{$g_or_n}{$nick} = $has_colour{$netchan}{$nick} = $colour) : $colour
+}
+
+sub expire_hist {
+ for my $ch (@_) {
+ if ($netchan_hist{$ch}
+ && @{$netchan_hist{$ch}} > 2 * $history_lines) {
+ splice @{$netchan_hist{$ch}}, 0, $history_lines;
+ }
+ }
+}
+
+sub msg_line_tag {
+ my ($srv, $msg, $nick, $addr, $targ) = @_;
+ my $obj = $srv->channel_find($targ);
+ clear_ref(), return unless $obj;
+ my $nickobj = $obj->nick_find($nick);
+ $nick = $nickobj->{nick} if $nickobj;
+ my $colour = colourise_nt($srv->{tag}.'/'.$obj->{name}, $nick);
+ $expando = $colour ? format_expand('%X'.$colour) : '';
+ $iexpando = $colour ? format_expand('%x'.$colour) : '';
+}
+
+sub msg_line_tag_xmppaction {
+ clear_ref(), return unless @_;
+ my ($srv, $msg, $nick, $targ) = @_;
+ msg_line_tag($srv, $msg, $nick, undef, $targ);
+}
+
+sub msg_line_clear {
+ clear_ref();
+}
+
+sub prnt_clear_public {
+ my ($dest) = @_;
+ clear_ref() if $dest->{level} & MSGLEVEL_PUBLIC;
+}
+
+sub clear_ref {
+ $expando = '';
+ $iexpando = '';
+}
+
+sub nicklist_changed {
+ my ($chanobj, $nickobj, $old_nick) = @_;
+
+ my $netchan = $chanobj->{server}{tag}.'/'.$chanobj->{name};
+ my $nickstr = $nickobj->{nick};
+
+ if (!exists $has_colour{''}{$nickstr} && exists $has_colour{''}{$old_nick}) {
+ $has_colour{''}{$nickstr} = delete $has_colour{''}{$old_nick};
+ }
+ if (exists $has_colour{$netchan}{$old_nick}) {
+ $has_colour{$netchan}{$nickstr} = delete $has_colour{$netchan}{$old_nick};
+ }
+
+ $last_time{$netchan}{$nickstr}
+ = $last_time{''}{$nickstr} = time;
+
+ for my $old_ent (@{ $netchan_hist{$netchan} }) {
+ $old_ent->[0] = $nickstr if $old_ent->[0] eq $old_nick;
+ }
+
+}
+
+{
+ my %format2control = (
+ 'F' => "\cDa", '_' => "\cDc", '|' => "\cDe", '#' => "\cDi", "n" => "\cDg", "N" => "\cDg",
+ 'U' => "\c_", '8' => "\cV", 'I' => "\cDf",
+ );
+ my %bg_base = (
+ '0' => '0', '4' => '1', '2' => '2', '6' => '3', '1' => '4', '5' => '5', '3' => '6', '7' => '7',
+ 'x08' => '8', 'x09' => '9', 'x0a' => ':', 'x0b' => ';', 'x0c' => '<', 'x0d' => '=', 'x0e' => '>', 'x0f' => '?',
+ );
+ my %fg_base = (
+ 'k' => '0', 'b' => '1', 'g' => '2', 'c' => '3', 'r' => '4', 'm' => '5', 'p' => '5', 'y' => '6', 'w' => '7',
+ 'K' => '8', 'B' => '9', 'G' => ':', 'C' => ';', 'R' => '<', 'M' => '=', 'P' => '=', 'Y' => '>', 'W' => '?',
+ );
+ my @ext_colour_off = (
+ '.', '-', ',',
+ '+', "'", '&',
+ );
+ sub format_expand {
+ my $copy = $_[0];
+ $copy =~ s{%(Z.{6}|z.{6}|X..|x..|.)}{
+ my $c = $1;
+ if (exists $format2control{$c}) {
+ $format2control{$c}
+ }
+ elsif (exists $bg_base{$c}) {
+ "\cD/$bg_base{$c}"
+ }
+ elsif (exists $fg_base{$c}) {
+ "\cD$fg_base{$c}/"
+ }
+ elsif ($c =~ /^[{}%]$/) {
+ $c
+ }
+ elsif ($c =~ /^(z|Z)([[:xdigit:]]{2})([[:xdigit:]]{2})([[:xdigit:]]{2})$/) {
+ my $bg = $1 eq 'z';
+ my (@rgb) = map { hex $_ } $2, $3, $4;
+ my $x = $bg ? 0x1 : 0;
+ my $out = "\cD" . (chr -13 + ord '0');
+ for (my $i = 0; $i < 3; ++$i) {
+ if ($rgb[$i] > 0x20) {
+ $out .= chr $rgb[$i];
+ }
+ else {
+ $x |= 0x10 << $i; $out .= chr 0x20 + $rgb[$i];
+ }
+ }
+ $out .= chr 0x20 + $x;
+ $out
+ }
+ elsif ($c =~ /^(x)(?:0([[:xdigit:]])|([1-6])(?:([0-9])|([a-z]))|7([a-x]))$/i) {
+ my $bg = $1 eq 'x';
+ my $col = defined $2 ? hex $2
+ : defined $6 ? 232 + (ord lc $6) - (ord 'a')
+ : 16 + 36 * ($3 - 1) + (defined $4 ? $4 : 10 + (ord lc $5) - (ord 'a'));
+ if ($col < 0x10) {
+ my $chr = chr $col + ord '0';
+ "\cD" . ($bg ? "/$chr" : "$chr/")
+ }
+ else {
+ "\cD" . $ext_colour_off[($col - 0x10) / 0x50 + $bg * 3] . chr (($col - 0x10) % 0x50 - 1 + ord '0')
+ }
+ }
+ else {
+ "%$c"
+ }
+ }ge;
+ $copy
+ }
+}
+
+sub save_colours {
+ open my $fid, '>', Irssi::get_irssi_dir() . '/saved_nick_colors'
+ or do {
+ Irssi::print("Error saving nick colours: $!", MSGLEVEL_CLIENTERROR)
+ unless $exited;
+ return;
+ };
+
+ local $\ = "\n";
+ if (%set_colour) {
+ print $fid '[set]';
+ for my $netch (sort keys %set_colour) {
+ for my $nick (sort keys %{ $set_colour{$netch} }) {
+ print $fid "$netch/$nick:".$set_colour{$netch}{$nick};
+ }
+ }
+ print $fid '';
+ }
+ my $time = time;
+ print $fid '[session]';
+ my %session_colour;
+ for my $netch (sort keys %last_time) {
+ for my $nick (sort keys %{ $last_time{$netch} }) {
+ if (exists $has_colour{$netch} && exists $has_colour{$netch}{$nick}
+ && ($last_time{$netch}{$nick} + $retain_colour_time > $time
+ || ($last_time{$netch}{$nick} == 0 && $session_load_time + $retain_colour_time > $time)
+ || grep { $_->[0] eq $nick } @{ $netchan_hist{$netch} // [] })) {
+ $session_colour{$netch}{$nick} = $has_colour{$netch}{$nick};
+ if (exists $session_colour{''}{$nick}) {
+ if (defined $session_colour{''}{$nick}
+ && $session_colour{''}{$nick} ne $session_colour{$netch}{$nick}) {
+ $session_colour{''}{$nick} = undef;
+ }
+ }
+ else {
+ $session_colour{''}{$nick} = $session_colour{$netch}{$nick};
+ }
+ }
+ }
+ }
+ for my $nick (sort keys %{ $session_colour{''} }) {
+ if (defined $session_colour{''}{$nick}) {
+ print $fid "/$nick:".$session_colour{''}{$nick};
+ }
+ else {
+ for my $netch (sort keys %session_colour) {
+ print $fid "$netch/$nick:".$session_colour{$netch}{$nick}
+ if exists $session_colour{$netch}{$nick} && defined $session_colour{$netch}{$nick};
+ }
+ }
+ }
+
+ close $fid;
+}
+
+sub load_colours {
+ $session_load_time = time;
+
+ open my $fid, '<', Irssi::get_irssi_dir() . '/saved_nick_colors'
+ or return;
+ my $mode;
+ while (my $line = <$fid>) {
+ chomp $line;
+ if ($line =~ /^\[(.*)\]$/) {
+ $mode = $1;
+ next;
+ }
+
+ my $colon = rindex $line, ':';
+ next if $colon < 0;
+ my $slash = rindex $line, '/', $colon;
+ next if $slash < 0;
+ my $col = substr $line, $colon +1;
+ next unless length $col;
+ my $netch = substr $line, 0, $slash;
+ my $nick = substr $line, $slash +1, $colon-$slash -1;
+ if ($mode eq 'set') {
+ $set_colour{$netch}{$nick} = $col;
+ }
+ elsif ($mode eq 'session') {
+ $has_colour{$netch}{$nick} = $col;
+ $last_time{$netch}{$nick} = 0;
+ }
+ }
+ close $fid;
+}
+
+sub UNLOAD {
+ return if $exited;
+ exit_save();
+}
+
+sub exit_save {
+ $exited = 1;
+ save_colours() if Irssi::settings_get_bool('settings_autosave');
+}
+
+sub get_nick_color2 {
+ my ($tag, $chan, $nick, $format) = @_;
+ my $col = colourise_nt($tag.'/'.$chan, $nick, 1);
+ $col ? $format ? format_expand('%X'.$col) : $col : ''
+}
+
+sub _cmd_colours_check {
+ my ($add, $data) = @_;
+ my @to_check = grep { defined && length } map {
+ length == 1 ? $base_map{$_}
+ : length == 3 ? substr $_, 1
+ : $_ } map { /(?|x(..)|([0-7].)|(.))/gi }
+ split ' ', $data;
+ my @valid;
+ my %scolours = map { $_ => undef } @colours;
+ for my $c (@to_check) {
+ if ((grep { $_ eq $c } @colour_list)) {
+ if ($add) { next if exists $scolours{$c} }
+ else { next if !exists $scolours{$c} }
+ push @valid, $c;
+ if ($add) { $scolours{$c} = undef; }
+ else { delete $scolours{$c}; }
+ }
+ }
+ (\@valid, \%scolours)
+}
+
+sub _cmd_colours_set {
+ my $scolours = shift;
+ Irssi::settings_set_str('neat_colors', join '', map { $ext_to_base_map{$_} // "X$_" } grep { exists $scolours->{$_} } @colour_list);
+}
+
+sub _cmd_colours_list {
+ map { "%X$_".($ext_to_base_map{$_} // "X$_").'%n' } @{+shift}
+}
+
+sub cmd_neatcolor_colors_add {
+ my ($data, $server, $witem) = @_;
+ my ($added, $scolours) = _cmd_colours_check(1, $data);
+ if (@$added) {
+ _cmd_colours_set($scolours);
+ Irssi::print("%_nce2%_: added @{[ _cmd_colours_list($added) ]} to neat_colors", MSGLEVEL_CLIENTCRAP);
+ setup_changed();
+ }
+ else {
+ Irssi::print("%_nce2%_: nothing added", MSGLEVEL_CLIENTCRAP);
+ }
+}
+sub cmd_neatcolor_colors_remove {
+ my ($data, $server, $witem) = @_;
+ my ($removed, $scolours) = _cmd_colours_check(0, $data);
+ if (@$removed) {
+ _cmd_colours_set($scolours);
+ Irssi::print("%_nce2%_: removed @{[ _cmd_colours_list($removed) ]} from neat_colors", MSGLEVEL_CLIENTCRAP);
+ setup_changed();
+ }
+ else {
+ Irssi::print("%_nce2%_: nothing removed", MSGLEVEL_CLIENTCRAP);
+ }
+}
+
+sub cmd_neatcolor_colors {
+ my ($data, $server, $witem) = @_;
+ $data =~ s/\s+$//;
+ unless (length $data) {
+ Irssi::print("%_nce2%_: current colours: @{[ @colours ? _cmd_colours_list(\@colours) : '(none)' ]}");
+ }
+ Irssi::command_runsub('neatcolor colors', $data, $server, $witem);
+}
+
+sub cmd_neatcolor {
+ my ($data, $server, $witem) = @_;
+ $data =~ s/\s+$//;
+ unless (length $data) {
+ $witem ||= Irssi::active_win;
+ my $time = time;
+ my %distribution = map { $_ => 0 } @colours;
+ for my $netch (keys %has_colour) {
+ next unless length $netch;
+ for my $nick (keys %{ $has_colour{$netch} }) {
+ if (exists $last_time{$netch}{$nick}
+ && ($last_time{$netch}{$nick} + $retain_colour_time > $time
+ || grep { $_->[0] eq $nick } @{ $netchan_hist{$netch} // [] })) {
+ $distribution{ $has_colour{$netch}{$nick} }++
+ }
+ }
+ }
+ $witem->print('%_nce2%_ Colour distribution: '.
+ (join ', ',
+ map { "%X$_$_:$distribution{$_}" }
+ sort { $distribution{$b} <=> $distribution{$a} }
+ grep { exists $distribution{$_} } @colour_list), MSGLEVEL_CLIENTCRAP);
+ }
+ Irssi::command_runsub('neatcolor', $data, $server, $witem);
+}
+
+sub _cmd_check_netchan_arg {
+ my ($cmd, $netchan, $nick) = @_;
+ my %global = map { $_ => undef } qw(set get reset);
+ unless (length $netchan) {
+ Irssi::print('%_nce2%_: no network/channel argument given for neatcolor '.$cmd
+ .(exists $global{$cmd} ? ', use / to '.$cmd.' global colours' : ''),
+ MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ elsif (-1 == index $netchan, '/') {
+ Irssi::print('%_nce2%_: missing network/ in argument given for neatcolor '.$cmd, MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ elsif ($netchan =~ m\^[^/]+/$\) {
+ Irssi::print('%_nce2%_: missing /channel in argument given for neatcolor '.$cmd, MSGLEVEL_CLIENTERROR);
+ return;
+ }
+
+ unless (length $nick) {
+ Irssi::print('%_nce2%_: no nick argument given for neatcolor '.$cmd, MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ elsif (-1 != index $nick, '/') {
+ Irssi::print('%_nce2%_: / not supported in nicks in argument given for neatcolor '.$cmd, MSGLEVEL_CLIENTERROR);
+ return;
+ }
+
+ return 1;
+}
+
+sub _cmd_check_colour {
+ my ($cmd, $colour) = @_;
+ $colour = substr $colour, 1 if length $colour == 3;
+ $colour = $base_map{$colour} if length $colour == 1;
+ unless (length $colour && grep { $_ eq $colour } @colour_list) {
+ Irssi::print('%_nce2%_: no colour or invalid colour argument given for neatcolor '.$cmd, MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ return $colour;
+}
+
+sub cmd_neatcolor_set {
+ my ($data, $server, $witem) = @_;
+ my @args = split ' ', $data;
+ if (@args < 2) {
+ Irssi::print('%_nce2%_: not enough arguments for neatcolor set', MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ my $netchan;
+ if (ref $witem) {
+ $netchan = $witem->{server}{tag}.'/'.$witem->{name};
+ }
+ my $nick;
+ my $colour;
+ if (@args < 3) {
+ ($nick, $colour) = @args;
+ }
+ else {
+ ($netchan, $nick, $colour) = @args;
+ }
+
+ return unless _cmd_check_netchan_arg('set', $netchan, $nick);
+ return unless defined ($colour = _cmd_check_colour('set', $colour));
+
+ $set_colour{$netchan eq '/' ? '' : $netchan}{$nick} = $colour;
+ for my $netch ($netchan eq '/' ? keys %has_colour
+ : $global_colours ? ('', $netchan)
+ : $netchan) {
+ delete $has_colour{$netch}{$nick} unless
+ exists $has_colour{$netch}{$nick} && $has_colour{$netch}{$nick} eq $colour;
+ }
+ Irssi::print("%_nce2%_: %X$colour$nick%n colour set to: %X$colour$colour%n ".($netchan eq '/' ? 'globally' : "in $netchan"), MSGLEVEL_CLIENTCRAP);
+}
+sub cmd_neatcolor_get {
+ my ($data, $server, $witem) = @_;
+ my @args = split ' ', $data;
+ if (@args < 1) {
+ Irssi::print('%_nce2%_: not enough arguments for neatcolor get', MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ my $netchan;
+ if (ref $witem) {
+ $netchan = $witem->{server}{tag}.'/'.$witem->{name};
+ }
+ my $nick;
+ if (@args < 2) {
+ $nick = $args[0];
+ }
+ else {
+ ($netchan, $nick) = @args;
+ }
+
+ return unless _cmd_check_netchan_arg('get', $netchan, $nick);
+
+ if ($netchan ne '/') {
+ unless (exists $has_colour{$netchan} && exists $has_colour{$netchan}{$nick}) {
+ Irssi::print("%_nce2%_: $nick is not coloured (yet) in $netchan", MSGLEVEL_CLIENTCRAP);
+ }
+ else {
+ my $colour = $has_colour{$netchan}{$nick};
+ Irssi::print("%_nce2%_: %X$colour$nick%n has colour: %X$colour$colour%n in $netchan", MSGLEVEL_CLIENTCRAP);
+ }
+ }
+ my $hashnick = $nick;
+ $hashnick =~ s/$ignore_re//g if (defined $ignore_re && length $ignore_re);
+ if (exists $set_colour{$netchan} && exists $set_colour{$netchan}{$nick}) {
+ my $colour = $set_colour{$netchan}{$nick};
+ Irssi::print("%_nce2%_: set colour for %X$colour$nick%n in $netchan: %X$colour$colour%n ", MSGLEVEL_CLIENTCRAP);
+ }
+ elsif (exists $set_colour{$netchan} && exists $set_colour{$netchan}{$hashnick}) {
+ my $colour = $set_colour{$netchan}{$hashnick};
+ Irssi::print("%_nce2%_: set colour for %X$colour$hashnick%n in $netchan: %X$colour$colour%n ", MSGLEVEL_CLIENTCRAP);
+ }
+ elsif (exists $set_colour{''} && exists $set_colour{''}{$nick}) {
+ my $colour = $set_colour{''}{$nick};
+ Irssi::print("%_nce2%_: set colour for %X$colour$nick%n (global): %X$colour$colour%n ", MSGLEVEL_CLIENTCRAP);
+ }
+ elsif (exists $set_colour{''} && exists $set_colour{''}{$hashnick}) {
+ my $colour = $set_colour{''}{$hashnick};
+ Irssi::print("%_nce2%_: set colour for %X$colour$hashnick%n (global): %X$colour$colour%n ", MSGLEVEL_CLIENTCRAP);
+ }
+ elsif ($netchan eq '/') {
+ Irssi::print("%_nce2%_: no global colour set for $nick", MSGLEVEL_CLIENTCRAP);
+ }
+}
+sub cmd_neatcolor_reset {
+ my ($data, $server, $witem) = @_;
+ my @args = split ' ', $data;
+ if (@args < 1) {
+ Irssi::print('%_nce2%_: not enough arguments for neatcolor reset', MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ my $netchan;
+ if (ref $witem) {
+ $netchan = $witem->{server}{tag}.'/'.$witem->{name};
+ }
+ my $nick;
+ if (@args == 1 && $args[0] eq '--all') {
+ %set_colour = %avoid_colour = %has_colour = ();
+ Irssi::print("%_nce2%_: re-set all colouring");
+ return;
+ }
+ if (@args < 2) {
+ $nick = $args[0];
+ }
+ else {
+ ($netchan, $nick) = @args;
+ }
+
+ return unless _cmd_check_netchan_arg('reset', $netchan, $nick);
+
+ $netchan = '' if $netchan eq '/';
+ unless (exists $set_colour{$netchan} && exists $set_colour{$netchan}{$nick}) {
+ Irssi::print("%_nce2%_: $nick has no colour set ". (length $netchan ? "in $netchan" : "globally"), MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ my $colour = delete $set_colour{$netchan}{$nick};
+ for my $netch ($netchan eq '' ? keys %has_colour
+ : $global_colours ? ('', $netchan)
+ : $netchan) {
+ delete $has_colour{$netch}{$nick} if exists $has_colour{$netch} && exists $has_colour{$netch}{$nick}
+ && $has_colour{$netch}{$nick} eq $colour;
+ }
+ Irssi::print("%_nce2%_: ".($netchan eq '' ? 'global ' : '')."colouring re-set for $nick".($netchan eq '' ? '' : " in $netchan"), MSGLEVEL_CLIENTERROR);
+}
+sub cmd_neatcolor_re {
+ my ($data, $server, $witem) = @_;
+ my @args = split ' ', $data;
+ if (@args < 1) {
+ Irssi::print('%_nce2%_: not enough arguments for neatcolor re', MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ my $netchan;
+ if (ref $witem) {
+ $netchan = $witem->{server}{tag}.'/'.$witem->{name};
+ }
+ my $nick;
+ if (@args < 2) {
+ $nick = $args[0];
+ }
+ else {
+ ($netchan, $nick) = @args;
+ }
+
+ return unless _cmd_check_netchan_arg('re', $netchan, $nick);
+
+ unless (exists $has_colour{$netchan} && exists $has_colour{$netchan}{$nick}) {
+ Irssi::print("%_nce2%_: could not find $nick in $netchan", MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ my $colour = delete $has_colour{$netchan}{$nick};
+ if (grep { $colour eq $_ } @{ $avoid_colour{$netchan}{$nick} || [] }) {
+ $avoid_colour{$netchan}{$nick} = [ $colour ]
+ }
+ else {
+ push @{ $avoid_colour{$netchan}{$nick} }, $colour;
+ }
+ if ($global_colours) {
+ delete $has_colour{''}{$nick} if defined $colour;
+
+ if (grep { $colour eq $_ } @{ $avoid_colour{''}{$nick} || [] }) {
+ $avoid_colour{''}{$nick} = [ $colour ]
+ }
+ else {
+ push @{ $avoid_colour{''}{$nick} }, $colour;
+ }
+ }
+ Irssi::print("%_nce2%_: re-colouring $nick in $netchan", MSGLEVEL_CLIENTERROR);
+}
+sub cmd_neatcolor_save {
+ Irssi::print("%_nce2%_: saving colours to file", MSGLEVEL_CLIENTCRAP);
+ save_colours();
+}
+
+sub setup_changed {
+ $global_colours = Irssi::settings_get_bool('neat_global_colors');
+ $retain_colour_time = int( abs( Irssi::settings_get_time('neat_color_reassign_time') ) / 1000 );
+ my $old_ignore = $ignore_setting // '';
+ $ignore_setting = Irssi::settings_get_str('neat_ignorechars');
+ if ($old_ignore ne $ignore_setting) {
+ local $@;
+ eval { $ignore_re = qr/$ignore_setting/ };
+ if ($@) {
+ $@ =~ /^(.*)/;
+ print '%_neat_ignorechars%_ did not compile: '.$1;
+ }
+ }
+ my $old_colours = "@colours";
+ my %scolours = map { ($base_map{$_} // $_) => undef } Irssi::settings_get_str('neat_colors') =~ /(?|x(..)|(.))/ig;
+ @colours = grep { exists $scolours{$_} } @colour_list;
+
+ if ($old_colours ne "@colours") {
+ my $time = time;
+ for my $netch (sort keys %last_time) {
+ for my $nick (sort keys %{ $last_time{$netch} }) {
+ if (exists $has_colour{$netch} && exists $has_colour{$netch}{$nick}) {
+ if ($last_time{$netch}{$nick} + $retain_colour_time > $time
+ || ($last_time{$netch}{$nick} == 0 && $session_load_time + $retain_colour_time > $time)) {
+ $last_time{$netch}{$nick} = 0;
+ }
+ else {
+ delete $last_time{$netch}{$nick};
+ }
+ }
+ }
+ $session_load_time = $time;
+ }
+ }
+}
+
+sub internals {
+ +{
+ set => \%set_colour,
+ avoid => \%avoid_colour,
+ has => \%has_colour,
+ time => \%last_time,
+ hist => \%netchan_hist,
+ colours => \@colours
+ }
+}
+
+sub init_nickcolour {
+ setup_changed();
+ load_colours();
+}
+
+Irssi::settings_add_str('misc', 'neat_colors', 'rRgGybBmMcCX42X3AX5EX4NX3HX3CX32');
+Irssi::settings_add_str('misc', 'neat_ignorechars', '');
+Irssi::settings_add_time('misc', 'neat_color_reassign_time', '30min');
+Irssi::settings_add_bool('misc', 'neat_global_colors', 0);
+init_nickcolour();
+
+Irssi::expando_create('nickcolor', \&expando_neatcolour, {
+ 'message public' => 'none',
+ 'message own_public' => 'none',
+ (map { ("message $_ action" => 'none',
+ "message $_ own_action" => 'none')
+ } @action_protos),
+ });
+
+Irssi::expando_create('inickcolor', \&expando_neatcolour_inv, {
+ 'message public' => 'none',
+ 'message own_public' => 'none',
+ (map { ("message $_ action" => 'none',
+ "message $_ own_action" => 'none')
+ } @action_protos),
+ });
+
+Irssi::signal_add({
+ 'message public' => 'msg_line_tag',
+ 'message own_public' => 'msg_line_clear',
+ (map { ("message $_ action" => 'msg_line_tag',
+ "message $_ own_action" => 'msg_line_clear')
+ } qw(irc silc)),
+ "message xmpp action" => 'msg_line_tag_xmppaction',
+ "message xmpp own_action" => 'msg_line_clear',
+ 'print text' => 'prnt_clear_public',
+ 'nicklist changed' => 'nicklist_changed',
+ 'gui exit' => 'exit_save',
+});
+Irssi::command_bind({
+ 'help' => sub { &cmd_help_neatcolor if $_[0] =~ /^neatcolor\s*$/i;},
+ 'neatcolor' => 'cmd_neatcolor',
+ 'neatcolor save' => 'cmd_neatcolor_save',
+ 'neatcolor set' => 'cmd_neatcolor_set',
+ 'neatcolor get' => 'cmd_neatcolor_get',
+ 'neatcolor reset' => 'cmd_neatcolor_reset',
+ 'neatcolor re' => 'cmd_neatcolor_re',
+ 'neatcolor colors' => 'cmd_neatcolor_colors',
+ 'neatcolor colors add' => 'cmd_neatcolor_colors_add',
+ 'neatcolor colors remove' => 'cmd_neatcolor_colors_remove',
+ });
+
+Irssi::signal_add_last('setup changed' => 'setup_changed');
+
+
+# Changelog
+# =========
+# 0.4.0
+# - Allow usage of the colour as a background (using $inickcolor)
+# 0.3.7
+# - fix crash if xmpp action signal is not registered (just ignore it)
+# 0.3.6
+# - also look up ignorechars in set colours
+# 0.3.5
+# - bug fix release
+# 0.3.4
+# - re/set/reset-colouring was affected by the global colour
+# - set colour score too weak
+# 0.3.3
+# - fix error with get / reported by Meicceli
+# - now possible to reset global colour
+# - check for invalid colours
+# 0.3.2
+# - add global colour option
+# - respect save settings setting
+# - add action handling
+# 0.3.1
+# - regression: reset colours after removing colour
+# 0.3.0
+# - save some more colours
+# 0.2.9
+# - fix incorrect calculation of used colours
+# - add some sanity checks to set/get command
+# - avoid random colour changes
diff --git a/scripts/nickident.pl b/scripts/nickident.pl
new file mode 100644
index 0000000..b9b27ce
--- /dev/null
+++ b/scripts/nickident.pl
@@ -0,0 +1,230 @@
+#
+# $Id: nickident.pl 1736 2007-02-01 14:13:24Z cb $
+#
+# NickServ interface
+# Original code by Sami Haahtinen / ZaNaGa
+# Protected channel support added by David McNett <nugget@slacker.com>
+# Heavily patched by Christoph Berg <cb@df7cb.de>
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '20070201';
+%IRSSI = (
+ authors => 'Sami Haahtinen, Christoph Berg',
+ name => 'nickident',
+ description => 'identify to nickserv',
+ url => 'http://cvsweb.oftc.net/svn/oftc-tools/trunk/user/irssi/',
+ license => 'public domain',
+);
+
+my $name = "nickident";
+my $nickserv_passfile = glob "~/.irssi/nickserv.users";
+my $nickserv_chanfile = glob "~/.irssi/nickserv.channels";
+my @users = ();
+my @chans = ();
+my %nickservs = (
+ openprojects => [ 'NickServ', 'NickServ@services.' ],
+ sourceirc => [ 'NickServ', 'services@sourceirc.net' ],
+ cuckoonet => [ 'NickServ', 'services@irc.cuckoo.com' ],
+ slashnet => [ 'NickServ', 'services@services.slashnet.org' ],
+ roxnet => [ 'NickServ', 'services@ircsystems.net' ],
+ oftc => [ 'NickServ', 'services@services.oftc.net' ],
+ techno => [ 'NickServ', 'services@campus-sbg.at' ],
+ euirc => [ 'NickServ', 'anope@services.eu-irc.net' ],
+ cacert => [ 'NickServ', 'services@wireless' ],
+);
+
+use Irssi;
+use Irssi::Irc;
+
+sub join_channels {
+ my ($server) = @_;
+ my $current_ircnet = $server->{'tag'};
+
+ #Irssi::print("$name: Joining channels for $current_ircnet");
+ foreach $_ (@chans) {
+ my ($channel, $ircnet) = split(/:/);
+ if ($current_ircnet =~ /^$ircnet$/i) {
+ #Irssi::print("$name: Joining $channel");
+ #$server->send_message("ChanServ", "UNBAN $channel", "-nick");
+ #sleep 1;
+ Irssi::Server::channels_join($server, $channel, 0);
+ }
+ }
+}
+
+sub get_nickpass {
+ my ($current_nick, $current_ircnet) = @_;
+
+ foreach $_ (@users) {
+ my ($nick, $ircnet, $password) = split(/:/);
+ if ($current_nick =~ /^$nick$/i and $current_ircnet =~ /^$ircnet$/i) {
+ return $password;
+ }
+ }
+ return 0;
+}
+
+sub got_nickserv_msg {
+ my ($nick, $server, $text) = @_;
+ my $password;
+
+ if ($password = get_nickpass($server->{'nick'}, $server->{'tag'})) {
+ # The below is for OPN style.. i need to figure out a way to
+ # make this portable
+ if ($text =~ /This nickname is owned by someone else/i) {
+ Irssi::print("$name: Got authrequest from $nick/" . $server->{'tag'});
+ $server->send_message("nickserv", "IDENTIFY $password", "-nick");
+ Irssi::signal_stop();
+ } elsif ($text =~ /^This nickname is registered and protected\. If it is your/) {
+ Irssi::print("$name: Got authrequest from $nick/" . $server->{'tag'});
+ $server->send_message("nickserv", "IDENTIFY $password", "-nick");
+ Irssi::signal_stop();
+ # testnet:
+ # is a registered nickname and you are not on its access list
+ # authenticate yourself to services ^Bnow^B
+ } elsif ($text =~ /^This nick is registered\. Please choose another\.|is a registered nickname and you are not on its access list|authenticate yourself to services/) {
+ Irssi::print("$name: Got authrequest from $nick/" . $server->{'tag'});
+ $server->send_message("nickserv", "IDENTIFY $password", "-nick");
+ Irssi::signal_stop();
+ } elsif ($text =~ /nick, type.+msg NickServ IDENTIFY.+password.+Otherwise,|please choose a different nick./i) {
+ Irssi::signal_stop();
+ } elsif ($text =~ /Password accepted - you are now recognized./ ||
+ $text =~ /Wow, you managed to remember your password. That's a miracle by your usual standard./ ||
+ $text =~ /You are sucessfully identified as/ ) {
+ Irssi::print("$name: Got a positive response from $nick/" . $server->{'tag'});
+ join_channels($server);
+ Irssi::signal_stop();
+ }
+ }
+}
+
+sub event_nickserv_message {
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $text) = $data =~ /^(\S*)\s:(.*)/;
+
+ foreach my $key (keys %nickservs) {
+ if ( ($nickservs{$key}->[0] =~ /^$nick$/i)
+ and ($nickservs{$key}->[1] =~ /^$address$/i) ) {
+ got_nickserv_msg($nick, $server, $text)
+ }
+ }
+}
+
+sub cmd_nickident {
+ my ($data, $server, $witem) = @_;
+ if (my $password = get_nickpass($server->{'nick'}, $server->{'tag'})) {
+ $server->send_message("nickserv", "IDENTIFY $password", "-nick");
+ } else {
+ Irssi::print("$name: No password for $server->{'nick'}/$server->{'tag'} found");
+ }
+}
+
+sub create_users {
+ Irssi::print("$name: Creating basic userfile in $nickserv_passfile. please edit it and run /nickserv_read");
+ if(!(open NICKUSERS, ">$nickserv_passfile")) {
+ Irssi::print("$name: Unable to create file $nickserv_passfile");
+ }
+
+ print NICKUSERS "# This file should contain all your protected nicks\n";
+ print NICKUSERS "# with the corresponding ircnet tag and password.\n";
+ print NICKUSERS "#\n";
+ print NICKUSERS "# Nick and IrcNet Tag are case insensitive\n";
+ print NICKUSERS "#\n";
+ print NICKUSERS "# Nick IrcNet Tag Password\n";
+ print NICKUSERS "# -------- ---------- --------\n";
+
+ close NICKUSERS;
+ chmod 0600, $nickserv_passfile;
+}
+
+sub create_chans {
+ Irssi::print("$name: Creating basic channelfile in $nickserv_chanfile. please edit it and run /nickserv_read");
+ if(!(open NICKCHANS, ">$nickserv_chanfile")) {
+ Irssi::print("$name: Unable to create file $nickserv_chanfile");
+ }
+
+ print NICKCHANS "# This file should contain a list of all channels\n";
+ print NICKCHANS "# which you don't want to join until after you've\n";
+ print NICKCHANS "# successfully identified with NickServ. This is\n";
+ print NICKCHANS "# useful for channels which are access-controlled.\n";
+ print NICKCHANS "#\n";
+ print NICKCHANS "# Channel IrcNet Tag\n";
+ print NICKCHANS "# -------- ----------\n";
+
+ close NICKCHANS;
+ chmod 0600, $nickserv_chanfile;
+}
+
+sub read_users {
+ my $count = 0;
+ @users = ();
+
+ if (!(open NICKUSERS, "<$nickserv_passfile")) {
+ create_users;
+ };
+
+ # first we test the file with mask 066 (we don't actually care if the
+ # file is executable by others.. what could they do with it =)
+ my $mode = (stat($nickserv_passfile))[2];
+ if ($mode & 066) {
+ Irssi::print("$name: Your password file should be mode 0600. Go fix it!");
+ Irssi::print("$name: Use command: chmod 0600 $nickserv_passfile");
+ }
+
+ # apparently Irssi resets $/, so we set it here.
+ $/ = "\n";
+ while( my $line = <NICKUSERS>) {
+ if ($line =~ /^\s*([^#]\S+)\s+(\S+)\s+(\S+)/) {
+ push @users, "$1:$2:$3";
+ $count++;
+ }
+ }
+ Irssi::print("$name: Found $count accounts");
+
+ close NICKUSERS;
+}
+
+sub read_chans {
+ my $count = 0;
+ @chans = ();
+
+ if (!(open NICKCHANS, "<$nickserv_chanfile")) {
+ create_chans;
+ };
+
+ # first we test the file with mask 066 (we don't actually care if the
+ # file is executable by others.. what could they do with it =)
+ my $mode = (stat($nickserv_chanfile))[2];
+ if ($mode & 066) {
+ Irssi::print("$name: Your channels file should be mode 0600. Go fix it!");
+ Irssi::print("$name: Use command: chmod 0600 $nickserv_chanfile");
+ }
+
+ # apparently Irssi resets $/, so we set it here.
+ $/ = "\n";
+ while( my $line = <NICKCHANS>) {
+ next if /^#\s/;
+ if ($line =~ /^\s*(\S+)\s+(\S+)\s*$/) {
+ push @chans, "$1:$2";
+ $count++;
+ }
+ }
+ Irssi::print("$name: Found $count channels");
+
+ close NICKCHANS;
+}
+
+sub read_files {
+ read_users();
+ read_chans();
+}
+
+
+Irssi::signal_add("event notice", "event_nickserv_message");
+Irssi::command_bind('nickident_read', 'read_files');
+Irssi::command_bind('nickident', 'cmd_nickident');
+
+read_files();
diff --git a/scripts/nickignore.pl b/scripts/nickignore.pl
new file mode 100644
index 0000000..bff2d50
--- /dev/null
+++ b/scripts/nickignore.pl
@@ -0,0 +1,49 @@
+#
+# nickignore.pl
+#
+# ignore minimal changes in nicks (case, special characters)
+#
+# can also ignore more complex/drastic changes via variable
+# 'nickignore_pattern' (use like '/set nickignore_pattern (away|afk)')
+
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+use strict;
+
+
+$VERSION = "0.03";
+%IRSSI = (
+ authors => "Kalle 'rpr' Marjola",
+ contact => "marjola\@iki.fi",
+ name => "ignore (minimal) nick changes",
+ description => "Ignores any nick changes when only the case or special characters are modified, like 'rpr -> Rpr' or 'rpr_ -> rpr', with optional pattern for more complicated ignores",
+ license => "Public Domain",
+ url => "http://iki.fi/rpr/irssi/nickignore.pl",
+ changed => "26.8.2003"
+);
+
+sub event_nick {
+ my ($server, $newnick, $nick, $address) = @_;
+
+ # (debug) Irssi::print("new: $newnick old: $nick");
+ $newnick = substr($newnick, 1) if ($newnick =~ /^:/);
+
+ # remove any special characters from nicks
+ $newnick =~ s/[^a-zA-Z]//g;
+ $nick =~ s/[^a-zA-Z]//g;
+
+ # if the user has specific other patterns to be used, use it
+ my $extra_pattern = Irssi::settings_get_str('nickignore_pattern');
+ if ($extra_pattern) {
+ $newnick =~ s/$extra_pattern//g;
+ $nick =~ s/$extra_pattern//g;
+ }
+
+ # compare if they are identical (excluding case)
+ Irssi::signal_stop() if ($newnick =~ m/^$nick$/i);
+}
+
+Irssi::signal_add('event nick', 'event_nick');
+
+Irssi::settings_add_str ('misc', 'nickignore_pattern', '');
diff --git a/scripts/nicklist.pl b/scripts/nicklist.pl
new file mode 100644
index 0000000..7c72aa7
--- /dev/null
+++ b/scripts/nicklist.pl
@@ -0,0 +1,828 @@
+# This script adds a nicklist to the right of irssi
+# for documentation: see http://wouter.coekaerts.be/site/irssi/nicklist
+
+# Copyright (C) 2002-2007 Wouter Coekaerts <coekie@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+use Irssi;
+use strict;
+use IO::Handle; # for (auto)flush
+use Fcntl; # for sysopen
+use vars qw($VERSION %IRSSI);
+$VERSION = '0.4.12';
+%IRSSI = (
+ authors => 'Wouter Coekaerts',
+ contact => 'coekie@irssi.org',
+ name => 'nicklist',
+ description => 'draws a nicklist to another terminal, or at the right of your irssi in the same terminal',
+ license => 'GPLv2',
+ url => 'http://wouter.coekaerts.be/irssi',
+ changed => '2018-10-02'
+);
+
+sub cmd_help {
+ print ( <<EOF
+Commands:
+NICKLIST HELP
+NICKLIST SCROLL <nr of lines>
+NICKLIST SCREEN
+NICKLIST FIFO
+NICKLIST ON
+NICKLIST OFF
+NICKLIST TOGGLE
+NICKLIST UPDATE
+
+For help see: http://wouter.coekaerts.be/site/irssi/nicklist
+
+in short:
+
+1. FIFO MODE
+- in irssi: /NICKLIST FIFO (only the first time, to create the fifo)
+- in a shell, in a window where you want the nicklist: cat ~/.irssi/nicklistfifo
+- back in irssi:
+ /SET nicklist_heigth <height of nicklist>
+ /SET nicklist_width <width of nicklist>
+ /NICKLIST FIFO
+
+2. SCREEN MODE
+- start irssi inside screen ("screen irssi")
+- /NICKLIST SCREEN
+EOF
+ );
+}
+
+my $prev_lines = 0; # number of lines in previous written nicklist
+my $scroll_pos = 0; # scrolling position
+my $cursor_line; # line the cursor is currently on
+my ($OFF, $SCREEN, $FIFO) = (0,1,2); # modes
+my $mode = $OFF; # current mode
+my $need_redraw = 0; # nicklist needs redrawing
+my $screen_resizing = 0; # terminal is being resized
+my $active_channel; # (REC)
+
+my @nicklist=(); # array of hashes, containing the internal nicklist of the active channel
+ # nick => realnick
+ # modeflag => '@', '%', '+', or other mode char
+ # modepos => number representing the position in which to sort nicks with that mode
+ # status => (not used yet...)
+ # text => text to be printed
+ # cmp => text used to compare (sort) nicks
+
+# 'cached' settings
+my ($screen_prefix, $irssi_width, %prefix_mode, @prefix_status, $height, $nicklist_width, $check_friends, @prefix_friends);
+
+sub read_settings {
+ ($screen_prefix = Irssi::settings_get_str('nicklist_screen_prefix')) =~ s/\\e/\033/g;
+
+ ($prefix_mode{'@'} = Irssi::settings_get_str('nicklist_prefix_mode_op')) =~ s/\\e/\033/g;
+ ($prefix_mode{'%'} = Irssi::settings_get_str('nicklist_prefix_mode_halfop')) =~ s/\\e/\033/g;
+ ($prefix_mode{'+'} = Irssi::settings_get_str('nicklist_prefix_mode_voice')) =~ s/\\e/\033/g;
+ ($prefix_mode{' '} = Irssi::settings_get_str('nicklist_prefix_mode_normal')) =~ s/\\e/\033/g;
+
+ (my $prefix_mode_other = Irssi::settings_get_str('nicklist_prefix_mode_other')) =~ s/\\e/\033/g;
+ foreach my $p (split (/ /, $prefix_mode_other)) {
+ next if $p eq '';
+ if ($p !~ /(.)=(.*)/) {
+ Irssi::print("Could not parse nicklist_prefix_mode_other part '$p'. Expected space separated list of <mode character>=<prefix>");
+ last;
+ } else {
+ $prefix_mode{$1} = $2;
+ }
+ }
+
+ (my $prefix_friends = Irssi::settings_get_str('nicklist_prefix_friends')) =~ s/\\e/\033/g;
+ foreach my $p (split (/ /, $prefix_friends)) {
+ next if $p eq '';
+ if ($p !~ /(.+?)=(.*)/) {
+ Irssi::print("Could not parse nicklist_prefix_friends part '$p'. Expected space separated list of <flags>=<prefix>");
+ last;
+ } else {
+ push @prefix_friends, {'flags' => $1, 'prefix' => $2};
+ }
+ }
+
+ $check_friends = ($prefix_friends ne '');
+
+ if ($mode != $SCREEN) {
+ $height = Irssi::settings_get_int('nicklist_height');
+ }
+ my $new_nicklist_width = Irssi::settings_get_int('nicklist_width');
+ if ($new_nicklist_width != $nicklist_width && $mode == $SCREEN) {
+ sig_terminal_resized();
+ }
+ $nicklist_width = $new_nicklist_width;
+}
+
+sub update {
+ read_settings();
+ make_nicklist();
+}
+
+##################
+##### OUTPUT #####
+##################
+
+### on ###
+
+sub cmd_on {
+ if (uc(Irssi::settings_get_str('nicklist_automode')) eq 'SCREEN') {
+ cmd_screen_start();
+ } elsif (uc(Irssi::settings_get_str('nicklist_automode')) eq 'FIFO') {
+ cmd_fifo_start();
+ }
+}
+
+### off ###
+
+sub cmd_off {
+ if ($mode == $SCREEN) {
+ screen_stop();
+ } elsif ($mode == $FIFO) {
+ fifo_stop();
+ }
+}
+
+### toggle ###
+
+sub cmd_toggle {
+ if ($mode == $OFF) {
+ cmd_on();
+ } else {
+ cmd_off();
+ }
+}
+
+### fifo ###
+
+sub cmd_fifo_start {
+ read_settings();
+ my $path = Irssi::settings_get_str('nicklist_fifo_path');
+ unless (-p $path) { # not a pipe
+ if (-e _) { # but a something else
+ die "$0: $path exists and is not a pipe, please remove it\n";
+ } else {
+ require POSIX;
+ POSIX::mkfifo($path, 0666) or die "can\'t mkfifo $path: $!";
+ Irssi::print("Fifo created. Start reading it (\"cat $path\") and try again.");
+ return;
+ }
+ }
+ if (!sysopen(FIFO, $path, O_WRONLY | O_NONBLOCK)) { # or die "can't write $path: $!";
+ Irssi::print("Couldn\'t write to the fifo ($!). Please start reading the fifo (\"cat $path\") and try again.");
+ return;
+ }
+ FIFO->autoflush(1);
+ print FIFO "\033[2J\033[1;1H"; # erase screen & jump to 0,0
+ $cursor_line = 0;
+ if ($mode == $SCREEN) {
+ screen_stop();
+ }
+ $mode = $FIFO;
+ make_nicklist();
+}
+
+sub fifo_stop {
+ close FIFO;
+ $mode = $OFF;
+ Irssi::print("Fifo closed.");
+}
+
+### screen ###
+
+sub cmd_screen_start {
+ if (!defined($ENV{'STY'})) {
+ Irssi::print 'screen not detected, screen mode only works inside screen';
+ return;
+ }
+ read_settings();
+ if ($mode == $SCREEN) {return;}
+ if ($mode == $FIFO) {
+ fifo_stop();
+ }
+ $mode = $SCREEN;
+ Irssi::signal_add_last('gui print text finished', \&sig_gui_print_text_finished);
+ Irssi::signal_add_last('gui page scrolled', \&sig_page_scrolled);
+ Irssi::signal_add('terminal resized', \&sig_terminal_resized);
+ screen_size();
+ make_nicklist();
+}
+
+sub screen_stop {
+ $mode = $OFF;
+ Irssi::signal_remove('gui print text finished', \&sig_gui_print_text_finished);
+ Irssi::signal_remove('gui page scrolled', \&sig_page_scrolled);
+ Irssi::signal_remove('terminal resized', \&sig_terminal_resized);
+ system 'screen -x '.$ENV{'STY'}.' -X fit';
+ # we wait a second to make sure the fit command was processed
+ Irssi::timeout_add_once(1000, \&screen_size, []);
+}
+
+#sub screen_size_real {
+sub screen_size {
+ if ($mode != $SCREEN) {
+ return;
+ }
+ $screen_resizing = 1;
+ # fit screen
+ system 'screen -x '.$ENV{'STY'}.' -X fit';
+ # get size (from perldoc -q size)
+ my ($winsize, $row, $col, $xpixel, $ypixel);
+ eval 'use Term::ReadKey; ($col, $row, $xpixel, $ypixel) = GetTerminalSize';
+ # require Term::ReadKey 'GetTerminalSize';
+ # ($col, $row, $xpixel, $ypixel) = Term::ReadKey::GetTerminalSize;
+ #};
+ if ($@) { # no Term::ReadKey, try the ugly way
+ eval {
+ require 'sys/ioctl.ph';
+ # without this reloading doesn't work. workaround for some unknown bug
+ do 'asm/ioctls.ph';
+ };
+
+ # ugly way not working, let's try something uglier, the dg-hack(tm) (constant for linux only?)
+ if($@) { no strict 'refs'; *TIOCGWINSZ = sub { return 0x5413 } }
+
+ unless (defined &TIOCGWINSZ) {
+ die "Term::ReadKey not found, and ioctl 'workaround' failed. Install the Term::ReadKey perl module to use screen mode.\n";
+ }
+ open(TTY, "+<","/dev/tty") or die "No tty: $!";
+ unless (ioctl(TTY, &TIOCGWINSZ, $winsize='')) {
+ die "Term::ReadKey not found, and ioctl 'workaround' failed ($!). Install the Term::ReadKey perl module to use screen mode.\n";
+ }
+ close(TTY);
+ ($row, $col, $xpixel, $ypixel) = unpack('S4', $winsize);
+ }
+
+ # set screen width
+ $irssi_width = $col-$nicklist_width-1;
+ $height = $row-1;
+
+ system 'screen -x '.$ENV{'STY'}.' -X width -w ' . $irssi_width;
+ # wait another second for the resizing, and then redraw.
+ Irssi::timeout_add_once(1000,sub {$screen_resizing = 0; redraw()}, []);
+}
+
+sub sig_terminal_resized {
+ if ($screen_resizing) {
+ return;
+ }
+ $screen_resizing = 1;
+ Irssi::timeout_add_once(1000,\&screen_size,[]);
+}
+
+
+### both ###
+
+sub nicklist_write_start {
+ if ($mode == $SCREEN) {
+ print STDERR "\033P\0337\033\\"; # save cursor
+ }
+}
+
+sub nicklist_write_end {
+ if ($mode == $SCREEN) {
+ print STDERR "\033P\0338\033\\"; # restore cursor
+ }
+}
+
+sub nicklist_write_line {
+ my ($line, $data) = @_;
+ if ($mode == $SCREEN) {
+ print STDERR "\033P\033[" . ($line+1) . ';'. ($irssi_width+1) .'H'. $screen_prefix . $data . "\033\\";
+ } elsif ($mode == $FIFO) {
+ $data = "\033[m$data"; # reset color
+ if ($line == $cursor_line+1) {
+ $data = "\n$data"; # next line
+ } elsif ($line == $cursor_line) {
+ $data = "\033[1G".$data; # back to beginning of line
+ } else {
+ $data = "\033[".($line+1).";0H".$data; # jump
+ }
+ $cursor_line=$line;
+ print(FIFO $data) or fifo_stop();
+ }
+}
+
+sub calc_prefix_friends {
+ my ($nick) = @_;
+
+ return '' unless $check_friends
+ && $nick->{'host'}
+ && is_friend($active_channel->{'server'}->{'chatnet'}, $active_channel->{'name'}, $nick->{'nick'}, $nick->{'host'});
+
+ my $flags = get_flags($active_channel->{'server'}->{'chatnet'}, $active_channel->{'name'}, $nick->{'nick'}, $nick->{'host'});
+
+ my $prefix;
+ foreach my $prefix_friend (@prefix_friends) {
+ if ($prefix_friend->{'flags'} eq 'noflag') {
+ if ($flags eq '') {
+ $prefix = $prefix_friend->{'prefix'};
+ last;
+ }
+ } elsif (check_modes($flags, $prefix_friend->{'flags'})) {
+ $prefix = $prefix_friend->{'prefix'};
+ }
+ }
+
+ return $prefix ? $prefix : '';
+}
+
+# recalc the text of the nicklist item
+sub calc_text {
+ my ($nick) = @_;
+ my $tmp = $nicklist_width-3;
+ (my $text = $nick->{'nick'}) =~ s/^(.{$tmp})..+$/$1\033[34m~/; # strip nick if too long
+
+ my $prefix_mode = $prefix_mode{$nick->{'modeflag'}};
+ if (! defined($prefix_mode) ) {
+ $prefix_mode = $nick->{'modeflag'};
+ }
+
+ my $prefix_friends = calc_prefix_friends($nick);
+
+ $nick->{'text'} =
+ $prefix_mode .
+ $prefix_friends .
+ $text .
+ (' ' x ($nicklist_width-length($nick->{'nick'})-1)) .
+ "\033[m"; # reset
+ $nick->{'cmp'} = $nick->{'modepos'}.lc($nick->{'nick'});
+}
+
+# redraw the given nick (nr) if it is visible
+sub redraw_nick_nr {
+ my ($nr) = @_;
+ my $line = $nr - $scroll_pos;
+ if ($line >= 0 && $line < $height) {
+ nicklist_write_line($line, $nicklist[$nr]->{'text'});
+ }
+}
+
+# nick was inserted, redraw area if necessary
+sub draw_insert_nick_nr {
+ my ($nr) = @_;
+ my $line = $nr - $scroll_pos;
+ if ($line < 0) { # nick is inserted above visible area
+ $scroll_pos++; # 'scroll' down :)
+ } elsif ($line < $height) { # line is visible
+ if ($mode == $SCREEN) {
+ need_redraw();
+ } elsif ($mode == $FIFO) {
+ my $data = "\033[m\033[L". $nicklist[$nr]->{'text'}; # reset color & insert line & write nick
+ if ($line == $cursor_line) {
+ $data = "\033[1G".$data; # back to beginning of line
+ } else {
+ $data = "\033[".($line+1).";1H".$data; # jump
+ }
+ $cursor_line=$line;
+ print(FIFO $data) or fifo_stop();
+ if ($prev_lines < $height) {
+ $prev_lines++; # the nicklist has one line more
+ }
+ }
+ }
+}
+
+sub draw_remove_nick_nr {
+ my ($nr) = @_;
+ my $line = $nr - $scroll_pos;
+ if ($line < 0) { # nick removed above visible area
+ $scroll_pos--; # 'scroll' up :)
+ } elsif ($line < $height) { # line is visible
+ if ($mode == $SCREEN) {
+ need_redraw();
+ } elsif ($mode == $FIFO) {
+ #my $data = "\033[m\033[L[i$line]". $nicklist[$nr]->{'text'}; # reset color & insert line & write nick
+ my $data = "\033[M"; # delete line
+ if ($line != $cursor_line) {
+ $data = "\033[".($line+1)."d".$data; # jump
+ }
+ $cursor_line=$line;
+ print(FIFO $data) or fifo_stop();
+ if (@nicklist-$scroll_pos >= $height) {
+ redraw_nick_nr($scroll_pos+$height-1);
+ }
+ }
+ }
+}
+
+# redraw the whole nicklist
+sub redraw {
+ $need_redraw = 0;
+ #make_nicklist();
+ nicklist_write_start();
+ my $line = 0;
+ ### draw nicklist ###
+ for (my $i=$scroll_pos;$line < $height && $i < @nicklist; $i++) {
+ nicklist_write_line($line++, $nicklist[$i]->{'text'});
+ }
+
+ ### clean up other lines ###
+ my $real_lines = $line;
+ while($line < $prev_lines) {
+ nicklist_write_line($line++,' ' x $nicklist_width);
+ }
+ $prev_lines = $real_lines;
+ nicklist_write_end();
+}
+
+# redraw (with little delay to avoid redrawing to much)
+sub need_redraw {
+ if(!$need_redraw) {
+ $need_redraw = 1;
+ Irssi::timeout_add_once(10,\&redraw,[]);
+ }
+}
+
+sub sig_page_scrolled {
+ $prev_lines = $height; # we'll need to redraw everything if he scrolled up
+ need_redraw;
+}
+
+# redraw (with delay) if the window is visible (only in screen mode)
+sub sig_gui_print_text_finished {
+ if ($need_redraw) { # there's already a redraw 'queued'
+ return;
+ }
+ my $window = @_[0];
+ if ($window->{'refnum'} == Irssi::active_win->{'refnum'} || Irssi::settings_get_str('nicklist_screen_split_windows') eq '*') {
+ need_redraw;
+ return;
+ }
+ foreach my $win (split(/[ ,]/, Irssi::settings_get_str('nicklist_screen_split_windows'))) {
+ if ($window->{'refnum'} == $win || $window->{'name'} eq $win) {
+ need_redraw;
+ return;
+ }
+ }
+}
+
+###################
+##### FRIENDS #####
+###################
+
+# checks if $has_modes is in $need_modes, copied from trigger.pl
+sub check_modes {
+ my ($has_modes, $need_modes) = @_;
+ my $matches;
+ my $switch = 1; # if a '-' if found, will be 0 (meaning the modes should not be set)
+ foreach my $need_mode (split /&/,$need_modes) {
+ $matches = 0;
+ foreach my $char (split //,$need_mode) {
+ if ($char eq '-') {
+ $switch = 0;
+ } elsif ($char eq '+') {
+ $switch = 1;
+ } elsif ((index($has_modes,$char) != -1) == $switch) {
+ $matches = 1;
+ last;
+ }
+ }
+ if (!$matches) {
+ return 0;
+ }
+ }
+ return 1;
+}
+
+# get someones flags from people.pl or friends(_shasta).pl, copied from trigger.pl
+sub get_flags {
+ my ($chatnet, $channel, $nick, $address) = @_;
+ my $flags;
+ no strict 'refs';
+ if (%{ 'Irssi::Script::people::' }) {
+ if (defined ($channel)) {
+ $flags = (&{ 'Irssi::Script::people::find_local_flags' }($chatnet,$channel,$nick,$address));
+ } else {
+ $flags = (&{ 'Irssi::Script::people::find_global_flags' }($chatnet,$nick,$address));
+ }
+ $flags = join('',keys(%{$flags}));
+ } else {
+ my $shasta;
+ if (%{ 'Irssi::Script::friends_shasta::' }) {
+ $shasta = 'friends_shasta';
+ } elsif (defined &{ 'Irssi::Script::friends::get_idx' }) {
+ $shasta = 'friends';
+ }
+ if (!$shasta) {
+ return undef;
+ }
+ my $idx = (&{ 'Irssi::Script::'.$shasta.'::get_idx' }($nick,$address));
+ if ($idx == -1) {
+ return '';
+ }
+ $flags = (&{ 'Irssi::Script::'.$shasta.'::get_friends_flags' }($idx,undef));
+ if ($channel) {
+ $flags .= (&{ 'Irssi::Script::'.$shasta.'::get_friends_flags' }($idx,$channel));
+ }
+ }
+ return $flags;
+}
+
+sub is_friend {
+ my ($chatnet, $channel, $nick, $address) = @_;
+ no strict 'refs';
+ if (%{ 'Irssi::Script::people::' }) {
+ return (() != &{'Irssi::Script::people::find_users'}($chatnet, $nick, $address));
+ my $flags;
+ if (defined ($channel)) {
+ $flags = (&{ 'Irssi::Script::people::find_local_flags' }($chatnet,$channel,$nick,$address));
+ } else {
+ $flags = (&{ 'Irssi::Script::people::find_global_flags' }($chatnet,$nick,$address));
+ }
+ return ($flags ne ''); # TODO: test this
+ } else {
+ my $shasta;
+ if (%{ 'Irssi::Script::friends_shasta::' }) {
+ $shasta = 'friends_shasta';
+ } elsif (defined &{ 'Irssi::Script::friends::get_idx' }) {
+ $shasta = 'friends';
+ }
+ if (!$shasta) {
+ return undef;
+ }
+ my $idx = (&{ 'Irssi::Script::'.$shasta.'::get_idx' }($nick,$address));
+ return ($idx != -1);
+ }
+}
+
+####################
+##### NICKLIST #####
+####################
+
+# returns the position of the given nick(as string) in the (internal) nicklist
+sub find_nick {
+ my ($nick) = @_;
+ for (my $i=0;$i < @nicklist; $i++) {
+ if ($nicklist[$i]->{'nick'} eq $nick) {
+ return $i;
+ }
+ }
+ return -1;
+}
+
+# find position where nick should be inserted into the list
+sub find_insert_pos {
+ my ($cmp)= @_;
+ for (my $i=0;$i < @nicklist; $i++) {
+ if ($nicklist[$i]->{'cmp'} gt $cmp) {
+ return $i;
+ }
+ }
+ return scalar(@nicklist); #last
+}
+
+# make the (internal) nicklist (@nicklist)
+sub make_nicklist {
+ @nicklist = ();
+ $scroll_pos = 0;
+
+ ### get & check channel ###
+ my $channel = Irssi::active_win->{active};
+
+ if (!$channel || (ref($channel) ne 'Irssi::Irc::Channel' && ref($channel) ne 'Irssi::Silc::Channel' && ref($channel) ne 'Irssi::Xmpp::Channel') || $channel->{'type'} ne 'CHANNEL' || ($channel->{chat_type} ne 'SILC' && !$channel->{'names_got'}) ) {
+ $active_channel = undef;
+ # no nicklist
+ } else {
+ $active_channel = $channel;
+ ### make nicklist ###
+ foreach my $nick ($channel->nicks()) {
+ my $thisnick = {'nick' => $nick->{'nick'}};
+ recalc_nick($thisnick, $nick);
+ push @nicklist, $thisnick;
+ }
+ @nicklist = sort {$a->{'cmp'} cmp $b->{'cmp'}} @nicklist;
+ }
+ need_redraw();
+}
+
+# insert nick(as hash) into nicklist
+# pre: cmp has to be calculated
+sub insert_nick {
+ my ($nick) = @_;
+ my $nr = find_insert_pos($nick->{'cmp'});
+ splice @nicklist, $nr, 0, $nick;
+ draw_insert_nick_nr($nr);
+}
+
+# remove nick(as nr) from nicklist
+sub remove_nick {
+ my ($nr) = @_;
+ splice @nicklist, $nr, 1;
+ draw_remove_nick_nr($nr);
+}
+
+# update the mode and cmp of a nick, based on a nickrec from irssi
+sub recalc_nick {
+ my ($nick, $nickrec) = @_;
+ if (! $nickrec) {
+ $nickrec = $active_channel->nick_find($nick->{'nick'});
+ }
+
+ my $nickflags = $active_channel->{'server'}->get_nick_flags() . ' ';
+
+ my $flag = (
+ $nickrec->{'op'} ? '@' :
+ $nickrec->{'halfop'} ? '%' :
+ $nickrec->{'voice'} ? '+' :
+ ' '
+ );
+
+ if ($nickrec->{'other'} && index($nickflags, $nick->{'other'}) < index($nickflags, $flag)) {
+ $flag = chr($nickrec->{'other'});
+ }
+
+ $nick->{'modepos'} = index($nickflags, $flag);
+ $nick->{'modeflag'} = $flag;
+
+ $nick->{'host'} = $nickrec->{'host'};
+ calc_text($nick);
+}
+
+###################
+##### ACTIONS #####
+###################
+
+# scroll the nicklist, arg = number of lines to scroll, positive = down, negative = up
+sub cmd_scroll {
+ my $channel = Irssi::active_win->{active};
+ if (!$channel || !$channel->can('nicks')) { # active window is not a channel
+ return;
+ }
+ my @nicks = $channel->nicks;
+ my $nick_count = scalar(@nicks)+0;
+
+ if (!$active_channel) { # not a channel active
+ return;
+ }
+ if (!$channel || $channel->{type} ne 'CHANNEL' || !$channel->{names_got} || $nick_count <= $height) {
+ return;
+ }
+ if ($nick_count <= Irssi::settings_get_int('nicklist_height')) {
+ return;
+ }
+ $scroll_pos += @_[0];
+
+ if ($scroll_pos > $nick_count - $height) {
+ $scroll_pos = $nick_count - $height;
+ }
+ if ($scroll_pos <= 0) {
+ $scroll_pos = 0;
+ }
+ need_redraw();
+}
+
+sub is_active_channel {
+ my ($server,$channel) = @_; # (channel as string)
+ return ($server && $server->{'tag'} eq $active_channel->{'server'}->{'tag'} && $server->channel_find($channel) && $active_channel && $server->channel_find($channel)->{'name'} eq $active_channel->{'name'});
+}
+
+sub sig_channel_wholist { # this is actualy a little late, when the names are received would be better
+ my ($channel) = @_;
+ if (Irssi::active_win->{'active'} && Irssi::active_win->{'active'}->{'name'} eq $channel->{'name'}) { # the channel joined is active
+ make_nicklist
+ }
+}
+
+sub sig_join {
+ my ($server,$channel,$nick,$address) = @_;
+ if (!is_active_channel($server,$channel)) {
+ return;
+ }
+ my $newnick = {'nick' => $nick};
+ recalc_nick($newnick);
+ insert_nick($newnick);
+}
+
+sub sig_kick {
+ my ($server, $channel, $nick, $kicker, $address, $reason) = @_;
+ if (!is_active_channel($server,$channel)) {
+ return;
+ }
+ my $nr = find_nick($nick);
+ if ($nr == -1) {
+ Irssi::print("nicklist warning: $nick was kicked from $channel, but not found in nicklist");
+ } else {
+ remove_nick($nr);
+ }
+}
+
+sub sig_part {
+ my ($server,$channel,$nick,$address, $reason) = @_;
+ if (!is_active_channel($server,$channel)) {
+ return;
+ }
+ my $nr = find_nick($nick);
+ if ($nr == -1) {
+ Irssi::print("nicklist warning: $nick has parted $channel, but was not found in nicklist");
+ } else {
+ remove_nick($nr);
+ }
+
+}
+
+sub sig_quit {
+ my ($server,$nick,$address, $reason) = @_;
+ if ($server->{'tag'} ne $active_channel->{'server'}->{'tag'}) {
+ return;
+ }
+ my $nr = find_nick($nick);
+ if ($nr != -1) {
+ remove_nick($nr);
+ }
+}
+
+sub sig_nick {
+ my ($server, $newnick, $oldnick, $address) = @_;
+ if ($server->{'tag'} ne $active_channel->{'server'}->{'tag'}) {
+ return;
+ }
+ my $nr = find_nick($oldnick);
+ if ($nr != -1) { # if nick was found (nickchange is in current channel)
+ my $nick = $nicklist[$nr];
+ remove_nick($nr);
+ $nick->{'nick'} = $newnick;
+ calc_text($nick);
+ insert_nick($nick);
+ }
+}
+
+sub sig_mode {
+ my ($channel, $nick, $setby, $mode, $type) = @_; # (nick and channel as rec)
+ if ($channel->{'server'}->{'tag'} ne $active_channel->{'server'}->{'tag'} || $channel->{'name'} ne $active_channel->{'name'}) {
+ return;
+ }
+ my $nr = find_nick($nick->{'nick'});
+ if ($nr == -1) {
+ Irssi::print("nicklist warning: $nick->{'nick'} had mode set on $channel->{'name'}, but was not found in nicklist");
+ } else {
+ my $nicklist_item = $nicklist[$nr];
+ remove_nick($nr);
+ recalc_nick($nicklist_item, $nick);
+ insert_nick($nicklist_item);
+ }
+}
+
+##### command binds #####
+Irssi::command_bind 'nicklist' => sub {
+ my ( $data, $server, $item ) = @_;
+ $data =~ s/\s+$//g;
+ Irssi::command_runsub ('nicklist', $data, $server, $item ) ;
+};
+Irssi::signal_add_first 'default command nicklist' => sub {
+ # gets triggered if called with unknown subcommand
+ cmd_help();
+};
+Irssi::command_bind('nicklist update',\&update);
+Irssi::command_bind('nicklist help',\&cmd_help);
+Irssi::command_bind('nicklist scroll',\&cmd_scroll);
+Irssi::command_bind('nicklist fifo',\&cmd_fifo_start);
+Irssi::command_bind('nicklist screen',\&cmd_screen_start);
+Irssi::command_bind('nicklist screensize',\&screen_size);
+Irssi::command_bind('nicklist on',\&cmd_on);
+Irssi::command_bind('nicklist off',\&cmd_off);
+Irssi::command_bind('nicklist toggle',\&cmd_toggle);
+
+##### signals #####
+Irssi::signal_add_last('window item changed', \&make_nicklist);
+Irssi::signal_add_last('window changed', \&make_nicklist);
+Irssi::signal_add_last('channel wholist', \&sig_channel_wholist);
+Irssi::signal_add_first('message join', \&sig_join); # first, to be before ignores
+Irssi::signal_add_first('message part', \&sig_part);
+Irssi::signal_add_first('message kick', \&sig_kick);
+Irssi::signal_add_first('message quit', \&sig_quit);
+Irssi::signal_add_first('message nick', \&sig_nick);
+Irssi::signal_add_first('message own_nick', \&sig_nick);
+Irssi::signal_add_first('nick mode changed', \&sig_mode);
+
+Irssi::signal_add('setup changed', \&read_settings);
+
+##### settings #####
+Irssi::settings_add_str('nicklist', 'nicklist_screen_prefix', '\e[m ');
+Irssi::settings_add_str('nicklist', 'nicklist_prefix_mode_op', '\e[32m@\e[39m');
+Irssi::settings_add_str('nicklist', 'nicklist_prefix_mode_halfop', '\e[34m%\e[39m');
+Irssi::settings_add_str('nicklist', 'nicklist_prefix_mode_voice', '\e[33m+\e[39m');
+Irssi::settings_add_str('nicklist', 'nicklist_prefix_mode_normal', ' ');
+Irssi::settings_add_str('nicklist', 'nicklist_prefix_mode_other', '&=\e[31m&\e[39m ~=\e[35m~\e[39m');
+Irssi::settings_add_str('nicklist', 'nicklist_prefix_friends', 'o=\e[32m v=\e[33m noflag=\e[1m');
+
+Irssi::settings_add_int('nicklist', 'nicklist_width',11);
+Irssi::settings_add_int('nicklist', 'nicklist_height',24);
+Irssi::settings_add_str('nicklist', 'nicklist_fifo_path', Irssi::get_irssi_dir . '/nicklistfifo');
+Irssi::settings_add_str('nicklist', 'nicklist_screen_split_windows', '');
+Irssi::settings_add_str('nicklist', 'nicklist_automode', '');
+
+read_settings();
+cmd_on();
diff --git a/scripts/nickmix-c0ffee.pl b/scripts/nickmix-c0ffee.pl
new file mode 100644
index 0000000..203c875
--- /dev/null
+++ b/scripts/nickmix-c0ffee.pl
@@ -0,0 +1,89 @@
+# Nickmix - Perturbates your nick to avoid being collided of be split-riders
+# trying to guess your nick (this normally includes banning them
+# and setting the channel +i)
+#
+
+
+use strict;
+
+use vars qw ($VERSION %IRSSI);
+
+$VERSION = 'v0.1';
+%IRSSI = (
+ name => 'nickmix-c0ffee',
+ authors => 'c0ffee',
+ contact => 'c0ffee@penguin-breeder.org',
+ url => 'http://www.penguin-breeder.org/irssi/',
+ license => 'GPLv2, not later',
+ description => 'Perturbates your nick, use /nickmix nick/len where len is the number of chars you want to keep from your orig nick. use /stopmix to stop. Always issue the commands in a window of the server you want to mix in.'
+ );
+
+
+use Irssi;
+
+
+my %mix;
+my %nick;
+my %len;
+my %servers;
+
+my @valid_chars = (split //, 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789[]{}`_-\\');
+
+sub nickmix {
+ my ($data, $mask, $cnt) = @_;
+
+ $data =~ s/$mask/"$1" . join "", (map { $valid_chars[rand @valid_chars] } (1..$cnt))/e;
+ return $data;
+
+}
+
+sub mixer {
+ my $new_nick;
+
+ $new_nick = nickmix($nick{$_},"(.\{$len{$_}\}).*",length($nick{$_}) - $len{$_}),
+ $servers{$_}->command("NICK $new_nick") foreach (keys %mix);
+
+}
+
+sub cmd_nickmix {
+ my ($data, $server, $channel) = @_;
+
+ Irssi::print("Not connected to a server."), return if not $server;
+
+ if ($data eq "") {
+ Irssi::print "mixing $nick{$_} on $servers{$_}->{chatnet}" foreach (keys %mix);
+ return;
+ }
+
+ Irssi::print("Invalid format: usage: /nickmix nick/keep (keep is an int)"),
+ return if $data !~ /^\S+\/\d+$/;
+
+ $mix{$server->{chatnet}} = $data;
+
+ ($nick{$server->{chatnet}},$len{$server->{chatnet}}) = $data =~ /^(\S+)\/(\d+)$/;
+ $servers{$server->{chatnet}} = $server;
+
+ Irssi::print("Now mixing $nick{$server->{chatnet}} on $server->{chatnet}");
+
+}
+
+sub cmd_stopmix {
+
+ my ($data, $server, $channel) = @_;
+
+ Irssi::print("Not connected to a server."), return if not $server;
+
+
+ Irssi::print("Invalid format: usage: /stopmix"),
+ return if $data !~ /^\s*$/;
+
+ Irssi::print("Stop mixing $nick{$server->{chatnet}} on $server->{chatnet}");
+ delete $mix{$server->{chatnet}};
+}
+
+Irssi::command_bind("stopmix", "cmd_stopmix");
+Irssi::command_bind("nickmix", "cmd_nickmix");
+
+Irssi::print("Nickmix $VERSION loaded...");
+
+Irssi::timeout_add(30000,'mixer',0);
diff --git a/scripts/nickmix_pasky.pl b/scripts/nickmix_pasky.pl
new file mode 100644
index 0000000..572df87
--- /dev/null
+++ b/scripts/nickmix_pasky.pl
@@ -0,0 +1,74 @@
+# Nickmix - Perturbates given nick (or just a word) in certain way.
+#
+# $Id: nickmix.pl,v 1.2 2002/02/09 22:13:12 pasky Exp pasky $
+
+
+use strict;
+
+use vars qw ($VERSION %IRSSI $rcsid);
+
+$rcsid = '$Id: nickmix.pl,v 1.2 2002/02/09 22:13:12 pasky Exp pasky $';
+($VERSION) = '$Revision: 1.2 $' =~ / (\d+\.\d+) /;
+%IRSSI = (
+ name => 'nickmix',
+ authors => 'Petr Baudis',
+ contact => 'pasky@ji.cz',
+ url => 'http://pasky.ji.cz/~pasky/dev/irssi/',
+ license => 'GPLv2, not later',
+ description => 'Perturbates given nick (or just a word) in certain way.'
+ );
+
+
+use Irssi;
+use Irssi::Irc;
+
+
+sub cmd_nickmix {
+ my ($data) = @_;
+ my %letters; # letters hash - value is count of letters
+ my $vstr; # vowels string
+ my $str; # resulting string
+
+ # First load the whole thing into letters hash
+ map { $letters{$_}++; } split(//, $data);
+
+ # Now take the (most of/all) vowels away and compose string from them
+ foreach (qw(a e i o u y)) {
+ my $c = int rand($letters{$_} * 4 + 1);
+
+ $c = $letters{$_} if ($c > $letters{$_});
+ $letters{$_} -= $c;
+
+ for (; $c; $c--) {
+ # Either add or prepend
+ if (rand(2) < 1) {
+ $vstr .= $_;
+ } else {
+ $vstr = $_ . $vstr;
+ }
+ }
+ }
+
+ # Position of the $vstr..
+ my $vpos = int rand (3);
+
+ $str = $vstr if (not $vpos);
+
+ # Now take the rest and do the same ;)
+ foreach (keys %letters) { for (; $letters{$_}; $letters{$_}--) {
+ # Either add or prepend
+ if (rand(2) < 1) {
+ $str .= $_;
+ } else {
+ $str = $_ . $str;
+ }
+ } }
+
+ if ($vpos == 1) { $str .= $vstr; } elsif ($vpos == 2) { $str = $vstr . $str; }
+
+ Irssi::print "$data -> $str";
+}
+
+Irssi::command_bind("nickmix", "cmd_nickmix");
+
+Irssi::print("Nickmix $VERSION loaded...");
diff --git a/scripts/nickserv.pl b/scripts/nickserv.pl
new file mode 100644
index 0000000..d9d0093
--- /dev/null
+++ b/scripts/nickserv.pl
@@ -0,0 +1,684 @@
+#!/usr/bin/perl -w
+
+## Bugreports and Licence disclaimer.
+#
+# For bugreports and other improvements contact Geert Hauwaerts <geert@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+##
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.12";
+
+%IRSSI = (
+ authors => 'Geert Hauwaerts',
+ contact => 'geert@irssi.org',
+ name => 'nickserv.pl',
+ description => 'This script will authorize you into NickServ.',
+ license => 'GNU General Public License',
+ url => 'https://github.com/irssi/scripts.irssi.org/blob/master/scripts/nickserv.pl',
+ changed => 'Wed Jun 27 19:23 CEST 2018',
+);
+
+my $irssidir = Irssi::get_irssi_dir();
+
+my @nickservnet = ();
+my $nickservnet_file = "$irssidir/nickserv.networks";
+
+my @nickservauth = ();
+my $nickservauth_file = "$irssidir/nickserv.auth";
+
+my @nickservpostcmd = ();
+my $nickservpostcmd_file = "$irssidir/nickserv.postcmd";
+
+my $help = <<EOF;
+
+Usage: (all on one line)
+/NICKSERV [addnet <ircnet> <services\@host>]
+ [addnick <ircnet> <nickname> <password>]
+ [addpostcmd <ircnet> <nickname> <command>]
+ [delnet <ircnet>]
+ [delnick <ircnet> <nick>]
+ [delpostcmd <ircnet> <nick>]
+ [help listnet listnick listpostcmd]
+
+addnet: Add a new network into the NickServ list.
+addnick: Add a new nickname into the NickServ list.
+addpostcmd: Add a new post auth command for nickname into the NickServ list.
+delnet: Delete a network from the NickServ list.
+delnick: Delete a nickname from the NickServ list.
+delpostcmd: Deletes all post auth commands for the given nickame.
+listnet: Display the contents of the NickServ network list.
+listnick: Display the contents of the NickServ nickname list.
+listpostcmd: Display the contents of the NickServ postcmd list.
+help: Display this useful little helptext.
+
+Examples: (all on one line)
+/NICKSERV addnet Freenode NickServ\@services.
+/NICKSERV addnick Freenode Geert mypass
+/NICKSERV addpostcmd Freenode Geert ^MSG ChanServ invite #heaven
+
+/NICKSERV delnet Freenode
+/NICKSERV delnick Freenode Geert
+
+Note: This script doesn't allow wildcards into the NickServ hostname. You must use the full services\@host.
+ Both /NICKSERV and /NS are valid commands.
+EOF
+
+Irssi::theme_register([
+ 'nickserv_usage_network', '%R>>%n %_NickServ:%_ Insufficient parameters: Usage "%_/NICKSERV addnet ircnet services@host%_".',
+ 'nickserv_usage_nickname', '%R>>%n %_NickServ:%_ Insufficient parameters: Usage "%_/NICKSERV addnick ircnet nickname password%_".',
+ 'nickserv_usage_postcmd', '%R>>%n %_NickServ:%_ Insufficient parameters: Usage "%_/NICKSERV addpostcmd ircnet nickname command%_".',
+ 'nickserv_delusage', '%R>>%n %_NickServ:%_ Insufficient parameters: Usage "%_/NICKSERV delnet ircnet%_".',
+ 'nickserv_delnickusage', '%R>>%n %_NickServ:%_ Insufficient parameters: Usage "%_/NICKSERV delnick ircnet nickname%_".',
+ 'nickserv_delpostcmdusage', '%R>>%n %_NickServ:%_ Insufficient parameters: Usage "%_/NICKSERV delpostcmd ircnet nickname%_".',
+ 'nickserv_delled', '%R>>%n %_NickServ:%_ Deleted %_$0%_ and it\'s nicknames and post commands from the NickServ ircnet list.',
+ 'nickserv_delled_nick', '%R>>%n %_NickServ:%_ Deleted %_$1%_ and it\'s post commands from the NickServ list on $0.',
+ 'nickserv_delled_postcmd', '%R>>%n %_NickServ:%_ Deleted all entries for %_$1%_ from the NickServ postcmd list on $0.',
+ 'nickserv_nfound', '%R>>%n %_NickServ:%_ The NickServ ircnet %_$0%_ could not be found.',
+ 'nickserv_nfound_nick', '%R>>%n %_NickServ:%_ The NickServ nickname %_$0%_ could not be found on $1.',
+ 'nickserv_nfound_postcmd', '%R>>%n %_NickServ:%_ The NickServ post commands for nickname %_$1%_ could not be found on $0.',
+ 'nickserv_usage', '%R>>%n %_NickServ:%_ Insufficient parameters: Use "%_/NICKSERV help%_" for further instructions.',
+ 'nickserv_no_net', '%R>>%n %_NickServ:%_ Unknown Irssi ircnet %_$0%_.',
+ 'nickserv_wrong_host', '%R>>%n %_NickServ:%_ Malformed services hostname %_$0%_.',
+ 'already_loaded_network', '%R>>%n %_NickServ:%_ The ircnet %_$0%_ already exists in the NickServ ircnet list, please remove it first.',
+ 'nickserv_loaded_nick', '%R>>%n %_NickServ:%_ The nickname %_$0%_ already exists in the NickServ authlist on %_$1%_, please remove it first.',
+ 'nickserv_not_loaded_net', '%R>>%n %_NickServ:%_ The ircnet %_$0%_ doesn\'t exists in the NickServ ircnet list, please add it first.',
+ 'nickserv_not_loaded_nick', '%R>>%n %_NickServ:%_ The nickname %_$0%_ doesn\'t exists in the NickServ authlist on %_$1%_, please add it first.',
+ 'saved_nickname', '%R>>%n %_NickServ:%_ Added nickname %_$1%_ on %_$0%_.',
+ 'saved_postcmd', '%R>>%n %_NickServ:%_ Added postcmd %_$1%_ on %_$0%_: %_%2%_.',
+ 'network_print', '$[!-2]0 $[20]1 $2',
+ 'password_request', '%R>>%n %_NickServ:%_ Auth Request from NickServ on %_$0%_.',
+ 'password_accepted', '%R>>%n %_NickServ:%_ Password accepted on %_$0%_.',
+ 'password_wrong', '%R>>%n %_NickServ:%_ Password denied on %_$0%_. Please change the password.',
+ 'network_info', '%_ # Ircnet Services hostname%_',
+ 'network_empty', '%R>>%n %_NickServ:%_ Your NickServ ircnet list is empty.',
+ 'nickname_print', '$[!-2]0 $[20]1 $[18]2 $3',
+ 'nickname_info', '%_ # Ircnet Nickname Password%_',
+ 'nickname_empty', '%R>>%n %_NickServ:%_ Your NickServ authlist is empty.',
+ 'postcmd_print', '$[!-2]0 $[20]1 $[18]2 $3',
+ 'postcmd_info', '%_ # Ircnet Nickname Postcmd%_',
+ 'postcmd_empty', '%R>>%n %_NickServ:%_ Your NickServ postcmd list is empty.',
+ 'nickserv_help', '$0',
+ 'saved_network', '%R>>%n %_NickServ:%_ Added services mask "%_$1%_" on %_$0%_.',
+ 'nickserv_loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.'
+]);
+
+sub load_nickservnet {
+
+ my ($file) = @_;
+
+ @nickservnet = load_file($file, sub {
+ my $new_nsnet = new_nickserv_network(@_);
+ return undef if ($new_nsnet->{name} eq "" || $new_nsnet->{host} eq "");
+ return $new_nsnet;
+ });
+}
+
+sub save_nickservnet {
+
+ save_file($nickservnet_file, \@nickservnet, \&nickservnet_as_list);
+}
+
+sub new_nickserv_network {
+
+ return {
+ name => shift,
+ host => shift
+ };
+}
+
+sub nickservnet_as_list {
+
+ my $nickserv_net = shift;
+
+ return (
+ $nickserv_net->{name},
+ $nickserv_net->{host}
+ );
+}
+
+sub load_nickservnick {
+
+ my ($file) = @_;
+
+ @nickservauth = load_file($file, sub {
+ my $new_nsnick = new_nickserv_nick(@_);
+
+ return undef if ($new_nsnick->{ircnet} eq "" || $new_nsnick->{nick} eq "" || $new_nsnick->{pass} eq "");
+ return $new_nsnick;
+ });
+}
+
+sub save_nickservnick {
+
+ save_file($nickservauth_file, \@nickservauth, \&nickserv_nick_as_list);
+}
+
+sub new_nickserv_nick {
+
+ return {
+ ircnet => shift,
+ nick => shift,
+ pass => shift
+ };
+}
+
+sub nickserv_nick_as_list {
+
+ my $nickserv_nick = shift;
+ return (
+ $nickserv_nick->{ircnet},
+ $nickserv_nick->{nick},
+ $nickserv_nick->{pass}
+ );
+}
+
+sub load_nickservpostcmd {
+
+ my ($file) = @_;
+
+ @nickservpostcmd = load_file($file, sub {
+ my $new_postcmd = new_postcmd(@_);
+
+ return undef if ($new_postcmd->{ircnet} eq "" || $new_postcmd->{nick} eq "" || $new_postcmd->{postcmd} eq "");
+ return $new_postcmd;
+ });
+}
+
+sub save_nickservpostcmd {
+
+ save_file($nickservpostcmd_file, \@nickservpostcmd, \&postcmd_as_list);
+}
+
+sub new_postcmd {
+
+ return {
+ ircnet => shift,
+ nick => shift,
+ postcmd => shift
+ };
+}
+
+sub postcmd_as_list {
+ my $postcmd = shift;
+
+ return (
+ $postcmd->{ircnet},
+ $postcmd->{nick},
+ $postcmd->{postcmd}
+ );
+}
+
+# file: filename to be read
+# parse_line_fn: receives array of entries of a single line as input, should
+# return parsed data object or undef in the data is incomplete
+# returns: parsed data array
+sub load_file {
+
+ my ($file, $parse_line_fn) = @_;
+ my @parsed_data = ();
+
+ if (-e $file) {
+ open(my $fh, "<", $file);
+ local $/ = "\n";
+
+ while (<$fh>) {
+ chomp;
+ my $data = $parse_line_fn->(split("\t"));
+ push(@parsed_data, $data) if $data;
+ }
+
+ close($fh);
+ }
+
+ return @parsed_data;
+}
+
+# file: filename to be written, is created accessable only by the user
+# data_ref: array ref of data entries
+# serialize_fn: receives a data reference and should return an array or tuples
+# for that data that will be serialized into one line
+sub save_file {
+
+ my ($file, $data_ref, $serialize_fn) = @_;
+
+ create_private_file($file) unless -e $file;
+
+ open(my $fh, ">", $file) or die "Can't create $file. Reason: $!";
+
+ for my $data (@$data_ref) {
+ print($fh join("\t", $serialize_fn->($data)), "\n");
+ }
+
+ close($fh);
+}
+
+sub create_private_file {
+
+ my ($file) = @_;
+ my $umask = umask 0077; # save old umask
+ open(my $fh, ">", $file) or die "Can't create $file. Reason: $!";
+ close($fh);
+ umask $umask;
+}
+
+sub add_nickname {
+
+ my ($network, $nickname, $password) = split(" ", $_[0], 3);
+ my ($correct_network, $correct_nickname);
+
+ if ($network eq "" || $nickname eq "" || $password eq "") {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_usage_nickname');
+ return;
+ }
+
+ if ($network) {
+ if (!already_loaded_net($network)) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_not_loaded_net', $network);
+ return;
+ } else {
+ $correct_network = 1;
+ }
+ }
+
+ if ($nickname) {
+ if (already_loaded_nick($nickname, $network)) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_loaded_nick', $nickname, $network);
+ return;
+ } else {
+ $correct_nickname = 1;
+ }
+ }
+
+ if ($correct_network && $correct_nickname) {
+ push(@nickservauth, new_nickserv_nick($network, $nickname, $password));
+ save_nickservnick();
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'saved_nickname', $network, $nickname);
+ }
+}
+
+sub add_postcmd {
+
+ my ($network, $nickname, $postcmd) = split(" ", $_[0], 3);
+ my ($correct_network, $correct_nickname);
+
+ if ($network eq "" || $nickname eq "" || $postcmd eq "") {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_usage_postcmd');
+ return;
+ }
+
+ if ($network) {
+ if (!already_loaded_net($network)) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_not_loaded_net', $network);
+ return;
+ } else {
+ $correct_network = 1;
+ }
+ }
+
+ if ($nickname) {
+ if (!already_loaded_nick($nickname, $network)) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_not_loaded_nick', $nickname, $network);
+ return;
+ } else {
+ $correct_nickname = 1;
+ }
+ }
+
+ if ($correct_network && $correct_nickname) {
+ push(@nickservpostcmd, new_postcmd($network, $nickname, $postcmd));
+ save_nickservpostcmd();
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'saved_postcmd', $network, $nickname, $postcmd);
+ }
+}
+
+sub add_network {
+
+ my ($network, $hostname) = split(" ", $_[0], 2);
+ my ($correct_net, $correct_host);
+
+ if ($network eq "" || $hostname eq "") {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_usage_network');
+ return;
+ }
+
+ if ($network) {
+ my ($ircnet) = Irssi::chatnet_find($network);
+
+ if (!$ircnet) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_no_net', $network);
+ return;
+ } elsif (already_loaded_net($network)) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'already_loaded_network', $network);
+ return;
+ } else {
+ $correct_net = 1;
+ }
+ }
+
+ if ($hostname) {
+ if ($hostname !~ /^[.+a-zA-Z0-9_-]{1,}@[.+a-zA-Z0-9_-]{1,}$/) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_wrong_host', $hostname);
+ return;
+ } else {
+ $correct_host = 1;
+ }
+ }
+
+ if ($correct_net && $correct_host) {
+ push(@nickservnet, new_nickserv_network($network, $hostname));
+ save_nickservnet();
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'saved_network', $network, $hostname);
+ }
+}
+
+sub already_loaded_net {
+
+ my ($ircnet) = @_;
+
+ $ircnet = lc($ircnet);
+
+ for my $loaded (@nickservnet) {
+ return 1 if (lc($loaded->{name}) eq $ircnet);
+ }
+
+ return 0;
+}
+
+sub already_loaded_nick {
+ my ($nickname, $network) = @_;
+
+ $nickname = lc($nickname);
+ $network = lc($network);
+
+ for my $loaded (@nickservauth) {
+ return 1 if (lc($loaded->{nick}) eq $nickname &&
+ lc($loaded->{ircnet}) eq $network);
+ }
+
+ return 0;
+}
+
+sub list_net {
+
+ if (@nickservnet == 0) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'network_empty');
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'network_info');
+
+ for (my $n = 0; $n < @nickservnet ; ++$n) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'network_print', $n, $nickservnet[$n]->{name}, $nickservnet[$n]->{host});
+ }
+ }
+}
+
+sub list_nick {
+
+ if (@nickservauth == 0) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickname_empty');
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickname_info');
+
+ for (my $n = 0; $n < @nickservauth ; ++$n) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickname_print', $n, $nickservauth[$n]->{ircnet}, $nickservauth[$n]->{nick}, "*" x length($nickservauth[$n]->{pass}));
+ }
+ }
+}
+
+sub list_postcmd {
+
+ if (@nickservpostcmd == 0) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'postcmd_empty');
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'postcmd_info');
+
+ for (my $n = 0; $n < @nickservpostcmd ; ++$n) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'postcmd_print', $n, $nickservpostcmd[$n]->{ircnet}, $nickservpostcmd[$n]->{nick}, $nickservpostcmd[$n]->{postcmd});
+ }
+ }
+}
+
+sub nickserv_notice {
+
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $text) = $data =~ /^(\S*)\s:(.*)/;
+
+ if (is_nickserv($server->{tag}, $address)) {
+ $text =~ s/[[:cntrl:]]+//g; # remove control crap
+
+ if ($text =~ /^(?:\(?If this is your nick(?:name)?, type|Please identify via|Type) \/msg NickServ (?i:identify)/ || $text =~ /^This nickname is registered and protected. If it is your/ || $text =~ /This nickname is registered\. Please choose a different nickname/) {
+ my $password = get_password($server->{tag}, $server->{nick});
+
+ if ($password == -1) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'password_request', $server->{tag});
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_nfound_nick', $server->{nick}, $server->{tag});
+ Irssi::signal_stop();
+ return;
+ }
+
+ Irssi::signal_stop();
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'password_request', $server->{tag});
+ $server->command("^MSG NickServ IDENTIFY $password");
+ } elsif ($text =~ /If this is your nickname, type \/NickServ/) {
+ my $password = get_password($server->{tag}, $server->{nick});
+
+ if ($password == -1) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'password_request', $server->{tag});
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_nfound_nick', $server->{nick}, $server->{tag});
+ Irssi::signal_stop();
+ return;
+ }
+
+ Irssi::signal_stop();
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'password_request', $server->{tag});
+ $server->command("^QUOTE NickServ :IDENTIFY $password");
+ } elsif ($text =~ /If this is your nickname, type \/msg NS/) {
+ my $password = get_password($server->{tag}, $server->{nick});
+
+ if ($password == -1) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'password_request', $server->{tag});
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_nfound_nick', $server->{nick}, $server->{tag});
+ Irssi::signal_stop();
+ return;
+ }
+
+ Irssi::signal_stop();
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'password_request', $server->{tag});
+ $server->command("^MSG NS IDENTIFY $password");
+ } elsif ($text =~ /If you do not (.*) within one minute, you will be disconnected/) {
+ Irssi::signal_stop();
+ } elsif ($text =~ /^This nickname is owned by someone else/) {
+ Irssi::signal_stop();
+ } elsif ($text =~ /^nick, type (.*) Otherwise,/) {
+ Irssi::signal_stop();
+ } elsif ($text =~ /^please choose a different nick./) {
+ Irssi::signal_stop();
+ } elsif ($text =~ /^You have already identified/ || $text =~ /^This nick is already identified./ || $text =~ /^You are already logged in as/) {
+ Irssi::signal_stop();
+ } elsif ($text =~ /^Password accepted - you are now recognized/ || $text =~ /^You are now identified for/) {
+ Irssi::signal_stop();
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'password_accepted', $server->{tag});
+ run_postcmds($server, $server->{tag}, $server->{nick})
+ } elsif ($text =~ /^Password Incorrect/ || $text =~ /^Password incorrect./) {
+ Irssi::signal_stop();
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'password_wrong', $server->{tag});
+ }
+ }
+}
+
+sub run_postcmds {
+ my ($server, $ircnet, $nick) = @_;
+ return if @nickservpostcmd == 0;
+
+ for my $cmd (@nickservpostcmd) {
+ if ($ircnet eq $cmd->{ircnet} &&
+ $nick eq $cmd->{nick} &&
+ $cmd->{postcmd}) {
+ $server->command($cmd->{postcmd});
+ }
+ }
+}
+
+sub is_nickserv {
+
+ my ($net, $host) = @_;
+
+ for (my $loaded = 0; $loaded < @nickservnet; ++$loaded) {
+ return 1 if (lc($nickservnet[$loaded]->{name}) eq lc($net) &&
+ lc($nickservnet[$loaded]->{host}) eq lc($host));
+ }
+ return 0;
+}
+
+sub get_password {
+
+ my ($ircnet, $nick) = @_;
+
+ for (my $loaded = 0; $loaded < @nickservauth; ++$loaded) {
+ return $nickservauth[$loaded]->{pass} if (lc($nickservauth[$loaded]->{ircnet}) eq lc($ircnet) &&
+ lc($nickservauth[$loaded]->{nick}) eq lc($nick));
+ }
+
+ return -1;
+}
+
+sub del_network {
+
+ my ($ircnet) = split(" ", $_[0], 1);
+ my ($ircnetindex);
+
+ if ($ircnet eq "") {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_delusage');
+ return;
+ }
+
+ for (my $index = 0; $index < @nickservnet; ++$index) {
+ if (lc($nickservnet[$index]->{name}) eq lc($ircnet)) {
+ $ircnetindex = 1;
+ }
+ }
+
+ if ($ircnetindex) {
+ @nickservnet = grep {lc($_->{name}) ne lc($ircnet)} @nickservnet;
+ @nickservauth = grep {lc($_->{ircnet}) ne lc($ircnet)} @nickservauth;
+ @nickservpostcmd = grep {lc($_->{ircnet}) ne lc($ircnet)} @nickservpostcmd;
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_delled', $ircnet);
+ save_nickservnet();
+ save_nickservnick();
+ save_nickservpostcmd();
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_nfound', $ircnet);
+ }
+}
+
+sub del_nickname {
+
+ my ($ircnet, $nickname) = split(" ", $_[0], 2);
+ my ($nickindex);
+
+ if ($ircnet eq "" || $nickname eq "") {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_delnickusage');
+ return;
+ }
+
+ for (my $index = 0; $index < @nickservauth; ++$index) {
+ if (lc($nickservauth[$index]->{ircnet}) eq lc($ircnet) &&
+ lc($nickservauth[$index]->{nick}) eq lc($nickname)) {
+ $nickindex = splice(@nickservauth, $index, 1);
+ }
+ }
+
+ if ($nickindex) {
+ @nickservpostcmd = grep {lc($_->{ircnet}) ne lc($ircnet) ||
+ lc($_->{nick}) ne lc($nickname)}
+ @nickservpostcmd;
+
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_delled_nick', $ircnet, $nickname);
+ save_nickservnick();
+ save_nickservpostcmd();
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_nfound_nick', $ircnet, $nickname);
+ }
+}
+
+sub del_postcmd {
+
+ my ($ircnet, $nickname) = split(" ", $_[0], 2);
+
+ if ($ircnet eq "" || $nickname eq "") {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_delpostcmdusage');
+ return;
+ }
+
+ my $size_before = scalar(@nickservpostcmd);
+ @nickservpostcmd = grep { !( lc($_->{ircnet}) eq lc($ircnet) && lc($_->{nick}) eq lc($nickname) )} @nickservpostcmd;
+ my $size_after = scalar(@nickservpostcmd);
+
+ if ($size_before != $size_after) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_delled_postcmd', $ircnet, $nickname);
+ save_nickservpostcmd();
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_nfound_postcmd', $ircnet, $nickname);
+ }
+}
+
+sub nickserv_runsub {
+
+ my ($data, $server, $item) = @_;
+ $data =~ s/\s+$//g;
+
+ if ($data) {
+ Irssi::command_runsub('nickserv', $data, $server, $item);
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_usage');
+ }
+}
+
+load_nickservnet($nickservnet_file);
+load_nickservnick($nickservauth_file);
+load_nickservpostcmd($nickservpostcmd_file);
+
+Irssi::command_bind('nickserv', 'nickserv_runsub');
+Irssi::command_bind('ns', 'nickserv_runsub');
+
+Irssi::command_bind('nickserv help' => sub { Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_help', $help) });
+Irssi::command_bind('ns help' => sub { Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_help', $help) });
+
+# "command binding" -> "function name" mapping
+for my $cmd ((
+ ['addnet' => 'add_network'],
+ ['addnick' => 'add_nickname'],
+ ['addpostcmd' => 'add_postcmd'],
+ ['listnet' => 'list_net'],
+ ['listnick' => 'list_nick'],
+ ['listpostcmd' => 'list_postcmd'],
+ ['delnet' => 'del_network'],
+ ['delnick' => 'del_nickname'],
+ ['delpostcmd' => 'del_postcmd'],
+)) {
+ Irssi::command_bind("nickserv $cmd->[0]", $cmd->[1]);
+ Irssi::command_bind("ns $cmd->[0]", $cmd->[1]);
+}
+
+Irssi::signal_add('event notice', 'nickserv_notice');
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'nickserv_loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
diff --git a/scripts/niq.pl b/scripts/niq.pl
new file mode 100644
index 0000000..ffc71f8
--- /dev/null
+++ b/scripts/niq.pl
@@ -0,0 +1,296 @@
+# BitchX TAB complete style
+# for irssi 0.7.99 by bd@bc-bd.org
+#
+# <tab> signal handling learned from dictcomplete by Timo Sirainen
+#
+# thx go out to fuchs, darix, dg, peder and all on #irssi who helped
+#
+#########
+# USAGE
+###
+#
+# In a channel window type "ab<tab>" to see a list of nicks starting
+# with "ab".
+# If you now press <tab> again, irssi will default to its own nick
+# completion method.
+# If you enter more characters you can use <tab> again to see a list
+# of the matching nicks, or to complete the nick if there is only
+# one matching.
+#
+# The last completion is saved so if you press "<tab>" with an empty
+# input line, you get the last completed nick.
+#
+# Now there is a statusbar item where you can see the completing
+# nicks instead of in the channel window. There are two ways to
+# use it:
+#
+# 1) Inside another statusbar
+#
+# /set niq_show_in_statusbar ON
+# /statusbar window add -before more niq
+#
+# 2) In an own statusbar
+#
+# /statusbar niq enable
+# /statusbar niq add niq
+# /statusbar niq disable
+# /set niq_show_in_statusbar ON
+# /set niq_own_statusbar ON
+#
+# You can also hide the bar when not completing nicks by using
+#
+# /set niq_hide_on_inactive ON
+#
+#########
+# OPTIONS
+#########
+#
+# /set niq_show_in_statusbar <ON|OFF>
+# * ON : show the completing nicks in a statusbar item
+# * OFF : show the nicks in the channel window
+#
+# /set niq_own_statusbar <ON|OFF>
+# * ON : use an own statusbar for the nicks
+# * OFF : just use an item
+#
+# /set niq_hide_on_inactive <ON|OFF>
+# * ON : hide the own statusbar on inactivity
+# * OFF : dont hide it
+#
+# /set niq_color_char <ON|OFF>
+# * ON : colors the next unlikely character
+# * OFF : boring no colors
+#
+###
+################
+###
+# Changelog
+#
+# Version 0.5.7
+# - use configured completion_char instead of a colon
+# - removed old, unused code
+# - fixed url
+# - fixed documentation leading to emtpy statusbar
+# - removed warning about a problem with irssi version 0.8.4
+#
+# Version 0.5.6
+# - work around an use problem
+#
+# Version 0.5.5
+# - fixed completion for nicks starting with special chars
+#
+# Version 0.5.4
+# - removed unneeded sort() of colored nicks
+# - moved colored nick generation to where it is needed
+# - the statusbar only worked with colorized nicks (duh!)
+#
+# Version 0.5.3
+# - stop nickcompleting if last char is the completion_char
+# which is in most cases ':'
+#
+# Version 0.5.2
+# - fixed vanishing statusbar. it wrongly was reset on any
+# privmsg.
+#
+# Version 0.5.1
+# - changed statusbar to be off by default since most people
+# dont use the latest fixed version.
+#
+# Version 0.5
+# - added own statusbar option
+# - added color char option
+#
+# Version 0.4
+# - added an niq statusbar
+#
+# Version 0.3
+# - added default to irssi method on <tab><tab>
+#
+# Version 0.2
+# - added lastcomp support
+#
+# Version 0.1
+# - initial release
+###
+################
+
+use Irssi;
+use Irssi::TextUI;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION="0.5.7";
+%IRSSI = (
+ authors=> 'BC-bd',
+ contact=> 'bd@bc-bd.org',
+ name=> 'niq',
+ description=> 'BitchX like Nickcompletion at line start plus statusbar',
+ sbitems=> 'niq',
+ license=> 'GPL v2',
+ url=> 'https://bc-bd.org/cgi-bin/gitweb.cgi?p=irssi.git;a=summary',
+);
+
+my($lastword,$lastcomp,$niqString);
+
+$lastcomp = "";
+$lastword = "";
+
+# build our nick with completion_char, add to complist and stop the signal
+sub buildNickAndStop {
+ my ($complist,$nick) = @_;
+ my $push = $nick.Irssi::settings_get_str('completion_char');
+
+ $lastcomp = $nick;
+ $lastword = "";
+ push (@{$complist}, $push);
+
+ if (Irssi::settings_get_bool('niq_show_in_statusbar') == 1) {
+ drawStatusbar("");
+ }
+
+ Irssi::signal_stop();
+}
+
+# the signal handler
+sub sig_complete {
+ my ($complist, $window, $word, $linestart, $want_space) = @_;
+
+ # still allow channel- #<tab>, /set n<tab>, etc completion.
+ if ($linestart ne "") {
+ return;
+ }
+
+ # also back out if nothing has been entered and lastcomp is ""
+ if ($word eq "") {
+ if ($lastcomp ne "") {
+ buildNickAndStop($complist,$lastcomp);
+ return;
+ } else {
+ return;
+ }
+ }
+ if (rindex($word,Irssi::settings_get_str('completion_char')) == length($word) -1) {
+ chop($word);
+ buildNickAndStop($complist,$word,0);
+ return;
+ }
+
+ my $channel = $window->{active};
+
+ # the completion is ok if this is a channel
+ if ($channel->{type} ne "CHANNEL")
+ {
+ return;
+ }
+
+ my (@nicks);
+
+ # get the matching nicks but quote this l33t special chars like ^
+ my $shortestNick = 999;
+ my $quoted = quotemeta $word;
+ foreach my $n ($channel->nicks()) {
+ if ($n->{nick} =~ /^$quoted/i && $window->{active_server}->{nick} ne $n->{nick}) {
+ push(@nicks,$n->{nick});
+ if (length($n->{nick}) < $shortestNick) {
+ $shortestNick = length($n->{nick});
+ }
+ }
+ }
+
+ @nicks = sort(@nicks);
+
+ # if theres only one nick return it.
+ if (scalar @nicks eq 1)
+ {
+ buildNickAndStop($complist,$nicks[0]);
+ } elsif (scalar @nicks gt 1) {
+ # check if this is <tab> or <tab><tab>
+ if ($lastword eq $word) {
+ # <tab><tab> so default to the irssi method
+ sort(@nicks);
+ for (@nicks) {
+ $_ .= Irssi::settings_get_str ('completion_char');
+ }
+
+ push (@{$complist}, @nicks);
+
+ # but delete lastword to be ready for the next <tab>
+ $lastword = "";
+
+ if (Irssi::settings_get_bool('niq_show_in_statusbar') == 1) {
+ drawStatusbar("");
+ }
+
+ return;
+ } else {
+ # <tab> only so just print
+
+ # build string w/o colored nicks
+ if (Irssi::settings_get_bool('niq_color_char') == 1) {
+ $niqString = "";
+ foreach my $n (@nicks) {
+ my $coloredNick = $n;
+ $coloredNick =~ s/($quoted)(.)(.*)/$1%_$2%_$3/i;
+ $niqString .= "$coloredNick ";
+ }
+ } else {
+ $niqString = join(" ",@nicks);
+ }
+
+ if (Irssi::settings_get_bool('niq_show_in_statusbar') == 1) {
+ drawStatusbar($niqString);
+ } else {
+ $window->print($niqString);
+ }
+
+ Irssi::signal_stop();
+
+ # remember last word
+ $lastword = $word;
+
+ return;
+ }
+ }
+}
+
+sub emptyBar() {
+ $lastword = "";
+
+ drawStatusbar("");
+}
+
+sub drawStatusbar() {
+ my ($word) = @_;
+
+ if (Irssi::settings_get_bool('niq_own_statusbar') == 1) {
+ if (Irssi::settings_get_bool('niq_hide_on_inactive') == 1) {
+ if ($word eq "") {
+ Irssi::command("statusbar niq disable");
+ } else {
+ Irssi::command("statusbar niq enable");
+ }
+ }
+ }
+
+ $niqString = "{sb $word}";
+ Irssi::statusbar_items_redraw('niq');
+}
+
+sub niqStatusbar() {
+ my ($item, $get_size_only) = @_;
+
+ $item->default_handler($get_size_only, $niqString, undef, 1);
+}
+
+Irssi::signal_add_first('complete word', 'sig_complete');
+Irssi::signal_add_last('window changed', 'emptyBar');
+Irssi::signal_add('message own_public', 'emptyBar');
+
+Irssi::statusbar_item_register('niq', '$0', 'niqStatusbar');
+Irssi::statusbars_recreate_items();
+
+Irssi::settings_add_bool('misc', 'niq_show_in_statusbar', 0);
+Irssi::settings_add_bool('misc', 'niq_own_statusbar', 0);
+Irssi::settings_add_bool('misc', 'niq_hide_on_inactive', 1);
+Irssi::settings_add_bool('misc', 'niq_color_char', 1);
diff --git a/scripts/nocaps.pl b/scripts/nocaps.pl
new file mode 100644
index 0000000..1520392
--- /dev/null
+++ b/scripts/nocaps.pl
@@ -0,0 +1,96 @@
+# nocaps.pl
+#
+# Stops people SHOUTING ON IRC
+#
+# Settings:
+# caps_replace: How to notify you something was changed. Default is
+# "<caps>text</caps>". 'text' is replaced with what they said.
+# caps_sensitivity: If the line is this shorter than this, all caps is
+# allowed. Default = 6
+# caps_percent: If the line has more than this percent caps in it, it's
+# transformed to lowercase. Default = 80.
+#
+# Thanks to Johan "Ion" Kiviniemi from #irssi for some of the stuff
+#
+# Example output (all these lines were all caps originally):
+# [@NoTopic] Boomskdfhh£$(&* [caps]
+# [@NoTopic] Boomfdkjh. Kdfhkdf. Kddkh. [caps]
+# [@NoTopic] Jamesoff: Boom*£&$&*£hdfjkhjfksdfljdksjgfkj*&^£* [caps]
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+
+$VERSION = '1.01';
+%IRSSI = (
+ authors => 'JamesOff, Ion',
+ contact => 'james@jamesoff.net',
+ name => 'nocaps',
+ description => 'Replaces lines in ALL CAPS with something easier on the eyes',
+ license => 'Public Domain',
+ url => 'http://www.jamesoff.net',
+ changed => '22 March 2002 12:34:38',
+);
+
+
+sub isAllCaps {
+ my ($msg) = @_;
+ #strip out everything that's not letters
+ $msg =~ s/[^A-Za-z]+//g;
+
+ #msgs with no letters in are a waste of time
+ return 0 if (!length($msg));
+ my $capsonly = $msg;
+
+ #only caps
+ $capsonly =~ s/[^A-Z]+//g;
+
+ #if it's all caps and less than caps_sensitivity, return 0
+ my $minimum = Irssi::settings_get_str('caps_sensitivity');
+ return 0 if ((length($capsonly) < $minimum));
+
+ #check percentage
+ my $percentage = Irssi::settings_get_str('caps_percent');
+ if (((length($capsonly) / length($msg)) * 100) > $percentage) {
+ #too many caps!
+ return 1;
+ }
+
+ return 0;
+}
+
+#main event handler
+sub caps_message {
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $msg) = split(/ :/, $data,2);
+
+ if (isAllCaps($msg)) {
+ #bleh, a line in ALL CAPS£*$&(*(£$&
+ $msg =~ tr/A-Z/a-z/;
+
+ # foo bar biz. blah quux. -> Foo bar biz. Blah quux.
+ $msg =~ s/(^\s*|[.!?]\s+)(\w)/$1 . uc $2/eg;
+
+ # Nick: hello -> Nick: Hello.
+ $msg =~ s/^(\S+:\s*)(\w)/$1 . uc $2/e;
+
+ #:<d|p|o> --> capital letter (for |Saruman| )
+ $msg =~ s/([=:;][dpo])/uc $1/eg;
+
+ my $replacement = Irssi::settings_get_str('caps_replace');
+ $replacement =~ s/text/$msg/;
+
+ #re-emit the signal to make Irssi display it
+ Irssi::signal_emit('event privmsg', ($server, "$target :$replacement", $nick, $address));
+ #and stop
+ Irssi::signal_stop();
+ }
+}
+
+Irssi::signal_add('event privmsg', 'caps_message');
+
+Irssi::settings_add_str('misc', 'caps_replace', "<caps>text</caps>");
+Irssi::settings_add_str('misc', 'caps_sensitivity', "6");
+Irssi::settings_add_str('misc', 'caps_percent', "80");
diff --git a/scripts/nocollide.pl b/scripts/nocollide.pl
new file mode 100644
index 0000000..d2f8177
--- /dev/null
+++ b/scripts/nocollide.pl
@@ -0,0 +1,118 @@
+#
+# This script will change your nickname if in given time (/SET collision_time [seconds])
+# there are more than specific number of collisions (/SET collision_count [number]) on
+# single channel. After change next nick collisions are ignored for given time
+# (/SET collsion_ignore [seconds]).
+# Settings:
+# /SET collision_avoid [On/Off] (default is on, if off - action disabled)
+# /SET collision_count [number]
+# /SET collision_time [seconds]
+# /SET collision_ignore [seconds]
+# /SET collision_baselen [0-6]
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.2.3";
+%IRSSI = (
+ 'authors' => 'Marcin Rozycki',
+ 'contact' => 'derwan@irssi.pl',
+ 'name' => 'nocollide',
+ 'description' => 'Automatically changes nick (to randnick or uid on ircd 2.11) when certain amount of nick colissions'.
+ 'takes place on channel',
+ 'url' => 'http://derwan.irssi.pl',
+ 'license' => 'GNU GPL v2',
+ 'changed' => 'Mon Feb 16 10:08:59 CET 2004',
+);
+
+my $default_time = 5;
+my $default_count = 2;
+my $default_ignore = 10;
+my $default_baselen = 5;
+
+Irssi::settings_add_bool('misc', 'collision_avoid', 1);
+Irssi::settings_add_int('misc', 'collision_time', $default_time);
+Irssi::settings_add_int('misc', 'collision_count', $default_count);
+Irssi::settings_add_int('misc', 'collision_ignore', $default_ignore);
+Irssi::settings_add_int('misc', 'collision_baselen', $default_baselen);
+
+my %collision = ();
+my %collision_changed = ();
+
+sub sig_message_quit {
+ my ($server, $nick, $null, $quit_msg) = @_;
+
+ # based on cras'es kills.pl
+ return if ($quit_msg !~ /^Killed \(([^ ]*) \((.*)\)\)$/ or !$server or !$server->{connected} or
+ !$nick or !Irssi::settings_get_bool('collision_avoid'));
+
+ my $time = time(); my $tag = lc($server->{tag}); my $change = 0;
+
+ my $check_time = Irssi::settings_get_int('collision_time');
+ $check_time = $default_time if (!$check_time or $check_time !~ /^\d+$/);
+
+ my $check_count = Irssi::settings_get_int('collision_count');
+ $check_count = $default_count if (!$check_count or $check_count !~ /^\d+$/);
+ $check_count = 10 if (--$check_count > 10);
+
+ my $ignore = Irssi::settings_get_int('collision_ignore');
+ $ignore = $default_ignore if (!$ignore or $ignore !~ /^\d+$/);
+
+ my $version = $server->{version};
+ $version = 0 unless ( defined $version );
+
+ my @list = $server->nicks_get_same($nick);
+ while (my $channel = shift(@list)) {
+ shift(@list);
+
+ my $chan = lc($channel->{name});
+ unshift @{$collision{$tag}{$chan}}, $time; $#{$collision{$tag}{$chan}} = 10;
+ next if ( $server->{nick} =~ m/^\d/ );
+
+ next unless ($check_count > 0 and $check_time > 0);
+
+ my $test = $collision{$tag}{$chan}[$check_count];
+ if ($test and $test >= ($time - $check_time)) {
+ my $last = $collision_changed{$tag};
+ next if ($last and ($time - $last) < $ignore);
+
+ $collision_changed{$tag} = $time;
+ delete $collision{$tag}{$chan};
+ next if ($change++);
+
+ if ( $version =~ m/^2.11/ ) {
+ $channel->print("%RNick collision alert%n in %_".$channel->{name}."%_ \(rate ".($check_count + 1)."\:$check_time\). Changing nick to %_uid%_!", MSGLEVEL_CLIENTCRAP);
+ $server->send_raw('NICK 0');
+ next;
+ }
+
+ my $len = Irssi::settings_get_int('collision_baselen');
+ $len = 6 if ($len > 6);
+ my $nick = randnick(substr($server->{nick}, 0, $len));
+ $channel->print("%RNick collision alert%n in %_".$channel->{name}."%_ \(rate ".($check_count + 1)."\:$check_time\). Changing nick to \'%_$nick%_\'", MSGLEVEL_CLIENTCRAP);
+ $server->command("NICK $nick");
+ }
+ }
+}
+
+# str randnick($prefix, $nicklen);
+# returns random nickname
+sub randnick {
+ my ($base, $length) = @_;
+ $length = 9 if (!$length or $length !~ /^\d+$/);
+
+ # based on fahren's void.scr for LiCe
+ my $chars = 'aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ_-0123456789';
+ my $cchars = (length($base)) ? 64 : 53;
+
+ while (length($base) < $length)
+ {
+ $base .= substr($chars, int(rand($cchars)), 1);
+ $cchars = 64 if ($cchars == 53);
+ }
+ return $base;
+}
+
+Irssi::signal_add_first('message quit', 'sig_message_quit');
diff --git a/scripts/noisyquery.pl b/scripts/noisyquery.pl
new file mode 100644
index 0000000..e11be3b
--- /dev/null
+++ b/scripts/noisyquery.pl
@@ -0,0 +1,33 @@
+# prints "Query started with nick in window x" when query windows are
+# created automatically. For irssi 0.7.98
+
+# 21.08.2001 bd@bc-bd.org :: added automatic whois
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION="0.1.1";
+%IRSSI = (
+ authors=> 'unknown',
+ contact=> 'bd@bc-bd.org',
+ name=> 'noisyquery',
+ description=> 'Prints an info about a newly started Query in your current window and runs a /whois on the nick.',
+ license=> 'GPL v2',
+ url=> 'http://bc-bd.org/software.php3#irssi',
+);
+
+sub sig_query() {
+ my ($query, $auto) = @_;
+
+ # don't say anything if we did /query,
+ # or if query went to active window
+ my $refnum = $query->window()->{refnum};
+ my $window = Irssi::active_win();
+ if ($auto && $refnum != $window->{refnum}) {
+ $window->print("Query started with ".$query->{name}." in window $refnum");
+ $query->{server}->command("whois ".$query->{name});
+ }
+}
+
+Irssi::signal_add_last('query created', 'sig_query');
diff --git a/scripts/nopl.pl b/scripts/nopl.pl
new file mode 100644
index 0000000..2cf794e
--- /dev/null
+++ b/scripts/nopl.pl
@@ -0,0 +1,66 @@
+# nopl.pl
+#
+# Removes polish national diacritic characters from received msgs on irc,
+# replacing them with their corresponding letters. Can be used against
+# ISO-8859-2 and Windows-1250 character sets.
+#
+# Settings:
+#
+# nopl_replace: How to notify you that letters have been changed. Default
+# is "<pl>text</pl>", where "text" is replaced with the
+# message.
+#
+# Thanks to James <james@jamesoff.net> for his nocaps.pl script on which
+# I have based my nopl (I don't know perl :)).
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+
+$VERSION = '1.00';
+%IRSSI = (
+ authors => 'Adam Wysocki',
+ contact => 'gophi <at> efnet.pl',
+ name => 'nopl',
+ description => 'Replaces polish national characters with their corresponding letters',
+ license => 'Public Domain',
+ url => 'http://www.gophi.rotfl.pl/',
+ changed => '10 May 2005 16.12.32',
+);
+
+
+sub have_polish_chars {
+ my ($msg) = @_;
+
+ # only pl-letters
+ $msg =~ s/[^\xF3\xEA\xB6\xB1\xBF\xB3\xE6\xBC\xCA\xF1\xA1\xD3\xA3\xA6\xAC\xAF\xD1\xC6\x9C\xB9\x9F\xA5\x8C\x8F]+//g;
+
+ # if it has pl-letters, return 1 else return 0
+ return 1 if length($msg);
+
+ return 0;
+}
+
+# main event handler
+sub pl_message {
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $msg) = split(/ :/, $data, 2);
+
+ return if (!have_polish_chars($msg));
+
+ # bleh, a line contains pl-chars
+ $msg =~ tr/\xF3\xEA\xB6\xB1\xBF\xB3\xE6\xBC\xCA\xF1\xA1\xD3\xA3\xA6\xAC\xAF\xD1\xC6\x9C\xB9\x9F\xA5\x8C\x8F/oesazlczEnAOLSZZNCsazASZ/;
+
+ my $replacement = Irssi::settings_get_str('pl_replace');
+ $replacement =~ s/text/$msg/;
+
+ # display it
+ Irssi::signal_emit('event privmsg', ($server, "$target :$replacement", $nick, $address));
+
+ # and stop
+ Irssi::signal_stop();
+}
+
+Irssi::signal_add('event privmsg', 'pl_message');
+Irssi::settings_add_str('misc', 'pl_replace', "<pl>text</pl>");
diff --git a/scripts/norepeat.pl b/scripts/norepeat.pl
new file mode 100644
index 0000000..02aec56
--- /dev/null
+++ b/scripts/norepeat.pl
@@ -0,0 +1,76 @@
+use strict;
+use Digest::MD5 'md5_hex';
+
+use Irssi qw(settings_add_bool settings_get_bool signal_add signal_add_first signal_stop );
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '0.5';
+%IRSSI = (
+ authors => 'Marcin Rozycki',
+ contact => 'derwan@irssi.pl',
+ url => 'http://derwan.irssi.pl',
+ name => 'norepeat',
+ description => 'stops public repeating',
+ license => 'GNU GPL v2',
+ modules => 'Digest::MD5',
+ changed => 'Tue Sep 9 16:34:44 CEST 2003',
+);
+
+our $norepeat_enabled = 1;
+settings_add_bool('misc', 'norepeat_enabled', $norepeat_enabled);
+
+signal_add('setup changed' => sub {
+ $norepeat_enabled = settings_get_bool('norepeat_enabled');
+} );
+
+our %last_message = ();
+our $last_timeout = 300;
+
+sub check_last_message ($$$$$) {
+ my ($server, $data, $nick, $address, $target) = @_;
+ my ($time, $nick, $target, $md5) = (time, lc $nick, lc $target, md5_hex($data));
+ if ( $norepeat_enabled and my $ref = $last_message{$server->{tag}}{$target}{$nick} ) {
+ signal_stop(), return if ( $ref->[0] eq $md5 and $time - $ref->[1] <= $last_timeout );
+ }
+ remove_last_message($server, $target, $nick);
+ $last_message{$server->{tag}}{$target}{$nick} = [ $md5, $time ];
+}
+
+sub remove_last_message ($$$) {
+ my ($server, $target, $nick) = @_;
+ if ( my $ref = delete $last_message{$server->{tag}}{$target}{$nick} ) {
+ @{$ref} = ();
+ }
+}
+
+sub last_message_clear ($;$) {
+ my $chanrec = shift;
+ my $target = lc $chanrec->{name};
+ foreach my $nick ( keys %{$last_message{$chanrec->{server}->{tag}}{$target}} ) {
+ remove_last_message($chanrec->{server}, $target, $nick);
+ }
+ %{$last_message{$chanrec->{server}->{tag}}{$target}} = ();
+}
+
+signal_add_first('message public', \&check_last_message);
+signal_add_first('message irc action', \&check_last_message);
+signal_add_first('message irc notice', \&check_last_message);
+
+signal_add('nicklist remove' => sub {
+ my ($chanrec, $nickrec) = @_;
+ remove_last_message($chanrec->{server}, lc $chanrec->{name}, lc $nickrec->{nick});
+});
+
+signal_add('nicklist new' => sub {
+ my ($chanrec, $nickrec) = @_;
+ remove_last_message($chanrec->{server}, lc $chanrec->{name}, lc $nickrec->{nick});
+});
+
+signal_add('nicklist changed' => sub {
+ my ($chanrec, $nickrec, $oldnick) = @_;
+ $last_message{$chanrec->{server}->{tag}}{lc $chanrec->{name}}{lc $nickrec->{nick}} =
+ delete $last_message{$chanrec->{server}->{tag}}{lc $chanrec->{name}}{lc $oldnick};
+} );
+
+signal_add('channel created', \&last_message_clear);
+signal_add('channel destroyed', \&last_message_clear);
diff --git a/scripts/noteserve.pl b/scripts/noteserve.pl
new file mode 100644
index 0000000..5fbb79c
--- /dev/null
+++ b/scripts/noteserve.pl
@@ -0,0 +1,89 @@
+# by Stefan 'tommie' Tomanek
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "2002123101";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "NoteServ",
+ description => "Utilizes NoteServ to implement a buddylist",
+ license => "GPLv2",
+ changed => "$VERSION",
+ sbitems => "noteserv"
+);
+
+use Irssi;
+use Irssi::Irc;
+use Irssi::TextUI;
+
+use vars qw(%notifies);
+
+sub sig_event_connected ($) {
+ my ($server) = @_;
+ my $net = Irssi::settings_get_str('noteserv_ircnet');
+ return unless (lc $server->{tag} eq lc $net);
+ my $username = Irssi::settings_get_str('noteserv_login');
+ my $password = Irssi::settings_get_str('noteserv_password');
+ return unless $username && $password;
+ $server->command('squery noteserv login '.$username.' '.$password);
+ $server->command('squery noteserv notify');
+}
+
+sub sig_server_disconnected ($) {
+ my ($server) = @_;
+ my $net = Irssi::settings_get_str('noteserv_ircnet');
+ return unless (lc $server->{tag} eq lc $net);
+ %notifies = ();
+}
+
+sub sig_message_irc_notice ($$$) {
+ my ($server, $msg, $nick, $address, $target) = @_;
+ return unless lc $nick eq 'noteserv';
+ #print $msg;
+ if ($msg =~ /\d+\. Notify: (.*?)\!(.*?)\@(.*?) \(.*?\)/) {
+ my ($name, $user, $host, $time) = ($1,$2,$3,$4);
+ } elsif ($msg =~ /^(.*?) \((.*?)\) is on \(.*?\)/) {
+ $notifies{$1} = { mask => $2, status => 1 };
+ Irssi::statusbar_items_redraw('noteserv');
+ Irssi::signal_stop() if Irssi::settings_get_bool('noteserv_hide_messages');
+ } elsif ($msg =~ /^(.*?) \((.*?)\) gets (in)?visible/) {
+ $notifies{$1} = { mask => $2, status => not defined $3 };
+ Irssi::statusbar_items_redraw('noteserv');
+ Irssi::signal_stop() if Irssi::settings_get_bool('noteserv_hide_messages');
+ } elsif ($msg =~ /^(.*?) \((.*?)\) signs (on|off)/) {
+ $notifies{$1} = { mask => $2, status => ($3 eq 'on') };
+ Irssi::statusbar_items_redraw('noteserv');
+ Irssi::signal_stop() if Irssi::settings_get_bool('noteserv_hide_messages');
+ }
+}
+
+sub draw_bar ($$) {
+ my ($item, $get_size) = @_;
+ my $line = "";
+ foreach (keys %notifies) {
+ if ($notifies{$_}{status}) {
+ $line .= '%Go%n';
+ } else {
+ $line .= '%Ro%n';
+ }
+ $line .= ' '.$_.' ';
+ }
+ my $format = "{sb ".$line."}";
+ $item->{min_size} = $item->{max_size} = length($line);
+ $item->default_handler($get_size, $format, 0, 1);
+}
+
+Irssi::signal_add('message irc notice', \&sig_message_irc_notice);
+Irssi::statusbar_item_register('noteserv', 0, "draw_bar");
+
+Irssi::settings_add_str('NoteServ', 'noteserv_ircnet', 'IRCNet');
+Irssi::settings_add_str('NoteServ', 'noteserv_login', '');
+Irssi::settings_add_str('NoteServ', 'noteserv_password', '');
+Irssi::settings_add_bool('NoteServ', 'noteserv_show_offline', 1);
+Irssi::settings_add_bool('NoteServ', 'noteserv_hide_messages', 0);
+
+Irssi::signal_add('event connected', \&sig_event_connected);
+Irssi::signal_add('server disconnected', \&sig_server_disconnected);
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded';
diff --git a/scripts/noticemove.pl b/scripts/noticemove.pl
new file mode 100644
index 0000000..781d42d
--- /dev/null
+++ b/scripts/noticemove.pl
@@ -0,0 +1,49 @@
+# Prints private notices from people in the channel where they are joined
+# with you. Useful when you get lots of private notices from some bots.
+# for irssi 0.7.99 by Timo Sirainen
+
+# v1.01 - history:
+# - fixed infinite loop when you weren't connected to server :)
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.01";
+%IRSSI = (
+ authors => "Timo Sirainen",
+ contact => "tss\@iki.fi",
+ name => "notice move",
+ description => "Prints private notices from people in the channel where they are joined with you. Useful when you get lots of private notices from some bots.",
+ license => "Public Domain",
+ url => "http://irssi.org/",
+ changed => "2002-03-04T22:47+0100",
+ changes => "v1.01 - fixed infinite loop when you weren't connected to server :)"
+);
+
+my $insig = 0;
+
+sub sig_print_text {
+ my ($dest, $text, $stripped) = @_;
+ my $server = $dest->{server};
+
+ # ignore non-notices and notices in channels
+ return if (!$server ||
+ !($dest->{level} & MSGLEVEL_NOTICES) ||
+ $server->ischannel($dest->{target}));
+
+ return if ($insig);
+ $insig = 1;
+
+ # print the notice in the first channel the sender is joined
+ foreach my $channel ($server->channels()) {
+ if ($channel->nick_find($dest->{target})) {
+ $channel->print($text, MSGLEVEL_NOTICES);
+ Irssi::signal_stop();
+ last;
+ }
+ }
+
+ $insig = 0;
+}
+
+Irssi::signal_add('print text', 'sig_print_text');
diff --git a/scripts/notonline.pl b/scripts/notonline.pl
new file mode 100644
index 0000000..57a28a8
--- /dev/null
+++ b/scripts/notonline.pl
@@ -0,0 +1,76 @@
+# Answers "$nick: No." if you're away and someone asks are you online on a channel.
+
+use strict;
+use Irssi;
+use locale;
+
+use vars qw($VERSION %IRSSI %answers $floodlimit %floodi);
+
+$VERSION = '0.9';
+%IRSSI = (
+ authors => 'Johan "Ion" Kiviniemi',
+ contact => 'ion at hassers.org',
+ name => 'NotOnline',
+ description =>
+'Answers "$nick: No." if you\'re away and someone asks are you online on a channel',
+ license => 'Public Domain',
+ url => 'http://ion.amigafin.org/irssi/',
+ changed => 'Tue Mar 12 22:20 EET 2002',
+);
+
+%answers = (
+ 'online' => 'Offline.',
+ 'there' => 'Not here.',
+ 'idle' => 'Of course.',
+ 'paikalla' => 'En, vaan paikassa.',
+ 'siellä' => 'Ei kun tuolla.',
+ 'siellä' => 'Ei kun tuolla.',
+ 'hereillä' => 'Nukkumassa.',
+ 'hereillä' => 'Nukkumassa.',
+);
+
+$floodlimit = 600; # notice the same channel only once in N seconds
+%floodi = ();
+
+Irssi::signal_add_last(
+ 'message public' => sub {
+ my ($server, $msg, $nick, $address, $target) = @_;
+
+ # Am i away?
+ return unless $server->{usermode_away};
+
+ # Am i asked about something?
+ my $own_nick = $server->{nick};
+ $own_nick =~ s/\W//g;
+ return
+ unless $msg =~ /^(\Q$server->{nick}\E|\Q$own_nick\E)\s*[,:].+\?/i;
+
+ # Is it me who's talking?
+ return if $nick eq $server->{nick};
+
+ # Are you asking the right question?
+ my $answer;
+ foreach (keys %answers) {
+ $answer = $answers{$_} if $msg =~ /\b\Q$_\E\b/i;
+ }
+ return unless $answer;
+
+ # You aren't flooding, are you?
+ if (defined $floodi{$target}) {
+ if (time - $floodi{$target} < $floodlimit) {
+ return;
+ } else {
+ undef $floodi{$target};
+ }
+ }
+
+ $nick =~ s/\W//g;
+ $nick = lc $nick
+ if Irssi::settings_get_bool('completion_nicks_lowercase');
+ $nick .= Irssi::settings_get_str('completion_char') || ":";
+
+ $floodi{$target} = time;
+ $server->command("msg $target $nick $answer");
+ # Irssi::print("msg $target $nick $answer");
+ }
+);
diff --git a/scripts/ogg123.pl b/scripts/ogg123.pl
new file mode 100644
index 0000000..85a6700
--- /dev/null
+++ b/scripts/ogg123.pl
@@ -0,0 +1,95 @@
+# Display current ogg123 track to channel
+# you should run ogg123 as,
+# ogg123 --verbose file1 file2 2> ~/.irssi/scripts/ogg123.log
+# or just put this on a file
+
+# #--- ogg123a file ---#
+# #!/bin/sh
+# ogg123 --verbose * 2> ~/.irssi/scripts/ogg123.log
+
+# save it as ogg123a and make it executable
+# chmod a+x ogg123a
+#
+# execute it on the directory you have your .ogg files
+# ./ogg123a
+
+
+#
+# HOWTO use "ogg123 script" from Irssi:
+# /ogg123 [#channel] [-h|--help]
+#
+# bugs: if u call it from the "status" window, it ill crash the script, since you arent currently on a channel.
+# It ill crash the script not the Irssi program, so u shall re-run it.
+#
+# **** note ****
+# Yeah i now that this is a copy of mpg123.pl script ;D
+# to be true it was just a question of doing %s/mpg/ogg/gi and small changes on the regexp,
+# but its workable, the mpg123 author doenst complain, so who really cares?! =:)
+# isnt what all ppl is doing since recent events moving all... mv *.mp3 *.ogg
+
+use Irssi;
+use Irssi::Irc;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.01+1";
+%IRSSI = (
+ authors => 'Ricardo Mesquita',
+ contact => 'ricardomesquita@netcabo.pt',
+ name => 'ogg123',
+ description => 'Display current ogg123 track',
+ url => 'http://pwp.netcabo.pt/ricardomesquita/irssi',
+ license => 'GPLv2',
+ changed => 'Mon Nov 27 18:00:00 CET 2006'
+);
+
+my $ogg123file = glob "~/.irssi/scripts/ogg123.log";
+
+
+sub cmd_ogg123 {
+ my ($data, $server, $witem) = @_;
+ my ($ogg123msg, $ogg123linha, $channel);
+
+ my $showhelp="ogg123 irssi script version $VERSION\n/ogg123 [#channel] [-h|--help]";
+
+ if ($data=~/-h|--help/) {
+ Irssi::print($showhelp);
+ return
+ } else {
+ if ($data=~ /#./) {
+ $channel = $data;
+ } else {
+ if ($witem->{name} ne "") {
+ $channel = $witem->{name};
+ }
+ }
+
+ open (f,'<', $ogg123file) || return;
+
+ while ($ogg123linha=<f>) {
+
+ chomp($ogg123linha);
+ if ($ogg123linha=~/Playing:/i) {
+ $ogg123linha =~s/(.*)Playing:\s(.*)/\2/;
+ $ogg123msg="on ogg123 playing $ogg123linha";
+ }
+
+ chomp($ogg123linha);
+ if ($ogg123linha =~/Title:/i) {
+ $ogg123linha =~s/(.*)Title:\s(.*)/\2/;
+ $ogg123msg="on ogg123 playing $ogg123linha";
+ }
+
+ chomp($ogg123linha);
+ if ($ogg123linha =~/Artist:/i) {
+ $ogg123linha =~s/(.*)Artist:\s(.*)/\2/;
+ $ogg123msg.=" - $ogg123linha";
+ }
+ }
+ close(f);
+ $ogg123msg =~ s/[\r\n]/ /g;
+ $server->command("action ". $channel . " $ogg123msg");
+ }
+}
+
+Irssi::command_bind('ogg123', 'cmd_ogg123');
diff --git a/scripts/oidenty.pl b/scripts/oidenty.pl
new file mode 100644
index 0000000..a7961b4
--- /dev/null
+++ b/scripts/oidenty.pl
@@ -0,0 +1,75 @@
+#
+# psybnc like oidentd support for irssi
+#
+# requirements:
+# - oidentd (running)
+# - your user needs "spoof" permissions in the /etc/oidentd.conf
+# looks like:
+# "user youruser {
+# default {
+# allow spoof;
+# }
+# }"
+#
+# if you want to spoof local user you need:
+# "allow spoof_all;"
+#
+# - this script works like psybnc oidentd support.
+# that means it writes ~/.ispoof and ~/.oidentd.conf
+# these files have to be writeable.
+#
+# usage:
+# - just run the script.
+#
+# configuration:
+# - the script uses the active "username" field for the connect.
+# you can alter it global via "/set user_name"
+# or per ircnet with "/ircnet add -user ident somenet"
+#
+# how it works:
+# on connect it writes ~/.ispoof and ~/.oidentd.conf
+# you CAN have RACE CONDITIONS HERE.
+# so delay your connects a bit.
+#
+use strict;
+use warnings;
+use Irssi qw ( signal_add );
+use IO::File;
+
+use vars qw ( $VERSION %IRSSI );
+
+$VERSION = "0.0.3";
+%IRSSI = (
+ authors => 'darix',
+ contact => 'darix@irssi.org',
+ name => 'oidenty',
+ description => 'oidentd support for irssi',
+ license => 'BSD License',
+ url => 'http://www.irssi.de'
+);
+
+signal_add 'server looking' => sub {
+ my ( $server ) = @_;
+
+ my $fh = new IO::File "$ENV{'HOME'}/.ispoof", "w";
+ if ( $fh ) {
+ $fh->print ( "$server->{'username'}" );
+ undef $fh;
+ }
+ else {
+ print ( CRAP "cant open $ENV{'HOME'}/.ispoof for writing. $!" );
+ }
+
+ $fh = new IO::File "$ENV{'HOME'}/.oidentd.conf", "w";
+ if ( $fh ) {
+ $fh->print ( "global { reply \"$server->{'username'}\" }" );
+ undef $fh;
+ }
+ else {
+ print ( CRAP "cant open $ENV{'HOME'}/.oidentd.conf for writing. $!" );
+ }
+
+};
+
+print (CRAP "loaded $IRSSI{'name'} v$VERSION by $IRSSI{'authors'} <$IRSSI{'contact'}>. use it at \cBYOUR OWN RISK\cB");
+print (CRAP "$IRSSI{'description'}");
diff --git a/scripts/on.pl b/scripts/on.pl
new file mode 100644
index 0000000..8a98773
--- /dev/null
+++ b/scripts/on.pl
@@ -0,0 +1,287 @@
+use strict;
+use Irssi 20011210.0000 ();
+use Storable;
+
+use vars qw/$VERSION %IRSSI/;
+
+$VERSION = "1.13";
+%IRSSI = (
+ authors => 'David Leadbeater',
+ contact => 'dgl@dgl.cx',
+ name => 'on.pl',
+ description => '/on command - this is very simple and not really designed to be the same as ircII - it tries to fit into Irssi\'s usage style more than emulating ircII.',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.dgl.cx/',
+);
+
+my %on;
+
+=head1 on.pl
+
+/on command - this is very simple and not really designed to
+be the same as ircII - it tries to fit into Irssi's usage style
+more than emulating ircII.
+
+=head1 Features
+
+This script allow you to bind Irssi commands or a piece of perl
+code to s particular signal with some forms of filtering.
+
+A command can be set to run in a particular channel (nearly)
+and on a particular chatnet. The commands that you add are
+automatically saved into a file (usually ~/.irssi/on.save).
+
+
+=head1 Usage
+
+ /on list
+ /on add [-global] [-perl] [-server] [-channel #channel] [-stop] 'signal name' command
+ /on remove signal name
+ /on reload
+
+=head2 ON ADD
+
+ -global: run the command with Irssi::command
+ -perl: Interpret command as perl instead of the default Irssi
+ -server: Only trigger for events from this chat network
+ -channel #channel: only trigger for events in #channel
+ (only works where $channel->{name} is present (message signals mostly)
+ -stop: Call Irssi::signal_stop() (probably not a good idea to use this)
+
+If you supply a signal name then it must be quoted so it is
+interpeted as one, if you wish to bind to a numeric then just
+entering it will work.
+
+Currently if you specify a Irssi command $0 and $$0 are escaped,
+$0 $1 and so on are the parameters sent to the signal (except the first
+REC), $$0 and so on are the results of spliting $0 on a space so if
+the signal is an event then $$0 will usually be your nickname, $$1
+will be the channel or nickname the numeric is targeting and so on..
+
+=head2 ON REMOVE
+
+This removes *all* events from the signal specified (if you
+want to remove a numeric you must add event eg:
+ /on remove event 401
+
+=head2 ON RELOAD
+
+Reloads the saved list from ~/.irssi/on.save into memory,
+useful if you have to edit it manually (and very useful during debugging :)
+(perl -MStorable -MData::Dumper -e "print Dumper(retrieve('on.save'));")
+
+=head1 Examples
+
+These are pretty generic examples, there are many more
+specific uses for the commands.
+
+To automatically run a /whowas when the no such nick/channel
+event is recieved:
+ /on add 401 /whowas $$0
+
+To automatically run a command when you become an irc operator
+on this chatnet:
+ /on add -server 381 /whatever
+
+To automatically move to a window with activtiy in it on a hilight:
+ /on add -global 'window hilight' /window goto active
+
+Obviously perl commands could be used here or many different
+signals (see docs/signals.text in the irssi sources for a list
+of all the signals)
+
+=head2 more test items
+
+ /on add -perl 'channel topic changed' print "topic changed";
+ /on add -channel #test 'channel topic changed' /echo topic changed
+ /on add -stop 332 /echo event 332
+
+=cut
+
+Irssi::command_bind('on','cmd_on');
+Irssi::command_bind('on add','cmd_on');
+Irssi::command_bind('on remove','cmd_on');
+Irssi::command_bind('on reload','cmd_on');
+Irssi::command_bind('on list','cmd_on');
+# This makes tab completion work :)
+Irssi::command_set_options('on','global stop server perl +channel');
+load();
+add_signals();
+
+# Loads the saved on settings from the saved file
+sub load {
+ my $file = Irssi::get_irssi_dir . '/on.save';
+ return 0 unless -f $file;
+ %on = %{retrieve($file)};
+}
+
+# Saves the settings currently in the %on hash into the save file
+sub save {
+ my $file = Irssi::get_irssi_dir . '/on.save';
+ store(\%on, $file);
+}
+
+# Adds signals from the hash to irssi (only needs to be called once)
+sub add_signals {
+ for(keys %on) {
+ Irssi::signal_add($_, 'signal_handler');
+ }
+}
+
+# Irssi calls this and it figures out what to do with the event
+sub signal_handler {
+ my($item, @stuff) = @_;
+ my $signal = Irssi::signal_get_emitted();
+
+
+ if(exists $on{$signal}) {
+ for(@{$on{$signal}}) {
+ next if $_->{chatnet} ne 'all' and $_->{chatnet} ne $item->{chatnet};
+ next if $_->{channel} and $item->{name} ne $_->{channel};
+ event_handle(@$_{'settings','cmd'},$item,@stuff);
+ }
+ }else{
+ Irssi::signal_remove($signal,'signal_handler');
+ }
+}
+
+# Called with the params needed to handle an event from signal_handler
+sub event_handle {
+ my($settings,$cmd,$item,@stuff) = @_;
+ my %settings = %{$settings};
+
+ if($settings{type} == 1) {
+ local @_;
+ @_ = ($item,@stuff);
+ eval('no strict;' . $cmd);
+ }else{
+ $cmd =~ s!\$\$(\d)!(split / /,$stuff[0])[$1]!ge;
+ $cmd =~ s/\$(\d)/$stuff[$1]/g;
+ if (defined $settings{global}) {
+ Irssi::command($cmd);
+ } else {
+ $item->command($cmd);
+ }
+ }
+
+ Irssi::signal_stop() if $settings{stop};
+}
+
+# Called by the /on command
+sub cmd_on {
+ my $text = shift;
+
+ if($text =~ s/^add //) {
+ my($cmd,%options) = option_parse($text);
+ if(!$options{event} || !$cmd) {
+ Irssi::print('No '.($cmd ? 'command' : 'event'). ' supplied');
+ }else{
+ my($chatnet,%settings,$channel,$event);
+ $chatnet = ($options{server} ? Irssi::active_server()->{chatnet} : 'all');
+ $event = $options{event};
+ $channel = $options{channel};
+ $settings{type} = $options{perl};
+ $settings{stop} = $options{stop};
+ $settings{global} = $options{global};
+ add_on($event,$cmd,$chatnet,$channel,%settings);
+ save();
+ }
+ }elsif($text =~ s/^remove //) {
+ if(del_on($text)) {
+ Irssi::print("Event $text deleted",MSGLEVEL_CLIENTCRAP);
+ }else{
+ Irssi::print("Event not found",MSGLEVEL_CLIENTCRAP);
+ }
+ save();
+ }elsif($text =~ /^reload/) {
+ %on = ();
+ load();
+ }elsif($text eq "help") {
+ Irssi::print( <<EOF
+Usage:
+/on list
+/on add [-global] [-perl] [-server] [-channel #channel] [-stop] 'signal name' command
+/on remove signal name
+/on reload
+EOF
+ );
+ }else{
+ Irssi::print("/on help for usage information");
+ on_list();
+ }
+}
+
+# Output a list of the current contents of %on
+sub on_list {
+ if(!keys %on) {
+ Irssi::print("On list is empty", MSGLEVEL_CLIENTCRAP);
+ return;
+ }
+ for my $event(keys %on) {
+ for(@{$on{$event}}) {
+ Irssi::print("$event: " .
+ ($_->{chatnet} ne 'all' ? $_->{chatnet} : '') .
+ ' ' . $_->{cmd},
+ MSGLEVEL_CLIENTCRAP
+ );
+ }
+ }
+}
+
+# Adds into %on and adds a signal if needed.
+sub add_on {
+ my($event,$cmd,$chatnet,$channel,%settings) = @_;
+
+ Irssi::signal_add($event, 'signal_handler') unless $on{$event};
+
+ push(@{$on{$event}},
+ {
+ 'chatnet' => $chatnet || 'all',
+ 'settings' => {%settings},
+ 'channel' => $channel,
+ 'cmd' => $cmd,
+ }
+ );
+}
+
+# Deletes all ons under the event
+sub del_on {
+ my $on = shift;
+ Irssi::signal_remove($on, 'signal_handler');
+ return delete($on{$on});
+}
+
+# This is nasty.
+# It would be nice if perl scripts could use Irssi's internal stuff for option
+# parsing
+sub option_parse {
+ my $text = shift;
+ my($last,%options,$cmd);
+ for(split(' ',$text)) {
+ if($cmd) {
+ $cmd .= " $_";
+ }elsif(/^-(.+)$/) {
+ $last = 'channel' if $1 eq 'channel';
+ $options{$1}++;
+ }elsif(/^["'0-9]/) {
+ if(/^\d+$/) {
+ $options{event} = "event $_" if /^\d+$/;
+ }else{
+ $last = 'event';
+ s/^['"]//;
+ $options{event} = $_;
+ }
+ }elsif($last eq 'event'){
+ $last = "" if s/['"]$//;
+ $options{event} .= " $_";
+ }elsif($last) {
+ $options{$last} = $_;
+ $last = "";
+ }else{
+ $cmd = $_;
+ }
+ }
+ return ($cmd,%options);
+}
+
+# vim:set ts=4 sw=3 expandtab:
diff --git a/scripts/ontv.pl b/scripts/ontv.pl
new file mode 100644
index 0000000..8dcdfb3
--- /dev/null
+++ b/scripts/ontv.pl
@@ -0,0 +1,339 @@
+# OnTV by Stefan'tommie' Tomanek
+
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "20050226";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "OnTV",
+ description => "turns irssi into a tv program guide",
+ license => "GPLv2",
+ modules => "Data::Dumper POSIX LWP::Simple HTML::Entities Text::Wrap",
+ changed => "$VERSION",
+ commands => "ontv"
+);
+
+use Irssi 20020324;
+use Data::Dumper;
+use POSIX;
+use LWP::Simple;
+use HTML::Entities;
+use Text::Wrap;
+
+use vars qw($forked @comp);
+
+sub show_help() {
+ my $help=$IRSSI{name}." ".$VERSION."
+/ontv (current)
+ List the current tv program
+/ontv search <query>
+ Query the program guide for a show
+/ontv next
+ Show what'S next on TV
+/ontv tonight
+ List tonight's program
+/ontv watching <station>
+ Display what's on <station>
+";
+ my $text = '';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP &draw_box($IRSSI{name}." help", $text, "help", 1) ;
+}
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub get_prog ($) {
+ my ($what) = @_;
+ my $url = 'http://www.tvmovie.de/tv-programm/jetzt.html?nocache=true';
+ $url = 'http://www.tvmovie.de/tv-programm/gleich.html?nocache=true' if ($what == 0);
+ $url = 'http://www.tvmovie.de/tv-programm/2015.html' if ($what == 2);
+ my $data = get($url);
+ my $programs = [];
+ my %program;
+ foreach (split /\n/, $data) {
+ #print $_;
+ if (/class="linkgrau">(.*?)<\/a><\/font><\/td>/) {
+ $program{station} = $1;
+ decode_entities($program{station});
+ }
+ #if (/<a href="http:\/\/www.tvmovie.de\/tv-programm\/sendung.html\?SendungID=(\d+)" class="linkblack"><b>(.*?)<\/b><\/a>/) {
+ if (/<a href="http:\/\/www.tvmovie.de\/tv-programm\/sendung.html\?SendungID=(\d+)" class="linkblack"><b>(.*?)<\/b>/) {
+ $program{id} = $1;
+ $program{title} = $2;
+ decode_entities($program{title});
+ }
+ if (/<FONT face="Verdana, Arial, Helvetica, sans-serif" size="1" color="#757575"><br>(.*?)<\/font><\/font><\/td>/) {
+ $program{comment} = decode_entities($1);
+ }
+ if (/color='#ee0000'>(.*?)<\/font><\/td>/) {
+ $program{type} = decode_entities($1);
+ }
+ if (/color="white"><b>([A-Z]{2})<\/b><\/font><\/td>/) {
+ $program{day} = $1;
+ }
+ if (/size="1">(\d{2}\.\d{2})&nbsp;<\/font><\/td>/) {
+ $program{begin} = $1;
+ decode_entities($program{begin});
+ }
+ if (/size="1">bis&nbsp;(\d{2}\.\d{2})<\/font><\/td>/) {
+ $program{end} = $1;
+ decode_entities($program{end});
+ my %data = %program;
+ push @$programs, \%data;
+ %program = ();
+ }
+ }
+ return $programs;
+}
+
+sub search_prog ($) {
+ my ($query) = @_;
+ encode_entities($query);
+ my $url = 'http://fernsehen.tvmovie.de/finder?finder=swsendung&tag=alle&sw_sendung='.$query;
+ my $data = get($url);
+ return( parse_search($data) );
+}
+
+sub parse_search ($) {
+ my ($data) = @_;
+ my $programs = [];
+ my %program;
+ foreach (split /\n/, $data) {
+ if (/color="white"><b>([A-Z]{2})<\/b> <\/font><\/td>$/) {
+ $program{day} = $1;
+ decode_entities($program{day});
+ }
+ if (/size="1">(\d{2}:\d{2})<\/font><\/td>$/) {
+ $program{begin} = $1;
+ decode_entities($program{begin});
+ } elsif (/class="linkgrau">(.*?)<\/a><\/font><\/td>$/) {
+ $program{station} = $1;
+ decode_entities($program{station});
+ } elsif (/<a href="http:\/\/www.tvmovie.de\/tv-programm\/sendung\.html\?SendungID=(\d+)" class="linkblack"><b>(.*?)<\/b><\/a><\/font>(?:<FONT face="Verdana, Arial, Helvetica, sans-serif" size="1" color="#757575"><br>(.*?)<\/font>)?/) {
+ $program{id} = $1;
+ $program{title} = $2;
+ $program{comment} = $3;
+ decode_entities($program{title});
+ decode_entities($program{comment});
+ #} elsif (/{ \t]*<td valign="top" align="left">$/) {
+ my %data = %program;
+ push @$programs, \%data;
+ }
+ }
+ return $programs;
+}
+
+sub get_info ($) {
+ my ($id) = @_;
+ my $data = get('http://www.tvmovie.de/tv-programm/sendung.html?SendungID='.$id);
+ my %info;
+ foreach (split(/\n/, $data)) {
+ #print;
+ if (/size="3"><b>(.*?)<\/b><br><\/font>$/) {
+ $info{title} = decode_entities($1);
+ } elsif (/color="#FFFFFF"><b>&nbsp;(\d+\.\d+\.\d+) \|/) {
+ $info{date} = decode_entities($1);
+ } elsif (/size="1"><b>(.*?)<\/b><br><br><\/font>$/) {
+ $info{comment} = decode_entities($1);
+ } elsif (/class="uppercase"><b>(.*?)<\/b> <\/font>/) {
+ $info{type} = decode_entities($1);
+ } elsif (/<FONT face="Verdana, Arial, Helvetica, sans-serif" size="1">(.*?)<br><br><\/font>/) {
+ $info{desc} = decode_entities($1);
+ } elsif (/\[Sender:&nbsp;(.*?)\] \[Beginn:&nbsp;(.*?)\] \[Dauer:&nbsp;(.*?) Min\.\] \[Ende:&nbsp;(.*?)\] \[SV:&nbsp;(.*?)\]/) {
+ $info{station} = decode_entities($1);
+ $info{begin} = decode_entities($2);
+ $info{end} = decode_entities($4);
+ $info{showview} = decode_entities($5);
+ }
+ }
+ my $stat = $info{station};
+ $info{desc} =~ s/$stat$//;
+ #$info{desc} =~ s/<br><br>$//;
+ $info{desc} =~ s/<br>/\n/g;
+ return \%info;
+}
+
+sub bg_fetch ($$) {
+ my ($op, $query) = @_;
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ if ($forked) {
+ print CLIENTCRAP "%R>>%n Please wait until your earlier request has been finished.";
+ return;
+ }
+ my $pid = fork();
+ $forked = 1;
+ if ($pid > 0) {
+ print CLIENTCRAP "%R>>%n Please wait...";
+ close $wh;
+ Irssi::pidwait_add($pid);
+ my $pipetag;
+ my @args = ($rh, \$pipetag, $op, $query);
+ $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
+ } else {
+ my $result = {};
+ my @program;
+ my $stations = Irssi::settings_get_str('ontv_stations');
+ eval {
+ if ($op eq 'current') {
+ @program = @{ get_prog(1) };
+ foreach (@program) {
+ push @{ $result->{program} }, $_ if ($_->{station} =~ /^($stations)$/);
+ }
+ } elsif ($op eq 'next') {
+ @program = @{ get_prog(0) };
+ foreach (@program) {
+ push @{ $result->{program} }, $_ if ($_->{station} =~ /^($stations)$/);
+ }
+ } elsif ($op eq 'tonight') {
+ @program = @{ get_prog(2) };
+ foreach (@program) {
+ push @{ $result->{program} }, $_ if ($_->{station} =~ /^($stations)$/);
+ }
+ } elsif ($op eq 'search') {
+ @program = @{ search_prog($query) };
+ foreach (@program) {
+ push @{ $result->{program} }, $_ if ($_->{station} =~ /^($stations)$/);
+ }
+ } elsif ($op eq 'watching') {
+ @program = @{ get_prog(1) };
+ foreach (@program) {
+ next unless ($_->{station} =~ /^($query)$/);
+ push @{ $result->{program} }, $_;
+ print $_->{id};
+ $result->{info} = get_info($_->{id});
+ }
+ } elsif ($op eq 'info') {
+ $result->{info} = get_info($query);
+ }
+ my $dumper = Data::Dumper->new([$result]);
+ $dumper->Purity(1)->Deepcopy(1)->Indent(0);
+ print($wh $dumper->Dump);
+ };
+ close $wh;
+ POSIX::_exit(1);
+ }
+}
+
+sub pipe_input ($) {
+ my ($rh, $pipetag, $op, $args) = @{$_[0]};
+ $forked = 0;
+ Irssi::input_remove($$pipetag);
+ my $text;
+ $text .= $_ foreach <$rh>;
+ no strict 'vars';
+ my $incoming = eval("$text");
+ return unless ($incoming->{program} || $incoming->{info});
+ print_prog($incoming->{program}, 'current') if ($op eq 'current');
+ print_prog($incoming->{program}, 'next') if ($op eq 'next');
+ print_prog($incoming->{program}, 'tonight') if ($op eq 'tonight');
+ print_prog($incoming->{program}, 'query: "'.$args.'"') if ($op eq 'search');
+ print_prog($incoming->{program}, 'current: "'.$args.'"') if ($op eq 'watching');
+ print_info($incoming->{info}) if $incoming->{info};
+}
+
+sub print_info ($) {
+ my ($info) = @_;
+ my $text;
+ $text .= '%9'.$info->{title}.'%9'."\n";
+ $text .= $info->{date}.': '.$info->{begin}."-".$info->{end}."\n";
+ $text .= 'Showview: '.$info->{showview}."\n\n";
+ $text .= $info->{comment}."\n\n";
+ $text .= $info->{desc};
+ my $col = int( Irssi::active_win()->{width}*(2/3) );
+ $Text::Wrap::columns = $col;
+ my $article = wrap("", "", $text);
+ print CLIENTCRAP &draw_box('OnTV', $article, $info->{title}, 1);
+}
+
+sub print_prog ($$) {
+ my ($program, $query) = @_;
+ @comp = @$program;
+ my $text;
+ foreach (@$program) {
+ $text .= "%9".$_->{station}."%9:";
+ $text .= " %U".$_->{title}."%U";
+ $text .= " [".$_->{type}."]"if $_->{type};
+ $text .= " (".$_->{id}.")\n";
+ $text .= " >".$_->{comment}."<\n" if $_->{comment};
+ $text .= " time: ";
+ $text .= $_->{day}.", ";
+ $text .= $_->{begin};
+ $text .= "-".$_->{end} if $_->{end};
+ $text .= "\n";
+ #$text .= "\n";
+ }
+ print CLIENTCRAP &draw_box('OnTV', $text, $query, 1);
+}
+
+sub sig_complete_word ($$$$$) {
+ my ($list, $window, $word, $linestart, $want_space) = @_;
+ return unless $linestart =~ /^.ontv (info)/;
+ foreach (@comp) {
+ push @$list, $_->{id} if ($_->{id} =~ /^(\Q$word\E.*)?$/);
+ push @$list, $_->{station} if ($_->{station} =~ /^(\Q$word\E.*)?$/);
+ push @$list, $_->{title} if ($_->{title} =~ /^(\Q$word\E.*)?$/);
+ }
+ Irssi::signal_stop();
+}
+
+
+sub cmd_ontv ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @arg = split(/ /, $args);
+ if (scalar(@arg) == 0 || $arg[0] eq 'current') {
+ bg_fetch('current', '');
+ } elsif ($arg[0] eq 'next') {
+ bg_fetch('next', '');
+ } elsif ($arg[0] eq 'tonight') {
+ bg_fetch('tonight', '');
+ } elsif ($arg[0] eq 'search') {
+ shift @arg;
+ bg_fetch('search', join(' ', @arg))
+ } elsif ($arg[0] eq 'watching' && defined $arg[1]) {
+ shift @arg;
+ bg_fetch('watching', join(' ', @arg));
+ } elsif ($arg[0] eq 'info' && defined $arg[1]) {
+ shift @arg;
+ my $query = join(' ', @arg);
+ unless ($query =~ /^\d+$/) {
+ foreach (@comp) {
+ if ($_->{title} eq $query || $_->{station} eq $query) {
+ $query = $_->{id};
+ last;
+ }
+ }
+ }
+ bg_fetch('info', $query);
+ } elsif ($arg[0] eq 'help') {
+ show_help();
+ }
+}
+
+Irssi::settings_add_str($IRSSI{name}, 'ontv_stations', '.*' );
+
+Irssi::command_bind('ontv' => \&cmd_ontv);
+
+Irssi::signal_add_first('complete word', \&sig_complete_word);
+
+foreach my $cmd ('search', 'current', 'next', 'tonight', 'watching', 'help', 'info') {
+ Irssi::command_bind('ontv '.$cmd =>
+ sub { cmd_ontv("$cmd ".$_[0], $_[1], $_[2]); } );
+}
+
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /ontv help for help';
diff --git a/scripts/oops.pl b/scripts/oops.pl
new file mode 100644
index 0000000..cadaad6
--- /dev/null
+++ b/scripts/oops.pl
@@ -0,0 +1,90 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+$VERSION = '20180707';
+%IRSSI = (
+ authors => 'bw1 and others',
+ contact => 'bw1@aol.at',
+ name => 'oops',
+ description =>
+ 'turns \'ll\' and \'ls\' in the beginning of a sent line into the names or whois commands',
+ license => 'Public Domain',
+ );
+
+my @words;
+my $wordonly;
+my $warn_msg;
+my $help = <<eof;
+%9Settings:%9
+ $IRSSI{name}_words
+ a list of words separated by a whitespace
+ $IRSSI{name}_wordonly
+ match if the word stand alone
+ $IRSSI{name}_warn_msg
+ output only a warning message
+eof
+
+sub send_text {
+ #"send text", char *line, SERVER_REC, WI_ITEM_REC
+ my ( $data, $server, $witem ) = @_;
+
+ my $find='';
+ if ($wordonly) {
+ foreach (@words) {
+ if ( $data =~ m/^$_$/ ) {
+ $find=$_;
+ }
+ }
+ } else {
+ foreach (@words) {
+ if ( $data =~ m/^$_(\s|$)/ ) {
+ $find=$_;
+ }
+ }
+ }
+
+ if($find && defined $witem) {
+ if ($warn_msg) {
+ $witem->print("%r$IRSSI{name}:%n warning before word '$find'",MSGLEVEL_CRAP);
+ Irssi::signal_stop();
+ } else {
+ if($witem->{type} eq "CHANNEL")
+ {
+ $witem->command("names $witem->{name}");
+ Irssi::signal_stop();
+ }
+ elsif($witem->{type} eq "QUERY")
+ {
+ $witem->command("whois $witem->{name}");
+ Irssi::signal_stop();
+ }
+ }
+ }
+}
+
+sub cmd_help {
+ if ($_[0] eq $IRSSI{name} ) {
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop;
+ }
+}
+
+sub reload_settings {
+ @words= split /\s+/,Irssi::settings_get_str($IRSSI{name}."_words");
+ $wordonly=Irssi::settings_get_bool($IRSSI{name}."_wordonly");
+ $warn_msg=Irssi::settings_get_bool($IRSSI{name}."_warn_msg");
+}
+
+Irssi::settings_add_str($IRSSI{name},$IRSSI{name}."_words", "ls");
+Irssi::settings_add_bool($IRSSI{name},$IRSSI{name}."_wordonly", "off");
+Irssi::settings_add_bool($IRSSI{name},$IRSSI{name}."_warn_msg", "off");
+
+Irssi::signal_add('setup changed', \&reload_settings);
+Irssi::signal_add 'send text' => 'send_text';
+
+Irssi::command_bind('help', \&cmd_help );
+
+reload_settings();
+
+# vim:set sw=4 expandtab:
diff --git a/scripts/oopsie.pl b/scripts/oopsie.pl
new file mode 100644
index 0000000..2646d6c
--- /dev/null
+++ b/scripts/oopsie.pl
@@ -0,0 +1,50 @@
+use strict;
+use warnings;
+
+our $VERSION = "1.1";
+our %IRSSI = (
+ authors => 'David Leadbeater',
+ contact => 'dgl@dgl.cx',
+ name => 'oopsie',
+ description => 'Stops those silly mistakes being sent (spaces at start of ' .
+ 'line, /1/1 for window changes, etc).',
+ license => 'WTFPL <http://dgl.cx/licence>',
+ url => 'http://dgl.cx/irssi',
+);
+
+# /SET oopsie_chars_regexp [0-9]
+# This can have nearly anything in it, but you may block some commands if
+# you're not careful. \w may be useful (e.g. blocks "/ m foo bar") but \w+ is
+# problematic (it would block /exec /some/file among other useful things,
+# although if you're a bad typist maybe that is a reasonable trade-off).
+Irssi::settings_add_str("misc", "oopsie_chars_regexp", "[0-9]");
+
+my @words = qw(stopped prevented avoided inhibited forestalled averted deflected
+ repelled);
+
+Irssi::signal_add("send command" => sub {
+ my ($command, $server, $rec) = @_;
+
+ my $chars = Irssi::settings_get_str("cmdchars");
+ my $cmdchars_re = qr/[$chars]/;
+ my $oopsie_re = Irssi::settings_get_str("oopsie_chars_regexp");
+
+ if ($command =~ /^\s+$cmdchars_re/ ||
+ $command =~ /^$cmdchars_re(?:\s+$oopsie_re|$oopsie_re\s*$cmdchars_re)/) {
+ Irssi::signal_stop();
+ if ($rec ) {
+ $rec->print("oopsie " . $words[rand @words] . ": $command", MSGLEVEL_CRAP);
+ } else {
+ Irssi::print("oopsie " . $words[rand @words] . ": $command", MSGLEVEL_CRAP);
+ }
+ }
+});
+
+Irssi::signal_add("setup changed" => sub {
+ if (" " =~ Irssi::settings_get_str("oopsie_chars_regexp")) {
+ Irssi::active_win->print(
+ "Your oopsie_chars_regexp matches a space. This is a very bad idea.");
+ }
+});
+
+# vim:set ts=2 sw=2 expandtab:
diff --git a/scripts/openurl.pl b/scripts/openurl.pl
new file mode 100644
index 0000000..066a5f4
--- /dev/null
+++ b/scripts/openurl.pl
@@ -0,0 +1,269 @@
+# OpenURL by Stefan'tommie' Tomanek
+#
+# 05.06.2002
+# * complete rewrite
+
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "20030208";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "OpenURL",
+ description => "Stores URLs in a list and launches mail, web or ftp software",
+ license => "GPLv2",
+ url => "http://scripts.irssi.org",
+ changed => "$VERSION",
+ commands => "openurl"
+);
+
+use Irssi 20020324;
+use Irssi::TextUI;
+use Irssi::UI;
+
+use vars qw(@urls %urltypes $recent);
+$recent = 1;
+
+# RegExp & defaultcommands
+%urltypes = ( http => { regexp => qr#((?:https?://[^\s<>"]+|www\.[-a-z0-9.]+)[^\s.,;<">\):])#, cmd => 'w3m "$1"' },
+ ftp => { regexp => qr#((?:ftp://[^\s<>"]+|ftp\.[-a-z0-9.]+)[^\s.,;<">\):])#, cmd => 'ncftp "$1"' },
+ mail => { regexp => qr#([-_a-z0-9.]+\@[-a-z0-9.]+\.[-a-z0-9.]+)#, cmd => 'mutt "$1" -s "$2"' },
+ );
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ } $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub show_help() {
+ my $help=$IRSSI{name}." ".$VERSION."
+/openurl
+ List the saved URLs
+/openurl <number> <number>...
+ Load the corresponding URLs in your browser/mailer
+/openurl paste <number> <number>...
+ Paste the selected URLs to the current channel/query
+/openurl topics
+ Look for URLs in channel topics
+/openurl clear
+ Clear all URLs
+/openurl help
+ Display this help
+";
+ my $text = '';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP draw_box($IRSSI{name}." help", $text, "help", 1) ;
+}
+
+sub list_urls {
+ my $string = '';
+ my $i = 1;
+ foreach (@urls) {
+ my $text = $_->{url};
+ my $url = $_->{url};
+ $text = $_->{text} if Irssi::settings_get_bool('openurl_display_context');
+ $url =~ s/%/%%/g;
+ $text =~ s/%/%%/g;
+ $text =~ s/\Q$url/%U$url%U/;
+ if ($recent-1 == $i) {
+ $string .= '%B»%n';
+ } else {
+ $string .= ' ';
+ }
+ $string .= '%r['.$i.']%n ';
+ $string .= '<'.$_->{channel};
+ $string .= '/'.$_->{nick} unless $_->{nick} eq "";
+ $string .= '> ';
+ $string .= $text." %n\n";
+ $i++;
+ }
+ print CLIENTCRAP draw_box("OpenURL", $string, "URLs", 1);
+}
+
+sub event_private_message {
+ my ($server, $text, $nick, $address) = @_;
+ process_line($server, $nick, $nick, $text);
+}
+sub event_public_message {
+ my ($server, $text, $nick, $address, $target) = @_;
+ process_line($server, $target, $nick, $text);
+}
+sub event_topic_changed {
+ my ($channel) = @_;
+ process_line($channel->{server}, $channel->{name}, "", $channel->{topic});
+}
+
+sub process_line ($$$$) {
+ my ($server, $target, $nick, $line) = @_;
+ my $url = get_url($line);
+ if ($url) {
+ my $type = url_type($url);
+ return unless Irssi::settings_get_bool('openurl_watch_'.$type);
+ new_url($server, $target, $nick, $line, $url);
+ }
+}
+
+sub get_url ($) {
+ my ($text) = @_;
+ foreach (keys %urltypes) {
+ return $1 if ($text =~ /$urltypes{$_}->{regexp}/);
+ }
+}
+
+sub url_type ($) {
+ my ($url) = @_;
+ foreach (keys %urltypes) {
+ return $_ if ($url =~ /$urltypes{$_}->{regexp}/);
+ }
+}
+
+sub launch_url ($) {
+ my ($url) = @_;
+ my $type = url_type($url);
+ my $address = $url;
+ my $suffix= "";
+ if ($type eq "mail") {
+ $address = $1 if $url =~ /(.*?@.*?)($|\?)/;
+ $suffix = $2 if $url =~ /(.*?@.*?)\?subject=(.*)/;
+ }
+ my $command = Irssi::settings_get_str("openurl_app_".$type);
+ $command =~ s/\$1/$address/;
+ $command =~ s/\$2/$suffix/;
+ system($command);
+}
+
+sub new_url ($$$$$) {
+ my ($server, $channel, $nick, $text, $url) = @_;
+ $recent = 1 if ($recent > Irssi::settings_get_int('openurl_max_urls'));
+ # Check for existance of URL
+ my $i = 1;
+ foreach (@urls) {
+ if ($text eq $_->{text} && $channel eq $_->{channel}) {
+ my $note_id = add_note($server, $channel, $i);
+ push @{$_->{notes}}, $note_id;
+ return();
+ }
+ $i++;
+ }
+ if (defined $urls[$recent-1]) {
+ del_notes($recent);
+ }
+ $urls[$recent-1] = {channel => $channel,
+ text => $text,
+ nick => $nick,
+ url => $url,
+ notes => [],
+ };
+ my $note_id = add_note($server, $channel, $recent);
+ push @{$urls[$recent-1]{notes}}, $note_id;
+ $recent++;
+}
+
+
+sub del_notes ($) {
+ my ($num) = @_;
+ my $view;
+ my $witem = Irssi::window_item_find($urls[$num-1]->{channel});
+ if (defined $witem) {
+ $view = $witem->window()->view();
+ }
+ if (defined $view) {
+ foreach (@{$urls[$num-1]->{notes}}) {
+ my $line = $view->get_bookmark($_);
+ $view->remove_line($line) if defined $line;
+ $view->set_bookmark($_, undef);
+ }
+ @{$urls[$num-1]->{notes}} = ();
+ $view->redraw();
+ }
+}
+
+sub add_note ($$$) {
+ my ($server, $target, $num) = @_;
+ my $witem;
+ if (defined $server) {
+ $witem = $server->window_item_find($target);
+ } else {
+ $witem = Irssi::window_item_find($target);
+ }
+ if (defined $witem) {
+ $witem->print("%R>>%n OpenURL ".$num, MSGLEVEL_CLIENTCRAP);
+ # create a unique ID for the mark
+ my $foo = time().'-'.int(rand()*1000);
+ $witem->window()->view()->set_bookmark_bottom("openurl_".$num.'-'.$foo);
+ return("openurl_".$num.'-'.$foo);
+ }
+ return(undef);
+}
+
+sub clear_urls {
+ del_notes($_) foreach (0..scalar(@urls)-1);
+ pop(@urls) foreach (1..scalar(@urls));
+ $recent = 1;
+ print CLIENTCRAP '%R>>%n URLs cleared';
+}
+
+sub cmd_openurl ($$$) {
+ my ($arg, $server, $witem) = @_;
+ my @args = split(/ /, $arg);
+ if (scalar(@args) == 0) {
+ list_urls;
+ } elsif ($args[0] eq 'clear') {
+ clear_urls;
+ } elsif ($args[0] eq 'topics') {
+ event_topic_changed($_) foreach (Irssi::channels());
+ } elsif ($args[0] eq 'help') {
+ show_help();
+ } elsif ($args[0] eq 'open') {
+ launch_url($args[1]);
+ } else {
+ my $paste = 0;
+ if ($args[0] eq 'paste') {
+ $paste = 1;
+ shift(@args);
+ }
+ foreach (@args) {
+ next unless /\d+/;
+ next unless defined $urls[$_-1];
+ my $url = $urls[$_-1]->{url};
+ if ($paste == 1) {
+ if (ref $witem && ($witem->{type} eq "CHANNEL" || $witem->{type} eq "QUERY")) {
+ $witem->command("MSG ".$witem->{name}." ".$url);
+ }
+ } else {
+ launch_url($url);
+ }
+ }
+ }
+}
+
+foreach (keys %urltypes) {
+ Irssi::settings_add_str($IRSSI{'name'}, 'openurl_app_'.$_, "screen ".$urltypes{$_}->{cmd});
+ Irssi::settings_add_bool($IRSSI{'name'}, 'openurl_watch_'.$_, 1);
+}
+Irssi::settings_add_int($IRSSI{'name'}, 'openurl_max_urls', 20);
+Irssi::settings_add_bool($IRSSI{'name'}, 'openurl_display_context', 1);
+
+Irssi::signal_add_last("message private", "event_private_message");
+Irssi::signal_add_last("message public", "event_public_message");
+Irssi::signal_add_last("channel topic changed", "event_topic_changed");
+
+#Irssi::signal_add('open url', \&launch_url);
+
+foreach my $cmd ('topics', 'clear', 'paste', 'help') {
+ Irssi::command_bind('openurl '.$cmd => sub {
+ cmd_openurl("$cmd ".$_[0], $_[1], $_[2]); });
+}
+Irssi::command_bind('openurl', 'cmd_openurl');
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /openurl help for help';
diff --git a/scripts/operit.pl b/scripts/operit.pl
new file mode 100644
index 0000000..60f3181
--- /dev/null
+++ b/scripts/operit.pl
@@ -0,0 +1,320 @@
+### operit.pl (c) 2002, 2003 Petr Baudis <pasky@ucw.cz>
+#
+## Perform certain action (invite/op/...) on request authenticated by the
+## IRC operator status.
+#
+## See http://pasky.ji.cz/~pasky/dev/irssi/ for the latest version.
+#
+## Thanks to:
+## mofo <mick@mofo.nl> (patches)
+## Garion <garion@dnsspam.nl> (ideas)
+## Borys <borys@irc.pl> (ideas)
+## devastor <devastor@idiosynkrasia.net>(bug reports)
+## babar <babar@magicnet.org> (delay patch)
+#
+## $Id: operit.pl,v 1.14 2003/09/06 12:27:11 pasky Exp pasky $
+#
+# $Log: operit.pl,v $
+# Revision 1.14 2003/09/06 12:27:11 pasky
+# Okay, so while I'm at it updated other instance of my email addy, copyright, bunch of grammar fixes and documented the operit_public_delay variable.
+#
+# Revision 1.13 2003/09/06 12:25:09 pasky
+# Updated my email addy.
+#
+# Revision 1.12 2003/09/06 12:23:50 pasky
+# Added support for randomly delayed operit - if operit is public, the delay is zero to five seconds by default - this helps greatly if there is a lot of operit-enabled clients on a channel. Patch by Babar <babar@magicnet.org> and me.
+#
+# Revision 1.11 2003/03/20 08:58:18 pasky
+# Match whole channel, not random part, when checking for deny_channels and deny_hosts. So you can deny operits at #iraq but still allow them at #iraqlive ;-). Thanks to viha for cooperation during testing.
+#
+# Revision 1.10 2002/11/29 16:51:46 pasky
+# Don't play with channels we aren't on. Fixes occassional 'can't call method command on undefined value'; thanks to devastor for a report.
+#
+# Revision 1.9 2002/10/19 13:12:34 pasky
+# Introduced operit_allow_public (by default on), which toggles accepting of public (on-channel) operit requests. Idea by Borys.
+#
+# Revision 1.8 2002/10/13 12:33:13 pasky
+# We don't care about /^operit [^!#&]/ anymore. Thanks fly to Garion for suggestion.
+#
+# Revision 1.7 2002/10/07 14:16:58 pasky
+# Added operit_show_requests bool setting (by default 1, that is same behaviour as now).
+#
+# Revision 1.6 2002/09/01 12:27:08 pasky
+# Erm, compilation fixes.
+#
+# Revision 1.5 2002/09/01 12:24:24 pasky
+# Allow specification of more channels separated by a comma in requests. Changed default value of operit_hosts_deny to something harmless. Patch by mofo <mick@mofo.nl>.
+#
+# Revision 1.4 2002/03/13 13:17:36 pasky
+# remove one debug message accidentally left there
+#
+# Revision 1.3 2002/03/12 18:02:37 pasky
+# invait actually works now
+#
+# Revision 1.2 2002/02/05 17:47:13 pasky
+# fixed many things :^). now it basically works how it should...
+#
+# Revision 1.1 2002/02/05 16:47:09 pasky
+# Initial revision
+#
+#
+###
+
+### Inspired by Operit-2.01b+enge script for ircII+ clients by
+## - Viha (Viha@Theblah.Org)
+# - Karzan (Kari@Theblah.Org)
+#
+## Credits also go to:
+# - LuckyS (lucky@binet.lv) [bug reports]
+# - Fusion (fusion@nuts.edu) [bug reports]
+# - RA^v^EN (raven@sky.siol.org) [bug reports]
+# - tumble (tumble@openface.ca) [beta testing]
+# - koopal (andre@nl.uu.net) [script ideas]
+# - pt (primetime@wnol.net) [script ideas]
+# - delta (delta@rus.uni-stuttgart.de) [script ideas]
+# - pht (svobodam@irc.vsp.cz) [bug reports]
+# - enge (engerim@magicnet.org) [modifications]
+#
+### The most recent version can always be found at
+# http://www.vip.fi/~viha/irc/
+###
+
+use strict;
+
+use vars qw ($VERSION %IRSSI $rcsid);
+
+$rcsid = '$Id: operit.pl,v 1.14 2003/09/06 12:27:11 pasky Exp pasky $';
+($VERSION) = '$Revision: 1.14 $' =~ / (\d+\.\d+) /;
+%IRSSI = (
+ name => 'operit',
+ authors => 'Petr Baudis',
+ contact => 'pasky@ucw.cz',
+ url => 'http://pasky.ji.cz/~pasky/dev/irssi/',
+ license => 'BSD',
+ description => 'Perform certain action (invite/op/...) on request authenticated by the IRC operator status.'
+ );
+
+
+use Irssi 20021117; # timeout_add_once
+use Irssi::Irc;
+
+
+my $queue = 0; # already queued an operit? (when?)
+my $disp = 0; # already displayed kind notice about already queued operit?
+my $cmd = ""; # command issued
+my $target = ""; # who issued the command
+my $chan = ""; # object of the command
+
+my $coperit = 0;
+my $cinvait = 0;
+my $cdamode = 0;
+my $mpublic = 0;
+
+
+sub event_privmsg {
+ my ($server, $data, $nick, $address) = @_;
+ my ($msgtarget, $text) = split(/ :/, $data, 2);
+
+ return if (Irssi::settings_get_bool("operit_deny"));
+
+ if ($text =~ s/^(invait|operit|damode)( .*)?$/$2/i) {
+ if (uc($msgtarget) eq uc($server->{nick})) {
+ $mpublic = 0;
+ } else {
+ return unless (Irssi::settings_get_bool("operit_allow_public"));
+ $mpublic = 1;
+ }
+
+ if (time - $queue < 10) {
+ Irssi::print "Operit currently deactivated or queued. Request ignored."
+ if (time - $disp > 20);
+ $disp = time;
+ return;
+ }
+
+ $cmd = $1; $target = $nick; $queue = 0; $disp = 0;
+
+# if ($msgtarget eq $N or $cmd eq 'invait') {
+ if (1) {
+ ($_, $chan) = split /\s+/, $text; # oh.. oh well :)
+ my $a = 0;
+
+ $chan = $msgtarget if (not $chan and $msgtarget ne $server->{nick});
+ return unless ($chan =~ /^[#!&]/);
+
+ foreach (split /\s+/, Irssi::settings_get_str("operit_chans")) {
+ s/\./\\./;
+ s/\*/.*/g;
+ if ($chan =~ /^$_$/i) {
+ $a++;
+ }
+ }
+
+ unless ($a) {
+ Irssi::print "Unauthorized $cmd $chan by $target (not in operit_chans)" if (Irssi::settings_get_bool("operit_show_requests"));
+ return;
+ }
+
+ foreach (split /\s+/, Irssi::settings_get_str("operit_chans_deny")) {
+ s/\./\\./;
+ s/\*/.*/g;
+ if ($chan =~ /^$_$/i) {
+ Irssi::print "Unauthorized $cmd $chan by $target (in operit_chans_deny)" if (Irssi::settings_get_bool("operit_show_requests"));
+ return;
+ }
+ }
+
+ foreach (split /^\s+$/, Irssi::settings_get_str("operit_hosts_deny")) {
+ s/\./\\./;
+ s/\*/.*/g;
+ if ($address =~ /$_/i) {
+ Irssi::print "Unauthorized $cmd $chan by $target <$address> (in operit_hosts_deny)" if (Irssi::settings_get_bool("operit_show_requests"));
+ return;
+ }
+ }
+
+ $queue = time;
+
+ $server->redirect_event("userhost", 1, $target, 0, 'redir userhost_operit_error',
+ {"event 302" => "redir userhost_operit"});
+
+ $server->command("USERHOST $target");
+ }
+ }
+}
+
+sub event_userhost_error {
+ Irssi::print "Operit userhost on $target failed, aborting the action...";
+
+ $queue = $disp = 0;
+}
+
+
+sub event_userhost_operit {
+ my ($server, $data) = @_;
+ my ($mynick, $reply) = split(/ +/, $data);
+ my ($nick, $user, $host) = $reply =~ /^:(.*)=.(.*)@(.*)/;
+
+ unless ($nick =~ s/\*$//) {
+ Irssi::print "$target requested UNAUTHORIZED $cmd on channel $chan" if (Irssi::settings_get_bool("operit_show_requests"));
+ return;
+ }
+
+ Irssi::print "$target requested $cmd on channel $chan" if (Irssi::settings_get_bool("operit_show_requests"));
+
+ foreach my $chansplit (split(/\,/, $chan)) {
+ my $channel = $server->channel_find($chansplit);
+
+ next unless ($channel);
+
+ if (lc($cmd) eq "operit") {
+ if ($mpublic) {
+ my $precision = 10; # Delay precision (10 = 1/10s)
+ my $rdelay = int(rand(Irssi::settings_get_str("operit_public_delay") * $precision)) * 1000 / $precision;
+
+ Irssi::print "Waiting " . ($rdelay / 1000) . " seconds before executing PUBLIC $cmd for $target on $chan";
+ Irssi::timeout_add_once($rdelay + 11, sub { # XXX why + 10 ? --pasky
+ my ($target, $channel) = @{$_[0]};
+ my ($tgrec) = $channel->nick_find($target);
+ $channel->command("op $target") unless ($tgrec and $tgrec->{'op'});
+ }, [ $target, $channel ]);
+ } else {
+ $channel->command("op $target");
+ }
+ $coperit++;
+
+ } elsif (lc($cmd) eq "invait") {
+ $server->command("invite $target $chansplit");
+ $cinvait++;
+
+ } elsif (lc($cmd) eq "damode") {
+ $server->command("notice $target mode for $chansplit is +$channel->{mode}");
+ $cdamode++;
+ }
+ }
+
+ $queue = $disp = 0;
+}
+
+
+sub event_ctcp {
+ my ($server, $data, $nick, $address, $target) = @_;
+
+ return if (Irssi::settings_get_bool("operit_deny"));
+
+ if ($data =~ /^operit/i) {
+ Irssi::print "$nick requested operit thru CTCP... no way!" if (Irssi::settings_get_bool("operit_show_requests"));
+ $server->command("NOTICE $nick ssshht!");
+ Irssi::signal_stop();
+ }
+}
+
+
+sub cmd_operit {
+ my ($data, $server, $channel) = @_;
+
+ if ($data =~ /^(usage|help)/i) {
+
+ foreach (split /\n/, <<USAGEE
+Operit:
+
+Local commands
+
+operit usage - This help.
+operit help - This help.
+operit status - Display statistical information.
+
+Remote commands
+
+operit #chan - Op the person in question on #chan. (req. *)
+invait #chan - Invait the person in question to #chan. (req. *)
+damode #chan - Give the person in question the modes of #chan. (req. *)
+
+Variables
+
+operit_chans - The channelmask operit/invait is permitted on. (* is *)
+operit_chans_deny - The channel(s) operit/invait is not permitted on. (* is *)
+operit_hosts_deny - The user\@host(s) operit/invait is not permitted from. (* is *)
+operit_deny - Toogle this ON if you don't actually want invait/operit to function.
+operit_show_requests
+ - Toogle this OFF if you don't want to see messages about operit requests.
+operit_allow_public
+ - Toogle this OFF if you don't want requests written on channels to be proceeded.
+operit_public_delay
+ - Set this to 0 if you don't want random delay between request and action.
+USAGEE
+ ) {
+ Irssi::print $_;
+ }
+
+ } elsif ($data =~ /^status/i) {
+ my $ctotal = $coperit + $cinvait + $cdamode;
+
+ Irssi::print "Operit $VERSION Status:";
+ Irssi::print "The last person to request $cmd was $target [$chan].";
+ Irssi::print "This session has served $coperit op-requests, $cinvait invite-requests and $cdamode mode-requests.";
+ Irssi::print "Making a total of $ctotal succesful requests.";
+
+ } else {
+ Irssi::print "Excuse moi, sir? I guess that you want /operit usage ..?";
+ }
+}
+
+
+Irssi::command_bind("operit", "cmd_operit");
+Irssi::signal_add("redir userhost_operit", "event_userhost_operit");
+Irssi::signal_add("redir userhost_operit_error", "event_userhost_error");
+Irssi::signal_add("default ctcp msg", "event_ctcp");
+Irssi::signal_add("event privmsg", "event_privmsg");
+
+
+Irssi::settings_add_str("operit", "operit_chans", "#* !*");
+Irssi::settings_add_str("operit", "operit_chans_deny", "#ircophackers");
+Irssi::settings_add_str("operit", "operit_hosts_deny", "*!*@*.lamehost1 *lamehost2");
+Irssi::settings_add_bool("operit", "operit_deny", 0);
+Irssi::settings_add_bool("operit", "operit_show_requests", 1);
+Irssi::settings_add_bool("operit", "operit_allow_public", 1);
+Irssi::settings_add_str("operit", "operit_public_delay", 5);
+
+
+Irssi::print("Operit $VERSION loaded... see command 'operit usage'");
diff --git a/scripts/operview.pl b/scripts/operview.pl
new file mode 100644
index 0000000..6690851
--- /dev/null
+++ b/scripts/operview.pl
@@ -0,0 +1,422 @@
+# Operview - reformats some server notices, which may come i.e. from &clients
+# or &servers. Also reformat some incoming server numerics from advanced
+# commands like STATS.
+#
+# Note that whole this script is VERY ircnet-specific!
+#
+# Provided variables:
+#
+# mangle_stats_output - turn the mangling of /stats output on/off
+# mangle_server_notices - turn the mangling of server notices on/off
+# ignore_server_kills - we won't display nickname collissions
+# show_kills_path - we will display kill's path
+#
+# $Id: operview.pl,v 1.11 2002/03/30 21:16:06 pasky Exp pasky $
+#
+
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use Irssi::TextUI;
+
+use vars qw ($VERSION %IRSSI $rcsid);
+
+$rcsid = '$Id: operview.pl,v 1.11 2002/03/30 21:16:06 pasky Exp pasky $';
+($VERSION) = '$Revision: 1.11 $' =~ / (\d+\.\d+) /;
+%IRSSI = (
+ name => 'operview',
+ authors => 'Petr Baudis',
+ contact => 'pasky@ji.cz',
+ url => 'http://pasky.ji.cz/~pasky/dev/irssi/',
+ license => 'GPLv2, not later',
+ description => 'Reformats some server notices, which may come i.e. from &clients or &servers at IRCnet. You can turn the script on/off bytoggling variable mangle_server_notices.',
+ sbitems => 'sclientcount kills',
+ );
+
+my $mangle_stats_output;
+my $mangle_server_notices;
+my $ignore_server_kills;
+my $show_kills_path;
+
+my @lastkill = ('','','');
+my @curclientcount = (0,0);
+
+Irssi::theme_register([
+ client_connect => '{servernotice $0}Connect : {nick $[9]1} :: {nickhost $2%R@%n$3} {comment $4} :: $5-',
+ client_exit => '{servernotice $0}Disconnect : {nick $[9]1} :: {nickhost $2%R@%n$3} :: $4-',
+ client_nick => '{servernotice $0}{nick $[9]1} -> {nick $[9]2} :: {nickhost $3%R@%n$4}',
+ kills_kill => '{servernotice $0}Received %gKILL%n {nick $[9]1} ({server $2}) :: $3', # TODO: parse the path? subject to change
+ kills_operkill => '{servernotice $0}Received %gKILL%n {nick $[9]1} (%R$2%n) :: $3',
+ kills_collide => '{servernotice $0}Nick %gCOLLISION%n {nick $[9]1} :: $2',
+ servers_server => '{servernotice $0}Received %gSERVER%n {server $1} from {server $2} :: %G$3%w {comment $5} $6-',
+ servers_squit => '{servernotice $0}Received %gSQUIT %n {server $1} from {server $2} :: %R$3-%w',
+ servers_sserver=> '{servernotice $0}Sending %gSERVER%n {server $1} :: %G$2%w {comment $4} $5-',
+ servers_ssquit => '{servernotice $0}Sending %gSQUIT %n {server $1} :: %R$2-%w',
+
+# TODO: Header ? sendq smsgs skbs rmsgs rkbs age
+ stats_l => '$[!9]0 :: $[!7]3 %g<s%n $[!5]4 $[!5]5 %gr>%n $[!5]6 $[!5]7 :: $[!6]8 :: {nickhost $1%R@%n$2}',
+# TODO: Header ? pingf connf maxlinks sendq local limit global limit
+ stats_y => '$0 :: $[!4]1 :: %gpf%n $[!4]2 %gcf%n $[!4]3 %gml%n $[!4]4 %gsq%n $[!8]5 %gll%n $[!-2]6%K.%n$[!2]7 %ggl%n $[!-2]8%K.%n$[!2]9',
+# TODO: Header ? haddr hname passwd port class
+ stats_i => '$0 :: $[!20]1 $[!22]3 :: $[!6]2 :: %gp%n $4 %gc%n $5',
+# TODO: Header ? port class (N/A) host reason
+ stats_k => '$0 :: %gp%n $[!4]4 %gc%n $[!2]5 :: {nickhost $3%R@%n$1} :: $2',
+# TODO: Header ? port/masklvl class sname host passw
+ stats_c => '$0 :: %gp%n $[!4]5 %gc%n $[!2]6 :: $4 :: {nickhost $1%R@%n$2} :: $3',
+ stats_n => '$0 :: %gm%n $[!4]5 %gc%n $[!2]6 :: $4 :: {nickhost $1%R@%n$2} :: $3',
+
+# I wasn't able to discover how to get this working for statusbars. So THIS IS
+# NO-OP! Seek for its second incarnation hardcoded somewhere below.
+
+ sb_kill => '{sb $0%R@%n$1}',
+ sb_operkill => '{sb $0%R<%n$1}',
+ sb_collision => '{sb $0%R!%n}',
+ sb_sclientcount=> '{sb $0%c/%n$1%cs%n}',
+]);
+
+
+sub event_server_notice {
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $text) = $data =~ /^(\S*)\s+:(.*)$/;
+ my (@text) = split(/ /, $text);
+
+ $show_kills_path = Irssi::settings_get_bool("show_kills_path");
+ $ignore_server_kills = Irssi::settings_get_bool("ignore_server_kills");
+ $mangle_server_notices = Irssi::settings_get_bool("mangle_server_notices");
+ return unless ($mangle_server_notices);
+
+ return if ($address or $nick !~ /\./);
+
+ if ($target eq '&CLIENTS') {
+
+ if ($text =~ /^Client connecting/) {
+ my (@fa) = ($text[2], $text[4], $text[6], $text[7], join(" ", splice(@text, 9)));
+
+ $fa[3] =~ s/^\[(.*)\]$/$1/;
+
+ $server->printformat($target, MSGLEVEL_SNOTES, "client_connect",
+ $nick, @fa);
+ Irssi::signal_stop();
+
+ } elsif ($text =~ /^Client exiting/) {
+ my (@fa) = ($text[2], $text[4], $text[6], join(" ", splice(@text, 8)));
+
+ $server->printformat($target, MSGLEVEL_SNOTES, "client_exit",
+ $nick, @fa);
+ Irssi::signal_stop();
+
+ } elsif ($text =~ /^Nick change/) {
+ my (@fa) = ($text[2], $text[4], $text[6], $text[8]);
+
+ $server->printformat($target, MSGLEVEL_SNOTES, "client_nick",
+ $nick, @fa);
+ Irssi::signal_stop();
+ }
+
+ } elsif ($target eq '&KILLS') {
+
+ if ($text =~ /^Received KILL/) {
+ my (@fa) = ($text[4], $text[6], join(" ", splice(@text, 9 - $show_kills_path)));
+
+ $fa[0] =~ s/\.$//;
+
+ if ($fa[1] =~ /\./) {
+ $server->printformat($target, MSGLEVEL_SNOTES, "kills_kill",
+ $nick, @fa) unless ($ignore_server_kills);
+ @lastkill = ($fa[0], $fa[1], 's');
+ } else {
+ $server->printformat($target, MSGLEVEL_SNOTES+MSGLEVEL_HILIGHT, "kills_operkill",
+ $nick, @fa);
+ @lastkill = ($fa[0], $fa[1], 'o');
+ }
+ refresh_kills();
+ Irssi::signal_stop();
+
+ } elsif ($text =~ /^Nick collision on/) {
+ my (@fa) = ($text[3], join(" ", splice(@text, 4)));
+
+ $server->printformat($target, MSGLEVEL_SNOTES, "kills_collide",
+ $nick, @fa);
+ @lastkill = ($fa[0], '', 'c');
+
+ refresh_kills();
+ Irssi::signal_stop();
+ }
+
+ } elsif ($target eq '&NOTICES') {
+ if ($text =~ /^Local increase from/) {
+ @curclientcount = ($text[5], $text[8]);
+ refresh_sclientcount();
+ }
+
+ } elsif ($target eq '&SERVERS') {
+
+ if ($text =~ /^Received SERVER/) {
+ my ($sname) = join(" ", splice(@text, 5));
+ my (@fa) = ($text[2], $text[4],
+ $sname =~ /^\((\d+)\s+(\[(.+?)\])?\s*(.*)\)$/);
+
+ $server->printformat($target, MSGLEVEL_SNOTES, "servers_server",
+ $nick, @fa);
+ Irssi::signal_stop();
+
+ } elsif ($text =~ /^Received SQUIT/) {
+ my (@fa) = ($text[2], $text[4], join(" ", splice(@text, 5)));
+
+ $fa[2] =~ s/^\((.*)\)$/$1/;
+
+ $server->printformat($target, MSGLEVEL_SNOTES, "servers_squit",
+ $nick, @fa);
+ Irssi::signal_stop();
+
+ } elsif ($text =~ /^Sending SERVER/) {
+ my ($sname) = join(" ", splice(@text, 3));
+ my (@fa) = ($text[2], $sname =~ /^\((\d+)\s+(\[(.+?)\])?\s*(.*)\)$/);
+
+ $server->printformat($target, MSGLEVEL_SNOTES, "servers_sserver",
+ $nick, @fa);
+ Irssi::signal_stop();
+
+ } elsif ($text =~ /^Sending SQUIT/) {
+ my (@fa) = ($text[2], join(" ", splice(@text, 3)));
+
+ $fa[1] =~ s/^\((.*)\)$/$1/;
+
+ $server->printformat($target, MSGLEVEL_SNOTES, "servers_ssquit",
+ $nick, @fa);
+ Irssi::signal_stop();
+ }
+
+ }
+}
+
+
+sub event_stats_numeric {
+ my ($server, $data, $srvname) = @_;
+ my ($target, $text) = $data =~ /^(\S*)\s+(.*)$/;
+ my (@text) = split(/ /, $text);
+ my ($num) = Irssi::signal_get_emitted() =~ /^event (\d+)$/;
+
+ $mangle_stats_output = Irssi::settings_get_bool("mangle_stats_output");
+ unless ($mangle_stats_output) {
+ Irssi::print $text, MSGLEVEL_CRAP;
+ return;
+ }
+
+ unless ($num) {
+ Irssi::print "[OperView] Internal error - emitted signal '".Irssi::signal_get_emitted()."' is not numerics event.";
+ return;
+ }
+
+# Irssi::print "[$num][] $data -> $target , $text";
+
+ if ($num == 211) {
+# STATS L
+#:irc.cis.vutbr.cz 211 `asdf irc.cis.vutbr.cz[0.0.0.0@.3333] 0 92727331 1888902 168822985 3078358 :3201373
+#:irc.cis.vutbr.cz 211 `asdf irc.felk.cvut.cz[ircd@147.32.80.79] 6038 4876 52 268097 6375 :1427
+#:irc.cis.vutbr.cz 211 `asdf [unknown@66.135.66.250] 0 0 0 0 0 :0
+#:irc.cis.vutbr.cz 211 `asdf `asdf[~a@pasky.ji.cz] 478 2057 162 13 0 :324
+#:irc.cis.vutbr.cz 211 `asdf [@66.135.66.250] 0 10 0 11 0 :81
+#:irc.cis.vutbr.cz 211 `asdf `asdf[@62.44.12.54] 517 129 10 4 0 :87
+ my (@fa) = $text =~ /^(.*?)?\[([^[]*?)?@(.*?)\] (\d+) (\d+) (\d+) (\d+) (\d+) :(\d+)$/;
+
+ unless ($fa[2]) {
+ Irssi::print $text, MSGLEVEL_CRAP;
+ } else {
+ $server->printformat($target, MSGLEVEL_CRAP, "stats_l", @fa);
+ }
+ Irssi::signal_stop();
+
+ } elsif ($num == 218) {
+# STATS Y
+#:irc.cis.vutbr.cz 218 `asdf Y 0 120 600 1 384084 0.0 0.0
+#:irc.cis.vutbr.cz 218 `asdf Y 10 300 0 1 500000 1.1 1.1
+#:irc.cis.vutbr.cz 218 `asdf Y 12 300 0 10 700000 10.10 10.10
+#:irc.cis.vutbr.cz 218 `asdf Y 1 300 0 400 700000 10.3 10.3
+ my (@fa) = $text =~ /^(.) (\d+) (\d+) (\d+) (\d+) (\d+) (\d+)\.(\d+) :?(\d+)\.(\d+)$/;
+
+ unless ($fa[0]) {
+ Irssi::print $text, MSGLEVEL_CRAP;
+ } else {
+ $server->printformat($target, MSGLEVEL_CRAP, "stats_y", @fa);
+ }
+ Irssi::signal_stop();
+
+ } elsif ($num == 215) {
+# STATS I
+#:irc.cis.vutbr.cz 215 `asdf I pilsedu.cz <NULL> pilsedu.cz 0 12
+#:irc.cis.vutbr.cz 215 `asdf I x.opf.slu.cz <NULL> x.opf.slu.cz 0 9
+#:irc.cis.vutbr.cz 215 `asdf I 64.44.4.128/29 <NULL> <NULL> 0 1
+ my (@fa) = $text =~ /^(.) (\S+) (\S+) (\S+) (\d+) :?(\d+)$/;
+
+ unless ($fa[0]) {
+ Irssi::print $text, MSGLEVEL_CRAP;
+ } else {
+ $server->printformat($target, MSGLEVEL_CRAP, "stats_i", @fa);
+ }
+
+ Irssi::signal_stop();
+
+ } elsif ($num == 216) {
+# STATS K
+#:irc.cis.vutbr.cz 216 `asdf K *@*.*.*.*.*.*.*.*.* Access_denied,please_fix_your_domain_name * 0 -1
+#:irc.cis.vutbr.cz 216 `asdf K 195.116.4.* Access_denied,reason-use_servers_in_Poland * 0 -1
+#:irc.cis.vutbr.cz 216 `asdf K korak.isternet.sk abuse - expire 01.08.2003 16.26 * 0 -1
+#:irc.cis.vutbr.cz 216 `asdf K 193.84.192.0/24 compromissed network - expire 05.04.2002 22.37 * 0 -1
+ my (@fa) = $text =~ /^(.) (\S+) (.+) (\S+) (\d+) :?([-0-9]+)$/;
+
+ unless ($fa[0]) {
+ Irssi::print $text, MSGLEVEL_CRAP;
+ } else {
+ $server->printformat($target, MSGLEVEL_CRAP, "stats_k", @fa);
+ }
+
+ Irssi::signal_stop();
+
+ } elsif ($num == 213) {
+# STATS C
+#:irc.cis.vutbr.cz 213 `asdf c *@129.143.67.242 * *.de 6666 6
+#:irc.cis.vutbr.cz 213 `asdf c *@141.24.101.9 * *.de 6667 6
+#:irc.cis.vutbr.cz 213 `asdf c *@131.174.124.200 * *.sci.kun.nl 6667 6
+#:irc.cis.vutbr.cz 213 `asdf c *@130.240.16.47 * *.se 6667 6
+#:irc.cis.vutbr.cz 213 `asdf c *@147.32.80.79 * irc.felk.cvut.cz 6664 6
+#:irc.cis.vutbr.cz 213 `asdf c *@195.146.134.62 * *.sk 0 2
+#:irc.cis.vutbr.cz 213 `asdf c *@195.168.1.141 * *.sk 0 2
+ my (@fa) = $text =~ /^(.) (\S+)@(\S+) (\S+) (\S+) ([.0-9]+) :?([-0-9]+)$/;
+
+ unless ($fa[0]) {
+ Irssi::print $text, MSGLEVEL_CRAP;
+ } else {
+ $server->printformat($target, MSGLEVEL_CRAP, "stats_c", @fa);
+ }
+
+ Irssi::signal_stop();
+
+ } elsif ($num == 214) {
+# (STATS N)
+#:irc.cis.vutbr.cz 214 `asdf N *@129.143.67.242 * *.de 0 6
+#:irc.cis.vutbr.cz 214 `asdf N *@141.24.101.9 * *.de 3 6
+#:irc.cis.vutbr.cz 214 `asdf N *@131.174.124.200 * *.sci.kun.nl 3 6
+#:irc.cis.vutbr.cz 214 `asdf N *@130.240.16.47 * *.se 3 6
+#:irc.cis.vutbr.cz 214 `asdf N *@147.32.80.79 * irc.felk.cvut.cz 0 6
+#:irc.cis.vutbr.cz 214 `asdf N *@195.146.134.62 * *.sk 3 2
+#:irc.cis.vutbr.cz 214 `asdf N *@195.168.1.141 * *.sk 3 2
+ my (@fa) = $text =~ /^(.) (\S+)@(\S+) (\S+) (\S+) (\d+) :?(\d+)$/;
+
+ unless ($fa[0]) {
+ Irssi::print $text, MSGLEVEL_CRAP;
+ } else {
+ $server->printformat($target, MSGLEVEL_CRAP, "stats_n", @fa);
+ }
+
+ Irssi::signal_stop();
+=brm
+ } elsif ($num == 250) {
+
+#TRACE
+#:irc.cis.vutbr.cz 204 `asdf Oper 12 pasky[~pasky@pasky.ji.cz]
+#:irc.cis.vutbr.cz 206 `asdf Serv 6 46S 95580C irc.felk.cvut.cz[ircd@147.32.80.79] *!*@irc.cis.vutbr.cz VFz
+#:irc.cis.vutbr.cz 205 `asdf User 1 `asdf[~a@pasky.ji.cz]
+#:irc.cis.vutbr.cz 262 `asdf irc.cis.vutbr.cz 2.10.3p3.addpl2.hemp. :End of TRACE
+#
+#STATS O
+#:irc.cis.vutbr.cz 243 `asdf O revisor@*.ssakhk.cz * erixon 0 10
+#:irc.cis.vutbr.cz 243 `asdf O cf@candyflip.junkie.cz * cf 0 12
+#:irc.cis.vutbr.cz 243 `asdf O *@pilsedu.cz * jv 0 12
+#:irc.cis.vutbr.cz 243 `asdf O *@62.44.12.54 * pasky 0 12
+#:irc.cis.vutbr.cz 243 `asdf O *@bsd.xcem.com * Krash 0 10
+#:irc.cis.vutbr.cz 243 `asdf O spike@*.pantexcom.com * Krash 0 10
+#:irc.cis.vutbr.cz 243 `asdf O fantomas@*.fantomas.sk * filozof 0 10
+#:irc.cis.vutbr.cz 243 `asdf O *@147.229.1.11 * StiX 0 10
+#:irc.cis.vutbr.cz 243 `asdf O *@160.216.0.0/16 * StiX 0 10
+#:irc.cis.vutbr.cz 219 `asdf O :End of STATS report
+
+# STATS H
+#:irc.cis.vutbr.cz 250 `asdf D *.fr.ircnet.net <NULL> * 0 0
+#:irc.cis.vutbr.cz 250 `asdf D *.belnet.be <NULL> * 0 0
+#:irc.cis.vutbr.cz 244 `asdf H * <NULL> irc.felk.cvut.cz 0 -1
+#:irc.cis.vutbr.cz 244 `asdf H * <NULL> *.de 0 -1
+#:irc.cis.vutbr.cz 244 `asdf H * <NULL> *.sci.kun.nl 0 -1
+#:irc.cis.vutbr.cz 244 `asdf H * <NULL> *.fi 0 -1
+#:irc.cis.vutbr.cz 244 `asdf H * <NULL> *.se 0 -1
+#:irc.cis.vutbr.cz 244 `asdf H * <NULL> *.sk 0 -1
+#:irc.cis.vutbr.cz 244 `asdf H * <NULL> irc.uhk.cz 0 -1
+#:irc.cis.vutbr.cz 219 `asdf H :End of STATS report
+ my (@fa) = $text =~ /^(.) (\S+)@(\S+) (\S+) (\S+) (\d+) :?(\d+)$/;
+
+ Irssi::print $text unless ($fa[0]);
+
+ $server->printformat($target, MSGLEVEL_CRAP, "stats_n",
+ @fa);
+ Irssi::signal_stop();
+=cut
+ }
+}
+
+
+
+
+#
+### Statusbar stuff
+#
+
+
+sub sclientcount {
+ my ($item, $get_size_only) = @_;
+ my $f = '{sb '.$curclientcount[0].'%c/%n'.$curclientcount[1].'%cs%n}';
+
+ $item->default_handler($get_size_only, $f, undef, 1);
+}
+
+sub kills {
+ my ($item, $get_size_only) = @_;
+ my $theme = Irssi::current_theme();
+ my $f = '{sb %n}';
+
+ if ($lastkill[2] eq 's') {
+# Thanks to cras and darix for helping with following:
+# FIXME: Return value of following is for some reason "Perl script".
+# $f = Irssi::active_win()->format_get_text("Irssi::Script::operview", Irssi::active_server(), undef, 'sb_kill', @lastkill);
+
+ $f = '{sb '.$lastkill[0].'%c@%n'.$lastkill[1].'}';
+ } elsif ($lastkill[2] eq 'o') {
+ $f = '{sb '.$lastkill[0].'%c<%n'.$lastkill[1].'}';
+ } elsif ($lastkill[2] eq 'c') {
+ $f = '{sb '.$lastkill[0].'%c!%n}';
+ }
+
+ $item->default_handler($get_size_only, $f, undef, 1);
+}
+
+
+sub refresh_sclientcount {
+ Irssi::statusbar_items_redraw('sclientcount');
+}
+
+sub refresh_kills {
+ Irssi::statusbar_items_redraw('kills');
+}
+
+
+Irssi::signal_add("event notice", "event_server_notice");
+Irssi::signal_add("event 211", "event_stats_numeric");
+Irssi::signal_add("event 213", "event_stats_numeric");
+Irssi::signal_add("event 214", "event_stats_numeric");
+Irssi::signal_add("event 215", "event_stats_numeric");
+Irssi::signal_add("event 216", "event_stats_numeric");
+Irssi::signal_add("event 218", "event_stats_numeric");
+#Irssi::signal_add("event 243", "event_stats_numeric");
+#Irssi::signal_add("event 244", "event_stats_numeric");
+#Irssi::signal_add("event 250", "event_stats_numeric");
+
+Irssi::settings_add_bool("lookandfeel", "mangle_stats_output", 0);
+Irssi::settings_add_bool("lookandfeel", "mangle_server_notices", 1);
+Irssi::settings_add_bool("lookandfeel", "ignore_server_kills", 0);
+Irssi::settings_add_bool("lookandfeel", "show_kills_path", 0);
+
+Irssi::statusbar_item_register("sclientcount", '$0', 'sclientcount');
+Irssi::statusbar_item_register("kills", '$0', 'kills');
+Irssi::statusbars_recreate_items();
+
+Irssi::print("OperView $VERSION loaded...");
diff --git a/scripts/opnotice.pl b/scripts/opnotice.pl
new file mode 100644
index 0000000..0bb03ec
--- /dev/null
+++ b/scripts/opnotice.pl
@@ -0,0 +1,56 @@
+# Opnotice script, by Terje Tjeldnes (terje@darkrealm.no)
+# Compatible with bahamut (DALnet ircd) or any other ircd with
+# support for the /notice @#channel syntax.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# The complete text of the GNU General Public License can be found
+# on the World Wide Web: <URL:http://www.gnu.org/licenses/gpl.html>
+#
+# Commands: /o <text> in a channel.
+
+use strict;
+use Irssi;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.1";
+
+%IRSSI = (
+ authors => "Terje \"xerath\" Tjeldnes",
+ contact => "terje\@darkrealm.no",
+ name => "Opnotice",
+ url => "http://palantir.darkrealm.no/opnotice.pl",
+ license => "GNU GPL v2",
+ changed => "Thu Jul 25 00:19:09 CEST 2002"
+);
+
+
+sub cmd_opnotice {
+my ($data, $server, $witem) = @_;
+
+if (!$server || !$server->{connected}) {
+ Irssi::print("Not connected to server");
+ return;
+}
+
+if ($witem && ($witem->{type} eq "CHANNEL")) {
+ chomp ($data);
+ $witem->command("NOTICE \@".$witem->{name}." $data");
+ }
+ else {
+ Irssi::print("Not in a channel, aborted");
+ }
+}
+
+Irssi::command_bind('o', 'cmd_opnotice');
+
+
diff --git a/scripts/opnotify.pl b/scripts/opnotify.pl
new file mode 100644
index 0000000..beb99d0
--- /dev/null
+++ b/scripts/opnotify.pl
@@ -0,0 +1,47 @@
+use Irssi 20020300;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.0";
+%IRSSI = (
+ authors => "Maciek \'fahren\' Freudenheim",
+ contact => "fahren\@bochnia.pl",
+ name => "opnotify",
+ description => "Hilights window refnumber in statusbar if someone ops/deops you on channel",
+ license => "GNU GPLv2 or later",
+ changed => "Fri Mar 15 15:09:42 CET 2002"
+);
+
+sub event_modechange {
+ my ($server, $data, $nick) = @_;
+ my ($channel, $mode, $rest) = split(/ /, $data, 3);
+ my $win = Irssi::active_win();
+ my $winchan = $server->window_find_item($channel);
+
+ return if $win->{refnum} == $winchan->{refnum};
+
+ my @rest = split(/ +/, $rest);
+
+ # l4m3 but speeds-up
+ return unless grep {/^$server->{nick}$/} @rest;
+
+ my $par = undef;
+ my $ind = 0;
+ my $op = $winchan->{active}->{chanop};
+ my $gotop = $op;
+
+ for my $c (split(//, $mode)) {
+ if ($c =~ /[+-]/) {
+ $par = $c;
+ } elsif ($c eq "o") {
+ $gotop = ($par eq "+"? 1 : 0) if $rest[$ind++] eq $server->{nick};
+ } elsif ($c =~ /[vbkeIqhdO]/ || ($c eq "l" && $par eq "+")) {
+ $ind++;
+ }
+ }
+
+ $winchan->activity(4) unless $gotop == $op;
+# Irssi::print("%R>>%n $nick " . (($gotop)? "opped" : "deopped") . " You on %_$channel%_ /" . $server->{tag} . "/") unless $gotop == $op;
+}
+
+Irssi::signal_add("event mode", "event_modechange");
diff --git a/scripts/osd.pl b/scripts/osd.pl
new file mode 100644
index 0000000..1099c53
--- /dev/null
+++ b/scripts/osd.pl
@@ -0,0 +1,313 @@
+use strict;
+use IO::Handle;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+$VERSION = '0.3.4';
+%IRSSI = (
+ authors => 'Jeroen Coekaerts, Koenraad Heijlen',
+ contact => 'vipie@ulyssis.org, jeroen@coekaerts.be',
+ name => 'osd',
+ description => 'An OnScreenDisplay (osd) it show\'s who is talking to you, on what IRC Network.',
+ license => 'BSD',
+ url => 'http://vipie.studentenweb.org/dev/irssi/',
+ changed => '2017-06-12'
+);
+
+#--------------------------------------------------------------------
+# Changelog
+# 2004-01-09
+# - fix a typo in the help (M.G.Kishalmi)
+# TODO :
+#
+# * a setting that let's you display the text? (exploits?!)
+#
+#--------------------------------------------------------------------
+
+
+#--------------------------------------------------------------------
+# Public Variables
+#--------------------------------------------------------------------
+my %myHELP = ();
+
+#--------------------------------------------------------------------
+# Help function
+#--------------------------------------------------------------------
+sub cmd_help {
+ my ($about) = @_;
+
+ %myHELP = (
+ osd_test => "
+osd_test
+
+Displays a small test message on screen
+",
+
+ osd_reload => "
+osd_reload
+
+Restarts the osd_cat program, it's especially need when
+have CHANGED settings. They DO NOT take effect UNTIL you RELOAD.
+",
+
+ osd => "
+OSD
+
+You can display on screen who is paging/msg'ing you on IRC.
+
+When you CHANGE the settings you SHOULD use /osd_reload to let these changes
+take effect.
+
+Settings:
+---------
+
+* osd_color (default: blue)
+Currently the setting is: " . Irssi::settings_get_str('osd_color') . "
+
+It should be a valid X color, the list in normally located in /etc/X11/rgb.txt.
+
+* osd_font (default: -*-helvetica-medium-r-\*-\*-\*-320-\*-\*-\*-\*-\*-\*)
+Currently the setting is: " . Irssi::settings_get_str('osd_font') . "
+
+These fonts are available when you installed the microsoft font pack :-)
+-microsoft-tahoma-bold-r-normal-*-\*-320-\*-\*-p-\*-\*-\*
+-microsoft-verdana-bold-r-normal-\*-\*-320-\*-\*-p-\*-\*-\*
+
+This font is available on every linux install with the adobe fonts.
+-*-helvetica-medium-r-\*-\*-\*-320-\*-\*-\*-\*-\*-\*
+
+* osd_align (default: right)
+Currently the setting is: " . Irssi::settings_get_str('osd_align') . "
+
+left|right|center (horizontal alignment)
+
+* osd_place (default: top)
+Currently the setting is: " . Irssi::settings_get_str('osd_place') . "
+
+top|bottom|middle (vertical alginment)
+
+* osd_offset (default: 100)
+Currently the setting is: " . Irssi::settings_get_str('osd_offset') . "
+
+The vertical offset from the screen edge set in osd_place.
+
+* osd_indent (default: 100)
+Currently the setting is: " . Irssi::settings_get_str('osd_indent') . "
+
+The horizontal offset from the screen edge set in osd_align.
+
+* osd_shadow (default: 0)
+Currently the setting is: " . Irssi::settings_get_str('osd_shadow') . "
+
+Set the shadow offset, if the offset is 0, the shadow is disabled.
+
+* osd_delay (default: 4)
+Currently the setting is: " . Irssi::settings_get_str('osd_delay') . "
+
+How many seconds should the message remain on screen.
+
+* osd_age (default: 4)
+Currently the setting is: " . Irssi::settings_get_str('osd_age') . "
+
+Time in seconds before old scroll lines are discarded.
+
+* osd_lines (default: 5)
+Currently the setting is: " . Irssi::settings_get_str('osd_lines') . "
+
+Number of lines to display on screen at one time.
+
+* osd_DISPLAY (default: :0.0)
+Currently the setting is: " . Irssi::settings_get_str('osd_DISPLAY') . "
+
+On what \$DISPLAY should the osd connect. (this makes tunneling possible)
+
+* osd_showactivechannel (default: yes)
+Currently the setting is: " . Irssi::settings_get_str('osd_showactivechannel') . "
+
+When set to yes, OSD will be triggered even if the channel is the active channel.
+When set to yes, OSD will be triggered if you send a message from your own nick.
+
+You can test the OSD settings with the 'osd_test' command!
+he 'osd_test' to test them.
+
+",
+);
+
+ if ( $about =~ /(osd_reload|osd_test|osd)/i ) {
+ Irssi::print($myHELP{lc($1)});
+ }
+}
+
+#--------------------------------------------------------------------
+# Irssi::Settings
+#--------------------------------------------------------------------
+
+Irssi::settings_add_str('OSD', 'osd_color', "blue");
+
+#These fonts are available when you installed the microsoft font pack :-)
+#Irssi::settings_add_str('OSD', 'osd_font', "-microsoft-tahoma-bold-r-normal-\*-\*-320-\*-\*-p-\*-\*-\*");
+#Irssi::settings_add_str('OSD', 'osd_font', "-microsoft-verdana-bold-r-normal-\*-\*-320-\*-\*-p-\*-\*-\*");
+#This font is available on every linux install with the adobe fonts.
+Irssi::settings_add_str('OSD', 'osd_font', "-*-helvetica-medium-r-\*-\*-\*-320-\*-\*-\*-\*-\*-\*");
+
+Irssi::settings_add_str('OSD', 'osd_age', "4");
+Irssi::settings_add_str('OSD', 'osd_align', "right");
+Irssi::settings_add_str('OSD', 'osd_delay', "4");
+Irssi::settings_add_str('OSD', 'osd_indent', "100");
+Irssi::settings_add_str('OSD', 'osd_lines', "5");
+Irssi::settings_add_str('OSD', 'osd_offset', "100");
+Irssi::settings_add_str('OSD', 'osd_place', "top");
+Irssi::settings_add_str('OSD', 'osd_shadow', "0");
+Irssi::settings_add_str('OSD', 'osd_DISPLAY', ":0.0");
+Irssi::settings_add_str('OSD', 'osd_showactivechannel', "yes");
+
+#--------------------------------------------------------------------
+# initialize the pipe, test it.
+#--------------------------------------------------------------------
+
+sub init {
+ pipe_open();
+ osdprint("OSD Loaded.");
+}
+
+#--------------------------------------------------------------------
+# open the OSD pipe
+#--------------------------------------------------------------------
+
+sub pipe_open {
+ my $place;
+ my $version;
+ my $command;
+
+ $version = `osd_cat -h 2>&1` or die("The OSD program can't be started, check if you have osd_cat installed AND in your path.");
+ $version =~ /Version:\s*(.*)\s*/;
+ $version = $1;
+ #Irssi::print "Version: $version";
+
+ if ( $version =~ /^2.*/ ) {
+ # the --pos argument seems to be broken on 2.0.X
+ if ( Irssi::settings_get_str('osd_place') eq "top" ) {
+ $place = "-p top";
+ } elsif ( Irssi::settings_get_str('osd_place') eq "bottom") {
+ $place = "-p bottom";
+ } else {
+ $place = "-p middle";
+ }
+ } else {
+ if ( Irssi::settings_get_str('osd_place') eq "top" ) {
+ $place = "--top";
+ } else {
+ $place = "--bottom";
+ }
+ }
+
+ $command =
+ "env DISPLAY=".Irssi::settings_get_str('osd_display') .
+ " osd_cat $place " .
+ " --color=".Irssi::settings_get_str('osd_color').
+ " --delay=".Irssi::settings_get_str('osd_delay').
+ " --age=".Irssi::settings_get_str('osd_age').
+ " --font=".quotemeta(Irssi::settings_get_str('osd_font')).
+ " --offset=".Irssi::settings_get_str('osd_offset').
+ " --shadow=".Irssi::settings_get_str('osd_shadow').
+ " --lines=".Irssi::settings_get_str('osd_lines').
+ " --align=".Irssi::settings_get_str('osd_align');
+
+ if ( $version =~ /^2.*/ ) {
+ $command .= " --indent=".Irssi::settings_get_str('osd_indent');
+ }
+ open( OSDPIPE, "|-", $command )
+ or print "The OSD program can't be started, check if you have osd_cat installed AND in your path.";
+ OSDPIPE->autoflush(1);
+}
+
+#--------------------------------------------------------------------
+# Private message parsing
+#--------------------------------------------------------------------
+
+sub priv_msg {
+ my ($server,$msg,$nick,$address,$target) = @_;
+ if ((Irssi::settings_get_str('osd_showactivechannel') =~ /yes/) or
+ not (Irssi::active_win()->get_active_name() eq "$nick") ) {
+ osdprint($server->{chatnet}.":$nick");
+ }
+}
+
+#--------------------------------------------------------------------
+# Public message parsing
+#--------------------------------------------------------------------
+
+sub pub_msg {
+ my ($server,$msg,$nick,$address, $channel) = @_;
+ my $show;
+
+ if (Irssi::settings_get_str('osd_showactivechannel') =~ /yes/) {
+ $show = 1;
+ } elsif(uc(Irssi::active_win()->get_active_name()) eq uc($channel)) {
+ $show = 0;
+ }
+
+ if ($show) {
+ my $onick= quotemeta "$server->{nick}";
+ my $pat ='(\:|\,|\s)'; # option...
+ if($msg =~ /^$onick\s*$pat/i){
+ osdprint("$channel".":$nick");
+ }
+ }
+}
+
+#--------------------------------------------------------------------
+# The actual printing
+#--------------------------------------------------------------------
+
+sub osdprint {
+ my ($text) = @_;
+ if (not (OSDPIPE->opened())) {pipe_open();}
+ print OSDPIPE "$text\n";
+ OSDPIPE->flush();
+}
+
+#--------------------------------------------------------------------
+# A test command.
+#--------------------------------------------------------------------
+
+sub cmd_osd_test {
+ osdprint("Testing OSD");
+}
+
+#--------------------------------------------------------------------
+# A command to close and reopen OSDPIPE
+# so options take effect without needing to unload/reload the script
+#--------------------------------------------------------------------
+
+sub cmd_osd_reload {
+ close(OSDPIPE);
+ pipe_open();
+ osdprint("Reloaded OSD");
+}
+
+#--------------------------------------------------------------------
+# Irssi::signal_add_last / Irssi::command_bind
+#--------------------------------------------------------------------
+
+Irssi::signal_add_last("message public", "pub_msg");
+Irssi::signal_add_last("message private", "priv_msg");
+
+Irssi::command_bind("osd_reload","cmd_osd_reload", "OSD");
+Irssi::command_bind("osd_test","cmd_osd_test", "OSD");
+Irssi::command_bind("help","cmd_help", "Irssi commands");
+
+#--------------------------------------------------------------------
+# The command that's executed at load time.
+#--------------------------------------------------------------------
+
+init();
+
+#--------------------------------------------------------------------
+# This text is printed at Load time.
+#--------------------------------------------------------------------
+
+Irssi::print("Use /help osd for more information.");
+
+
+#- end
diff --git a/scripts/page-c0ffee.pl b/scripts/page-c0ffee.pl
new file mode 100644
index 0000000..aa6fe0c
--- /dev/null
+++ b/scripts/page-c0ffee.pl
@@ -0,0 +1,116 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi 20020120;
+$VERSION = "0.03";
+%IRSSI = (
+ authors => "c0ffee",
+ contact => "c0ffee\@penguin-breeder.org",
+ name => "mIRC pager",
+ description => "Adds the /PAGE command to page a nick (use /page nick <text>)... to ignore pages /set pager_mode off",
+ license => "Public Domain",
+ url => "http://www.penguin-breeder.org/?page=irssi",
+ changed => "2017-03-12",
+);
+
+use Irssi::Irc;
+
+Irssi::theme_register(['page_received','-({channick_hilight $0})- $1',
+ 'page_sending','Paging {nick $0}...',
+ 'page_pageroff','Page request ignored: {nick $0}\'s pager is {hilight OFF}',
+ 'page_pagersilent','Page request to {nick $0} dispatched silently',
+ 'page_pageron','Page request to {nick $0} dispatched']);
+
+sub signal_ctcpmsg_reply {
+ my ($server, $data, $nick, $addr, $target) = @_;
+
+ if ($data eq "0") {
+
+ Irssi::printformat(MSGLEVEL_CRAP,'page_pageroff',$nick);
+
+ } elsif ($data eq "1") {
+
+ Irssi::printformat(MSGLEVEL_CRAP,'page_pagersilent',$nick);
+
+ } elsif ($data eq "2") {
+
+ Irssi::printformat(MSGLEVEL_CRAP,'page_pageron',$nick);
+
+ }
+
+ Irssi::signal_stop();
+}
+
+sub signal_ctcpmsg {
+ my ($server, $data, $nick, $addr, $target) = @_;
+ my $pm = Irssi::settings_get_bool('pager_mode');
+ my $cmd = Irssi::settings_get_str('pager_cmd');
+ my $answer = 0;
+ my $rnd = int(rand(65535));
+
+ if ($pm) {
+ $data = "requesting your attention" if ($data eq "");
+ Irssi::printformat(MSGLEVEL_CTCPS, 'page_received',$nick,$data);
+ $answer = 1;
+
+ $nick =~ s/\\/\\\\/g;
+ $nick =~ s/\$/\\\$/g;
+ $nick =~ s/;/\\;/g;
+
+ $data =~ s/\\/\\\\/g;
+ $data =~ s/\$/\\\$/g;
+ $data =~ s/;/\\;/g;
+
+ if ($cmd ne "") {
+
+ $answer = 2;
+ $cmd =~ s/\$r/$rnd/g;
+ $cmd =~ s/\$n/$nick/g;
+ $cmd =~ s/\$i/$server->{chatnet}/g;
+ $cmd =~ s/\$s/$server->{address}/g;
+ $cmd =~ s/\$t/scalar localtime/eg;
+ $cmd =~ s/\$m/$data/g;
+
+ Irssi::command("$cmd");
+
+ }
+ }
+
+ $server->send_raw("NOTICE $nick :\001PAGE $answer\001");
+
+ Irssi::signal_stop();
+}
+
+sub cmd_page {
+ my ($data, $server, $channel) = @_;
+ my ($nick, $what);
+
+ $nick = $data;
+ $nick =~ s/\s(.+)//;
+ $what = $1;
+ $what = " $what" if ($what ne "");
+
+ $server->send_raw("PRIVMSG $nick :\001PAGE$what\001");
+ Irssi::printformat(MSGLEVEL_CRAP,'page_sending', $nick);
+
+}
+
+Irssi::signal_add('ctcp msg page', 'signal_ctcpmsg');
+Irssi::signal_add('ctcp reply page', 'signal_ctcpmsg_reply');
+Irssi::command_bind('page','cmd_page');
+Irssi::settings_add_bool('misc','pager_mode',1);
+Irssi::settings_add_str('misc', 'pager_cmd', "");
+# ok, here for the pager_cmd syntax:
+# "command [parameters]+"
+# where the following things will be replaced:
+# $n the nick who paged you
+# $m the message
+# $t timestamp (format depends on locale)
+# $i ircnet
+# $s server
+# $r a random number
+#
+# for example:
+# /set pager_cmd exec - play /usr/share/sounds/generic.wav
+# /set pager_cmd beep
+# /set pager_cmd eval exec -nosh -name wish$r wish - ; exec -in wish$r wm withdraw . ; exec -in wish$r tk_messageBox -message "$m" -icon info -type ok -title "$n paging..." ; exec -in wish$r destroy .
diff --git a/scripts/page_reeler.pl b/scripts/page_reeler.pl
new file mode 100644
index 0000000..502045a
--- /dev/null
+++ b/scripts/page_reeler.pl
@@ -0,0 +1,47 @@
+# Page script 0.2
+#
+# Thomas Graf <irssi@reeler.org>
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.2";
+%IRSSI = (
+ authors => 'Thomas Graf',
+ contact => 'irssi@reeler.org',
+ name => 'page',
+ description => 'display and send CTCP PAGE',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.reeler.org/',
+);
+
+sub sig_ctcp_msg
+{
+ my ($server, $args, $sender, $addr, $target) = @_;
+
+ if ( $args =~ /page/i ) {
+ Irssi::active_win()->printformat(MSGLEVEL_CRAP, 'page', "$sender!$addr is paging you!");
+ Irssi::signal_stop();
+ }
+}
+
+sub sig_page
+{
+ my ($cmd_line, $server, $win_item) = @_;
+ my @args = split(' ', $cmd_line);
+
+ if (@args <= 0) {
+ Irssi::active_win()->print("Usage: PAGE <nick>");
+ return;
+ }
+
+ my $nick = lc(shift(@args));
+
+ $server->command("CTCP $nick PAGE");
+}
+
+Irssi::signal_add_first('default ctcp msg', 'sig_ctcp_msg');
+Irssi::command_bind('page', 'sig_page');
+
+Irssi::theme_register(['page', '[%gPAGE%n]$0-']);
diff --git a/scripts/pager.pl b/scripts/pager.pl
new file mode 100644
index 0000000..50d7899
--- /dev/null
+++ b/scripts/pager.pl
@@ -0,0 +1,127 @@
+# $Id: pager.pl,v 1.23 2003/01/27 09:45:16 jylefort Exp $
+
+use strict;
+use Irssi 20020121.2020 ();
+
+use vars qw/$VERSION %IRSSI/;
+$VERSION = "1.2";
+%IRSSI = (
+ authors => 'Jean-Yves Lefort',
+ contact => 'jylefort\@brutele.be',
+ name => 'pager',
+ description => 'Notifies people if they send you a private message or a DCC chat offer while you are away; runs a shell command configurable via /set if they page you',
+ license => 'BSD',
+ changed => '$Date: 2017/03/06 $ ',
+);
+
+# note:
+#
+# Irssi special variables (see IRSSI_DOC_DIR/special_vars.txt) will be
+# expanded in *_notice /set's, and will NOT be expanded in page_command
+# for obvious security reasons.
+#
+# /set's:
+#
+# page_command a shell command to run if someone sends you the
+# private message 'page' while you are away
+#
+# away_notice a notice to send to someone sending you a private
+# message while you are away
+#
+# paged_notice a notice to send to someone who has just paged you
+#
+# dcc_notice a notice to send to someone who has just sent you
+# a DCC chat offer (this automatically pages you)
+#
+# changes:
+#
+# 2017-03-06 release 1.2
+# * declaration $VERSION %IRSSI
+#
+# 2003-01-27 release 1.1
+# * notices and commands are now optional
+#
+# 2002-07-04 release 1.01
+# * things are now printed in the right order
+# * signal_add's uses a reference instead of a string
+#
+# 2002-04-25 release 1.00
+# * increased version number
+#
+# 2002-02-06 release 0.20
+# * builtin expand deprecated;
+# now uses Irssi's special variables
+#
+# 2002-01-27 release 0.11
+# * uses builtin expand
+#
+# 2002-01-23 initial release
+
+use strict;
+use Irssi::Irc; # for DCC object
+
+sub message
+ {
+ my ($server, $msg, $nick, $address) = @_;
+
+ if ($server->{usermode_away})
+ {
+ if (lc($msg) eq "page")
+ {
+ my $page_command = Irssi::settings_get_str("page_command");
+ my $paged_notice = Irssi::settings_get_str("paged_notice");
+
+ if ($page_command)
+ {
+ system($page_command);
+ }
+ if ($paged_notice)
+ {
+ $server->command("EVAL NOTICE $nick $paged_notice");
+ }
+ }
+ else
+ {
+ my $away_notice = Irssi::settings_get_str("away_notice");
+
+ if ($away_notice)
+ {
+ $server->command("EVAL NOTICE $nick $away_notice");
+ }
+ }
+ }
+ }
+
+sub dcc_request
+ {
+ my ($dcc, $sendaddr) = @_;
+
+ if ($dcc->{server}->{usermode_away} && $dcc->{type} eq "CHAT")
+ {
+ my $page_command = Irssi::settings_get_str("page_command");
+ my $dcc_notice = Irssi::settings_get_str("dcc_notice");
+
+ if ($page_command)
+ {
+ system($page_command);
+ }
+ if ($dcc_notice)
+ {
+ $dcc->{server}->command("EVAL NOTICE $dcc->{nick} $dcc_notice");
+ }
+ }
+ }
+
+Irssi::settings_add_str("misc", "page_command",
+ "esdplay ~/sound/events/page.wav &");
+Irssi::settings_add_str("misc", "away_notice",
+ '$N is away ($A). Type /MSG $N PAGE to page him.');
+Irssi::settings_add_str("misc", "paged_notice",
+ '$N has been paged.');
+Irssi::settings_add_str("misc", "dcc_notice",
+ '$N is away ($A) and has been paged. Type /MSG $N PAGE to page him again.');
+
+Irssi::signal_add_priority("message private", \&message,
+ Irssi::SIGNAL_PRIORITY_LOW + 1);
+Irssi::signal_add_priority("dcc request", \&dcc_request,
+ Irssi::SIGNAL_PRIORITY_LOW + 1);
diff --git a/scripts/pangotext.pl b/scripts/pangotext.pl
new file mode 100644
index 0000000..125a538
--- /dev/null
+++ b/scripts/pangotext.pl
@@ -0,0 +1,253 @@
+##############################################################################################
+# pangotext.pl - Specify color patterns in a text message using html-esque tags. In the
+# same vein as pangotext.
+#
+# DESCRIPTION
+# The purpose of this script is to allow you to write text to the current channel with
+# complex color patterns, using simple html tag syntax. This allows you to do things like
+# send a rainbow-colored message where only part of the message is rainbow colored easily.
+#
+# USAGE
+# /pango <message text here>
+# NOTE: You can't put tags inside tags marked 'no inner tags' below
+# all other tags are fully nestable. Tags noted below with 'attributes'
+# also have attributes that can be specified (ie <tag attrib=value>) no spaces
+# are allowed in attribute names or values.
+# inverse,inv Reverse foreground and background of text
+# bold,b Bold text
+# underline,ul Underlines text
+# rainbow,rb Colorizes text with a rainbow (no inner tags)
+# checker Colorizes text with a checker pattern (no inner tags)
+# gradiant Colorizes text with a gradiant (no inner tags, attribs { start, end })
+# ...more to if you can think of any add more functions...
+#
+# EXAMPLES
+# This script makes most sense if you just use it and see how awesome it is. Here
+# are some example usages you should check out.
+# # Send a message with a colorful rainbow
+# /pango Hi guys, here's a <rainbow>rainbow</rainbow> for you.
+# /pango Hi guys, here's a <inverse><rainbow>rainbow</rainbow></inverse> for you. # Shows an inverse rainbow
+# /pango Hi guys, here's a <bold><rainbow>rainbow</rainbow></bold> for you. # Shows a bright rainbow
+#
+# # Send a message with a checker pattern and a rainbow and underlined text also
+# /pango <b>Let's play a game</b> <ul>of</ul> <checker>checkers</checker>! Or do you like
+# it better inversed <inverse><checker>inversed checkers</checker></inverse>!
+#
+# # Gradiants allow start and end range specifier in by color name:
+# /pango <gradiant start=green end=red>some gradiant text here</gradiant>
+# /pango <gradiant>default gradiant range</gradiant>
+# /pango <gradiant start=lightcyan end=white>a light gradiant</gradiant>
+#
+##############################################################################################
+use strict;
+use warnings;
+
+use Irssi;
+use Irssi::Irc;
+use utf8;
+
+our $VERSION = "1.2";
+our %IRSSI = (
+ authors => 'fprintf',
+ contact => 'fprintf@github.com',
+ name => 'pangotext',
+ description => 'Render text with various color modifications using HTML tag syntax.',
+ license => 'GNU GPLv2 or later',
+);
+
+# Color metadata
+my %color = (
+ white => 0,
+ black => 1,
+ blue => 2,
+ green => 3,
+ lightred => 4,
+ red => 5,
+ purple => 6,
+ orange => 7,
+ yellow => 8,
+ lightgreen => 9,
+ cyan => 10,
+ lightcyan => 11,
+ lightblue => 12,
+ lightpurple => 13,
+ gray => 14,
+ lightgray => 15,
+);
+
+my @color_order = (
+ 'white', 'lightgray', 'lightcyan', 'lightblue', 'lightgreen',
+ 'lightpurple', 'yellow', 'lightred', 'orange', 'red', 'purple',
+ 'cyan', 'blue', 'green', 'gray', 'black'
+);
+my %color_ordermap;
+for (my $i = 0; $i < @color_order; ++$i) {
+ $color_ordermap{$color_order[$i]} = $i;
+}
+
+# Allowed tags
+my %tag_registry = (
+ 'rb' => \&rainbow,
+ 'rainbow' => \&rainbow,
+ 'checker' => \&checker,
+
+ 'gradiant' => \&gradiant,
+ 'gradient' => \&gradiant,
+ 'grad' => \&gradiant,
+
+ 'ul' => \&underline,
+ 'underline' => \&underline,
+ 'bold' => \&bold,
+ 'b' => \&bold,
+ 'inverse' => \&inverse,
+ 'inv' => \&inverse,
+);
+
+my $utf8;
+
+##############################################################################################
+# Utils
+##############################################################################################
+
+sub palettize
+{
+ my ($text, $palette) = @_;
+ return $text if (!$palette || ref($palette) ne 'ARRAY');
+
+ # Colorize the text using the given palette
+ my $count = 0;
+ my $render = '';
+ foreach my $let (split(//,$text)) {
+ $let .= ',' if ($let eq ',');
+ $render .= $let =~ /\s/ ? $let : sprintf("\003%02d%s", $$palette[$count++ % scalar(@$palette)], $let);
+ }
+ return sprintf("%s\003", $render);
+}
+
+##############################################################################################
+# Render tags
+##############################################################################################
+sub rainbow
+{
+ my $text = shift;
+ my @palette = (
+ 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13
+ );
+ return palettize($text, \@palette);
+}
+
+sub gradiant
+{
+ my ($text, $attribs) = @_;
+ $attribs ||= {};
+ $attribs->{start} ||= 'white';
+ $attribs->{end} ||= 'lightpurple';
+
+ # Build the palette based on the given color range
+ my @palette = ();
+ my ($start,$end) = ($color_ordermap{$attribs->{start}},$color_ordermap{$attribs->{end}});
+ # Fancy way to find min and max
+ my $min = ($start,$end)[$start > $end];
+ my $max = ($start,$end)[$start < $end];
+ for (my $i = $min; $i <= $max; ++$i) {
+ push(@palette, $color{$color_order[$i % scalar(@color_order)]}); # Wrap colors around if they overlap
+ }
+
+ # Palettize the text
+ return palettize($text, \@palette);
+}
+
+sub checker
+{
+ my $text = shift;
+ my $rainbow = '';
+ my $count = 0;
+ # Black on red, red on black
+ my @palette = ('01,04', '04,01');
+ foreach my $let (split(//,$text)) {
+ $let .= ',' if ($let eq ',');
+ $rainbow .= $let =~ /\s/ ? $let : sprintf("\003%s%s", $palette[$count++ % scalar(@palette)], $let);
+ }
+ return sprintf("%s\003", $rainbow);
+}
+
+sub bold
+{
+ my $text = shift;
+ return sprintf("\002%s\002", $text);
+}
+
+sub underline
+{
+ my $text = shift;
+ return sprintf("\037%s\037", $text);
+}
+
+sub inverse
+{
+ my $text = shift;
+ return sprintf("\026%s\026", $text);
+}
+
+##############################################################################################
+# Renderer function
+##############################################################################################
+
+sub render
+{
+ my ($text) = @_;
+
+ while ($text =~ /<\s*([^>\s]+)\s*([^>]*)>(.+?)<\/?\1>/g) {
+ my ($action,$extra,$msg) = ($1,$2,$3);
+ my $mstart = $-[0];
+ my $mend = pos($text);
+ my %attribs = ();
+
+ (%attribs) = $extra =~ /(\S+)\s*=\s*(\S+)/g;
+
+ if (!exists($tag_registry{$action})) {
+ Irssi::print("[/pango error] invalid action: $action");
+ next;
+ }
+
+ # Render our text
+ $msg = $tag_registry{$action}->($msg,\%attribs);
+ my $len = $mend - $mstart;
+ my $index = $mend - $len;
+ # Insert it
+ substr($text, $index, $len, $msg);
+ }
+ return $text;
+}
+
+##############################################################################################
+# Irssi interface
+##############################################################################################
+# /pango
+# Send message to current channel
+# with rendered text
+# See functions above for available tags
+sub pango {
+ my ($text, $server, $dest) = @_;
+
+ if (!$server || !$server->{connected}) {
+ Irssi::print("[/pango error] not connected to server");
+ return;
+ }
+
+ return unless $dest;
+ if ($utf8) {
+ utf8::decode($text)
+ }
+
+ if ($dest->{type} eq "CHANNEL" || $dest->{type} eq "QUERY") {
+ $dest->command("/msg " . $dest->{name} . " " . render($text));
+ }
+}
+
+
+Irssi::command_bind("pango", \&pango);
+
+$utf8= Irssi::settings_get_str('term_charset') eq 'UTF-8';
+
+# vim:set ts=4 sw=4 expandtab:
diff --git a/scripts/paste-derwan.pl b/scripts/paste-derwan.pl
new file mode 100644
index 0000000..dd96dde
--- /dev/null
+++ b/scripts/paste-derwan.pl
@@ -0,0 +1,184 @@
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.9";
+%IRSSI = (
+ 'authors' => 'Marcin Rozycki, Stanislaw Halik',
+ 'contact' => 'derwan@irssi.pl',
+ 'name' => 'paste',
+ 'description' => 'Usage: /paste [-all|-msgs|-public] [-c|-b] [-s|-l| where] [lines]',
+ 'url' => 'http://derwan.irssi.pl',
+ 'license' => 'GNU GPL v2',
+ 'changed' => 'Tue Oct 12 23:37:12 CEST 2004'
+);
+
+use Irssi::TextUI;
+use POSIX qw(strftime);
+
+# Examples:
+# /paste
+# /paste -l
+# /paste -l +9
+# /paste derwan +2,11,18-23
+# /paste derwan,#irssi -msgs -5,22,18+1 16
+# /paste -s -30
+
+Irssi::settings_add_str("misc", "paste_save_file", Irssi::get_irssi_dir() . "/paste.save");
+Irssi::settings_add_int("misc", "paste_default_level", 0);
+Irssi::settings_add_bool("misc", "paste_use_colors", 0);
+Irssi::settings_add_bool("misc", "paste_send_index", 0);
+
+my $paste_use_level = MSGLEVEL_SNOTES;
+my $paste_warning_send = 10;
+my $paste_warning_show = 60;
+
+sub paste {
+ my ($server, $window, $where, $size, $yes) = ($_[1], Irssi::active_win(), undef, undef, 0);
+ my $colorize = Irssi::settings_get_bool("paste_use_colors");
+ my $level = Irssi::settings_get_int("paste_default_level");
+ my $file = Irssi::settings_get_str("paste_save_file");
+ my @lines = ();
+ my @args = split(/ |,/, $_[0]);
+ while ($_ = shift(@args))
+ {
+ /^\d+$/ and push(@lines, $_), next;
+ /^(\+|-)\d+$/ and $_ = "1" . $_;
+ /^\d+\+\d+$/ and do {
+ my ($i, $x) = split(/\+/, $_);
+ $_ = $i . "-" . ($i+$x);
+ };
+ /^\d+-\d+$/ and do {
+ my ($i, $x) = split(/-/, $_);
+ push(@lines, $i..$x);
+ next;
+ };
+ /^-(a|all)$/ and $level = 0, next;
+ /^-(m|msgs)$/ and $level = 1, next;
+ /^-(p|public)$/ and $level = 2, next;
+ /^-c$/ and $colorize = 1, next;
+ /^-b$/ and $colorize = 0, next;
+ /^-(l|s)$/ and $where = $_, next;
+ /^-yes$/i and $yes = 1, next;
+ /^(-|\d)/ and do {
+ $window->print("Paste: Bad argument: $_", $paste_use_level);
+ return;
+ };
+ $where .= ($where) ? "," . $_ : $_;
+ };
+ if ($where !~ /^-(l|s)/) {
+ $window->print("Paste: Not connected to server", $paste_use_level), return if (!$server or !$server->{connected});
+ unless ($where) {
+ $window->print("Paste: Not joined to any channel or query window", $paste_use_level), return
+ if (!$_[2] or $_[2]->{type} !~ /^(channel|query)/i);
+ $where = $window->get_active_name();
+ };
+ } elsif ($where =~ /^-l/) {
+ $colorize = 0;
+ $size = $window->{width} - 6;
+ $size -= (length(strftime(Irssi::settings_get_str("timestamp_format"), localtime)) + 1) if (Irssi::settings_get_bool("timestamps"));
+ }elsif (!$file) {
+ $window->print("Paste: Savefile is not defined, use: /SET paste_save_file [path], to set this", $paste_use_level);
+ return;
+ };
+ my ($line, $idx_last, $cnt) = ($window->view()->{buffer}->{cur_line}, undef, 0);
+ @lines = ($where =~ /^-l/) ? (1..($window->{height})) : (1) if ($#lines < 0);
+ my @buffer = ();
+ for my $idx (sort {$a <=> $b} @lines) {
+ next if ($idx == $idx_last);
+ while ($idx) {
+ last unless ($line);
+ my $line_level = $line->{info}->{level};
+ if ($level == 0 && ($line_level & ($paste_use_level)) == 0 or
+ $level == 1 && ($line_level & (MSGLEVEL_MSGS)) != 0 or
+ $level == 2 && ($line_level & (MSGLEVEL_PUBLIC)) != 0) {
+ if (++$cnt == $idx) {
+ my $text = $line->get_text($colorize);
+ $text = substr($text, 0, ($size-1)).'$' if ($size and length($text) > $size);
+ push @buffer, [$idx, $text];
+ $idx_last = $idx;
+ undef $idx;
+ };
+
+ };
+ $line = $line->prev();
+ };
+ last unless ($line);
+ };
+ if ($#buffer < 0) {
+ $window->print("Paste: Buffer for this window in this level is empty", $paste_use_level);
+ return;
+ }elsif (!$yes and ($where !~ /^-(l|s)/ && $#buffer > $paste_warning_send or $where =~ /^-l/ && $#buffer > $paste_warning_show)) {
+ $window->print("Paste: Doing this is not a good idea. Add -YES option to command if you really mean it", $paste_use_level);
+ return;
+ };
+ if ($where =~ /^-s/) {
+ open (F, ">>", $file) or do {
+ $window->print("Paste: Cannot write savefile \"$file\"", $paste_use_level);
+ return;
+ };
+ print F "\n-- paste ".strftime("%c", localtime)." ($server->{tag})\n";
+ };
+ $_ = $where;
+ my $index_test = Irssi::settings_get_bool("paste_send_index");
+ for (my $loop = $#buffer; $loop >= 0; $loop--) {
+ /^-l/ and $window->print("%K[%n%_".sprintf("%3d", $buffer[$loop][0])."%_%K]%n $buffer[$loop][1]", $paste_use_level), next;
+ /^-s/ and do {
+ print F $buffer[$loop][1]."\n";
+ next;
+ };
+ my $text = ($index_test) ? sprintf("%03d", $buffer[$loop][0]) ." $buffer[$loop][1]" : $buffer[$loop][1];
+ $server->command("msg $where ".to_mirc($text));
+ };
+ /^-s/ and do {
+ close(F);
+ $window->print("Paste: Saved ".($#buffer + 1)." lines in \"$file\"", $paste_use_level);
+ };
+}
+
+# too_mirc()
+# Stanislaw Halik <weirdo@blindfold.no-ip.com>
+sub to_mirc ($)
+{
+ my $text = shift();
+ $text =~ s/[\004]g\//\003\002\002/g;
+ $text =~ s/[\004]\?\/+/\0030\002\002/g;
+ $text =~ s/[\004]0\//\0031\002\002/g;
+ $text =~ s/[\004]0/\0031\002\002/g;
+ $text =~ s/[\004]1\//\0032\002\002/g;
+ $text =~ s/[\004]1/\0032\002\002/g;
+ $text =~ s/[\004]2\//\0033\002\002/g;
+ $text =~ s/[\004]2/\0033\002\002/g;
+ $text =~ s/[\004]<\//\0034\002\002/g;
+ $text =~ s/[\004]</\0034\002\002/g;
+ $text =~ s/[\004]4\//\0035\002\002/g;
+ $text =~ s/[\004]4/\0035\002\002/g;
+ $text =~ s/[\004]5\//\0036\002\002/g;
+ $text =~ s/[\004]5/\0036\002\002/g;
+ $text =~ s/[\004]6\//\0037\002\002/g;
+ $text =~ s/[\004]6/\0037\002\002/g;
+ $text =~ s/[\004]>\//\0038\002\002/g;
+ $text =~ s/[\004]>/\0038\002\002/g;
+ $text =~ s/[\004]:\//\0039\002\002/g;
+ $text =~ s/[\004]:/\0039\002\002/g;
+ $text =~ s/[\004]3\//\00310\002\002/g;
+ $text =~ s/[\004]3/\00310\002\002/g;
+ $text =~ s/[\004]\;\//\00311\002\002/g;
+ $text =~ s/[\004]\;/\00311\002\002/g;
+ $text =~ s/[\004]9\//\00312\002\002/g;
+ $text =~ s/[\004]9/\00312\002\002/g;
+ $text =~ s/[\004]=\//\00313\002\002/g;
+ $text =~ s/[\004]=/\00313\002\002/g;
+ $text =~ s/[\004]8\//\00314\002\002/g;
+ $text =~ s/[\004]8/\00314\002\002/g;
+ $text =~ s/[\004]7\//\00315\002\002/g;
+ $text =~ s/[\004]7/\00315\002\002/g;
+ $text =~ s/[\004]g\//\003\002\002/g;
+ $text =~ s/[\004]g/\003\002\002/g;
+ $text =~ s/[\004]8\//\003\002\002/g;
+ $text =~ s/[\004]8/\003\002\002/g;
+ return $text;
+}
+
+Irssi::command_bind("paste", "paste");
+
diff --git a/scripts/paste_derwan.pl b/scripts/paste_derwan.pl
new file mode 100644
index 0000000..0a2b480
--- /dev/null
+++ b/scripts/paste_derwan.pl
@@ -0,0 +1,381 @@
+use strict;
+use vars qw($VERSION %IRSSI %HELP);
+
+use Irssi 0 qw
+(
+ active_win server_find_tag signal_stop window_find_name parse_special
+);
+
+use Irssi::UI;
+use Irssi::TextUI;
+
+$VERSION = '1.1';
+%IRSSI =
+(
+ 'authors' => 'Marcin Rozycki',
+ 'contact' => 'derwan@irssi.pl',
+ 'name' => 'paste',
+ 'description' => 'Pasting lines to specified targets, type "/paste -help" for help',
+ 'license' => 'GNU GPL v2',
+ 'modules' => '',
+ 'url' => 'http://derwan.irssi.pl',
+ 'changed' => '2018-07-14',
+);
+
+$HELP{'paste'} = <<EOF;
+PASTE [-help] [-c] [-q] [-msg | -notice] [-<server tag>] [<target>] [<indexes>]
+
+ -help: print this help
+ -c: enable colors
+ -q: quiet mode (pasted lines are not dispalyed)
+ -msg: sends messages as msg (as default)
+ -notice: sends messages as notice
+ -<server target>: sends messages to specified server
+ <target>: targets (separated with commas)
+ <indexes>: indexes of lines to paste ( separated with spaces)
+
+Examples:
+
+ /PASTE - pasting to active channel or query
+ /PASTE -c - pasting to active channel or query with colors
+ /PASTE -c 1 3-5 - pasting to active channel or query lines 1, 3, 4 and 5
+ /PASTE -notice - pasting to active item - messages sent as notice, not msg
+ /PASTE derwan - sends messages to derwan
+ /PASTE -ircnet -c derwan,#irssi - sends messages (with colors) to derwan and #irssi in IRCNet
+
+Paste window - indexes:
+
+ [0] [<index>] [<index from>-<index to>]
+
+Examples:
+
+ 0 - cancel
+ 4 - line 4
+ 4 8 9 10 - lines 4, 8, 9, 10
+ 4 8-10 - lines 4, 8, 9, 10
+
+Themes:
+
+ paste_normal - \$0 line
+ paste_reverse - \$0 line
+ paste_count - \$0 count, \$1 server tag, \$2 target
+ paste_input
+ paste_no_server - \$0 comment
+ paste_argument_missing - \$0 option, \$1 comment
+ paste_argument_unknown - \$0 option, \$1 comment
+ paste_nothing
+
+Your version is $VERSION - for updates visit $IRSSI{url}
+Mail bug reports and suggestions to <$IRSSI{contact}>
+EOF
+
+my ( $p );
+
+# paste (str data, rec server, rec window)
+sub paste ($$$)
+{
+ buf_destroy();
+
+ $p = {};
+ $p->{color} = 0;
+ $p->{cmd} = 'msg';
+ $p->{quiet} = 0;
+
+ my $win = active_win();
+
+ foreach my $arg ( split /\s+/, $_[0] )
+ {
+ ( $arg eq '-help' ) and Irssi::print($HELP{'paste'}, MSGLEVEL_CLIENTCRAP), return;
+ ( $arg eq '-c' ) and $p->{color} = 1, next;
+ ( $arg eq '-q' ) and $p->{quiet} = 1, next;
+ ( $arg =~ m/^-(msg|notice)$/ ) and $p->{cmd} = $1, next;
+ ( $arg =~ m/^-(.*)$/ and !$p->{tag} ) and $p->{tag} = $1, next;
+ ( $arg =~ m/^([^-\s]*[^-\d]+[^\s]*)$/ and !$p->{target} ) and $p->{target} = $1, next;
+ ( $arg =~ m/^([1-9]\d*)$/ ) and $p->{l}->{$1} = 1, next;
+ if ( $arg =~ m/^([1-9]\d*)-(\d+)$/ and $1 <= $2 )
+ {
+ map { $p->{l}->{$_} = $p->{buf}->[$_-1] } ( $1 .. $2 );
+ next;
+ }
+
+ $win->printformat
+ (
+ MSGLEVEL_CRAP, 'paste_argument_unknown', $arg, 'type /paste -help for help'
+ );
+ buf_destroy(), return;
+ }
+
+ if ( !exists $p->{tag} or !defined $p->{tag} )
+ {
+ if ( !ref $_[1] and !ref $win->{server} )
+ {
+ $win->printformat
+ (
+ MSGLEVEL_CRAP, 'paste_argument_missing', 'server tag', 'type /paste -help for help'
+ );
+ buf_destroy(), return;
+ }
+ $p->{tag} = ( ref $_[1] ) ? $_[1]->{tag} : $win->{active}->{server}->{tag};
+ }
+ elsif ( ! ref server_find_tag($p->{tag}) )
+ {
+ $win->printformat
+ (
+ MSGLEVEL_CRAP, 'paste_argument_unknown', $p->{tag}, 'not connected to that server'
+ );
+ buf_destroy(), return;
+ }
+
+ unless ( exists $p->{target} and defined $p->{target} )
+ {
+ if ( !ref $win->{active} or !$win->{active}->{name} )
+ {
+ $win->printformat
+ (
+ MSGLEVEL_CRAP, 'paste_argument_missing', 'target', 'type /paste -help for help'
+ );
+ buf_destroy(), return;
+ }
+ $p->{target} = $win->{active}->{name};
+ }
+
+ if ( buf_create() == 0 )
+ {
+ $win->printformat
+ (
+ MSGLEVEL_CRAP, 'paste_nothing'
+ );
+ buf_destroy(), return;
+ }
+
+ foreach my $idx ( keys %{$p->{l}} )
+ {
+ $p->{l}->{$idx} = $p->{buf}->[$idx-1];
+ }
+
+ buf_destroy(), return if ( buf_flush() != 0 );
+
+ $p->{win} = sprintf('paste.%d', (int(rand(9000))+1000));
+ my $input = Irssi::Windowitem::window_create($p->{win}, 1);
+ $input->set_name($p->{win});
+ $input->set_history($p->{win});
+ $input->change_server(server_find_tag($p->{tag}));
+
+ my $width = $input->{width} - 8;
+ my $theme = 'normal';
+
+ for ( my $idx = $#{$p->{buf}}; $idx >= 0; $idx-- )
+ {
+ my $text = $p->{buf}->[$idx]->get_text(0);
+ $text = sprintf
+ (
+ '%03d %'.( length($text) > $width ? '.'.($width-1).'s$' : '-'.$width.'s' ).
+ ' %03d', $idx+1, $text, $idx+1
+ );
+ $input->printformat(MSGLEVEL_NOHILIGHT, 'paste_'.$theme, $text);
+ $theme = $theme eq 'normal' ? 'reverse' : 'normal';
+ }
+
+ $input->printformat(MSGLEVEL_NOHILIGHT, 'paste_input');
+ $input->set_active();
+};
+
+sub buf_create ()
+{
+ return unless ( defined $p and ref $p );
+
+ my $win = active_win();
+ return 0 unless ( ref $win );
+
+ my $curline = $win->view()->{buffer}->{cur_line};
+ return 0 unless ( ref $curline );
+
+ for ( my $idx = 0; $idx < 100; $idx++ )
+ {
+ last unless ( ref $curline );
+ push @{$p->{buf}}, $curline;
+ $curline = $curline->prev();
+ }
+
+ return ( $#{$p->{buf}} >= 0 ? 1 : 0 );
+}
+
+sub buf_flush ()
+{
+ return unless ( defined $p and ref $p );
+
+ my $serv = server_find_tag($p->{tag});
+
+ unless ( ref $serv and $serv->{connected} )
+ {
+ active_win()->printformat
+ (
+ MSGLEVEL_CRAP, 'paste_no_server', $p->{tag}
+ );
+
+ return -1;
+ }
+
+ my $count = 0;
+ foreach my $idx ( sort { $b <=> $a } ( keys %{$p->{l}} ) )
+ {
+ if ( defined $p->{l}->{$idx} and ref $p->{l}->{$idx} and ++$count )
+ {
+ if ( $p->{quiet} == 0 )
+ {
+ my $cmd = sprintf
+ (
+ '%s %s %s', $p->{cmd}, $p->{target}, convertstr($p->{l}->{$idx}->get_text($p->{color}))
+ );
+ $serv->command($cmd);
+ }
+ else
+ {
+ my $raw = sprintf
+ (
+ '%s %s :%s', ( $p->{cmd} eq 'msg' ? 'privmsg' : 'notice' ), $p->{target},
+ convertstr($p->{l}->{$idx}->get_text($p->{color}))
+ );
+ $serv->send_raw($raw);
+ }
+
+ }
+ }
+
+ if ( $count > 0 )
+ {
+ active_win()->printformat(MSGLEVEL_CRAP, 'paste_count', $count, $p->{tag}, $p->{target});
+ }
+ else
+ {
+ active_win()->printformat(MSGLEVEL_CRAP, 'paste_nothing');
+ }
+
+ return $count;
+}
+
+# sig_send_command (str data, rec server, rec window)
+sub sig_send_command ($$$)
+{
+ unless ( defined $p and ref $p and defined $p->{win} )
+ {
+ return;
+ }
+
+ my $win = active_win();
+
+ if ( $_[0] eq 0 )
+ {
+ buf_destroy(), return;
+ }
+
+ if ( substr($_[0], 0, 1) eq parse_special('$K') )
+ {
+ return;
+ }
+
+ unless ( ref $win and $win->{name} eq $p->{win} )
+ {
+ return;
+ }
+
+ signal_stop ();
+
+ $win->destroy();
+ delete $p->{win};
+
+ foreach my $arg ( split /\s+/, $_[0] )
+ {
+ if ( $arg =~ m/^(\d+)$/ and $1 > 0 )
+ {
+ $p->{l}->{$1} = $p->{buf}->[$1-1];
+ }
+ elsif ( $arg =~ m/^([1-9]\d*)-(\d+)$/ and $1 <= $2 )
+ {
+ map { $p->{l}->{$_} = $p->{buf}->[$_-1] } ( $1 .. $2 );
+ }
+ else
+ {
+ active_win()->printformat(MSGLEVEL_CRAP, 'paste_argument_unknown', $arg, 'type /paste -help for help');
+ }
+ }
+
+ buf_flush();
+ buf_destroy();
+};
+
+sub buf_destroy ()
+{
+ if ( defined $p and ref $p )
+ {
+ @{$p->{buf}} = () if ( defined $p->{buf} and ref $p->{buf} );
+ %{$p->{l}} = () if ( defined $p->{l} and ref $p->{l} );
+ if ( defined $p->{win} )
+ {
+ my $win = window_find_name($p->{win});
+ $win->destroy if ( ref $win );
+ }
+ undef ( $p );
+ }
+}
+
+# convertstr (str text), str text
+# thanks for Stanislaw Halik <weirdo@blindfold.no-ip.com>
+sub convertstr ($)
+{
+ if ( $_[0] )
+ {
+ $_[0] =~ s/[\004]g\//\003\002\002/g;
+ $_[0] =~ s/[\004]\?\/+/\0030\002\002/g;
+ $_[0] =~ s/[\004]0\//\0031\002\002/g;
+ $_[0] =~ s/[\004]0/\0031\002\002/g;
+ $_[0] =~ s/[\004]1\//\0032\002\002/g;
+ $_[0] =~ s/[\004]1/\0032\002\002/g;
+ $_[0] =~ s/[\004]2\//\0033\002\002/g;
+ $_[0] =~ s/[\004]2/\0033\002\002/g;
+ $_[0] =~ s/[\004]<\//\0034\002\002/g;
+ $_[0] =~ s/[\004]</\0034\002\002/g;
+ $_[0] =~ s/[\004]4\//\0035\002\002/g;
+ $_[0] =~ s/[\004]4/\0035\002\002/g;
+ $_[0] =~ s/[\004]5\//\0036\002\002/g;
+ $_[0] =~ s/[\004]5/\0036\002\002/g;
+ $_[0] =~ s/[\004]6\//\0037\002\002/g;
+ $_[0] =~ s/[\004]6/\0037\002\002/g;
+ $_[0] =~ s/[\004]>\//\0038\002\002/g;
+ $_[0] =~ s/[\004]>/\0038\002\002/g;
+ $_[0] =~ s/[\004]:\//\0039\002\002/g;
+ $_[0] =~ s/[\004]:/\0039\002\002/g;
+ $_[0] =~ s/[\004]3\//\00310\002\002/g;
+ $_[0] =~ s/[\004]3/\00310\002\002/g;
+ $_[0] =~ s/[\004]\;\//\00311\002\002/g;
+ $_[0] =~ s/[\004]\;/\00311\002\002/g;
+ $_[0] =~ s/[\004]9\//\00312\002\002/g;
+ $_[0] =~ s/[\004]9/\00312\002\002/g;
+ $_[0] =~ s/[\004]=\//\00313\002\002/g;
+ $_[0] =~ s/[\004]=/\00313\002\002/g;
+ $_[0] =~ s/[\004]8\//\00314\002\002/g;
+ $_[0] =~ s/[\004]8/\00314\002\002/g;
+ $_[0] =~ s/[\004]7\//\00315\002\002/g;
+ $_[0] =~ s/[\004]7/\00315\002\002/g;
+ $_[0] =~ s/[\004]g\//\003\002\002/g;
+ $_[0] =~ s/[\004]g/\003\002\002/g;
+ $_[0] =~ s/[\004]8\//\003\002\002/g;
+ $_[0] =~ s/[\004]8/\003\002\002/g;
+ }
+ return $_[0];
+}
+
+Irssi::theme_register
+([
+ 'paste_normal', '$0-',
+ 'paste_reverse', '%c$0-%n',
+ 'paste_input', '%7%r type indexes of lines to paste (type "0" for cancel or "/paste -help" for help): %8%n',
+ 'paste_count', '%_Irssi%_: {hilight $0} line(s) have been pasted to {nick $2} in $1',
+ 'paste_argument_unknown', '%_Irssi%_: Unknown option: {hilight $0} {comment $1}',
+ 'paste_argument_missing', '%_Irssi%_: Not enough parameters given: $0 {comment $1}',
+ 'paste_no_server', '%_Irssi%_: Not connected to specified server {comment $0}',
+ 'paste_nothing', '%_Irssi%_: Nothing to paste',
+]);
+
+Irssi::signal_add_first('send command', 'sig_send_command');
+Irssi::command_bind('paste', 'paste');
diff --git a/scripts/paste_huggie.pl b/scripts/paste_huggie.pl
new file mode 100644
index 0000000..25a8916
--- /dev/null
+++ b/scripts/paste_huggie.pl
@@ -0,0 +1,187 @@
+# Paste script for irssi
+# (C) Simon Huggins 2002
+# huggie@earth.li
+
+# Reformat pasted text ready to paste onto channels.
+
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the Free
+# Software Foundation; either version 2 of the License, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+# for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc., 59
+# Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+use Irssi 20020217.1542 (); # Version 0.8.1
+$VERSION = "0.5";
+%IRSSI = (
+authors => "Simon Huggins",
+contact => "huggie-irssi\@earth.li",
+name => "Paste",
+description => "Paste reformats long pieces of text typically pasted into your client from webpages so that they fit nicely into your channel. Width of client may be specified",
+license => "GPLv2",
+url => "http://the.earth.li/~huggie/irssi/",
+changed => "Sat Mar 9 10:59:49 GMT 2002",
+);
+
+use Irssi::Irc;
+use Text::Wrap;
+use Text::Tabs;
+use POSIX qw(strftime);
+
+=pod
+
+=head1 paste.pl
+
+B<paste.pl> - a script for irssi to manage reformatting before pasting to channels
+
+To stop people pasting from webpages with very poor formatting this script
+allows you to reformat as you paste.
+
+=head1 USAGE
+
+Load the script then create a new unused window and paste your text into it.
+The defaults should be reasonable so then B</paste> will paste it in the
+current window (either by saying it to the current channel, msging it to the
+current recipient in a query window or by printing it up as client messages
+in a blank window).
+
+Try altering I<paste_width> (0 is the autoformatted default based on your
+nick length) to affect the width of the pasted text.
+
+Alter I<paste_prefix> to change the prefix added to each line (B</set -clear
+paste_prefix> to remove it altogether).
+
+Set I<paste_showbuf> to show the lines pasted into the buffer as you paste it.
+
+=head1 AUTHOR
+
+Send suggestions to Simon Huggins <huggie@earth.li>
+
+=cut
+
+my $pastewin;
+
+BEGIN {
+ $pastewin = Irssi::window_find_name('paste');
+ if (!$pastewin) {
+ Irssi::command("window new hide");
+ Irssi::command("window name paste");
+ $pastewin = Irssi::window_find_name('paste');
+ }
+ $pastewin->print(">>> Paste your buffer here to start <<<");
+}
+
+Irssi::settings_add_bool("paste","paste_showbuf",0);
+Irssi::settings_add_int("paste","paste_width",0);
+Irssi::settings_add_str("paste","paste_prefix",">> ");
+
+{
+ my @buffer;
+ my $buf=0;
+ my $last_ts;
+
+sub event_send_text {
+ my ($line, $server, $windowitem) = @_;
+
+ return if $windowitem;
+
+ if ($last_ts < (time() - 60)) {
+ @buffer=();
+ $buf= 0;
+ $pastewin->print("Buffer cleared!");
+ }
+ $line =~ s/^\s+/ /;
+ $line =~ s/\s+$/ /;
+ $buffer[$buf] .= $line." ";
+
+ if (!$line and $buffer[$buf] ne "") {
+ $buf++;
+ }
+
+ if (Irssi::settings_get_bool("paste_showbuf")) {
+ $pastewin->print($line,MSGLEVEL_CLIENTCRAP);
+ }
+ $last_ts = time();
+
+ Irssi::signal_stop();
+}
+
+sub paste {
+ my ($data, $server, $witem) = @_;
+
+ my $offset;
+
+ if (!$buf and $buffer[0] eq "") {
+ $pastewin->print("No buffer to paste!",MSGLEVEL_HILIGHT);
+ return;
+ }
+
+ my $anyoldwin = Irssi::active_win();
+ my $width = Irssi::settings_get_int("paste_width");
+ my $prefix = Irssi::settings_get_str("paste_prefix");
+ my $prefixlen = length($prefix);
+ if ($width > 0) {
+ if ($width < 3+$prefixlen) {
+ $pastewin->print("paste_width is too small ($width<".
+ (3+$prefixlen).")!",
+ MSGLEVEL_HILIGHT);
+ return;
+ }
+ $Text::Wrap::columns = $width;
+ } else {
+ if ($server->{nick}) {
+ $offset+=length($server->{nick})+$prefixlen+15;
+ }
+ $Text::Wrap::columns = $anyoldwin->{'width'} - $offset;
+ if ($Text::Wrap::columns < 3+$prefixlen) {
+ $pastewin->print("Width would be too small (".
+ $Text::Wrap::columns."<".
+ (3+$prefixlen).", window width was ".
+ $anyoldwin->{'width'}.
+ ")!",
+ MSGLEVEL_HILIGHT);
+ return;
+ }
+ }
+
+ foreach my $outbuffer (@buffer) {
+ $outbuffer =~ s/^\s*//;
+ $outbuffer =~ s/\s*$//;
+ $outbuffer = wrap("","", $outbuffer);
+ $outbuffer = expand($outbuffer);
+
+ if ($witem) {
+ foreach (split '\n', $outbuffer) {
+ $witem->command("say ".$prefix.$_);
+ }
+ } else {
+ foreach (split '\n', $outbuffer) {
+ $anyoldwin->print($prefix.$_, MSGLEVEL_HILIGHT);
+ }
+ }
+ }
+}
+
+sub clear_buffer {
+ @buffer = ();
+ $buf = 0;
+ $pastewin->print("Buffer cleared!");
+}
+
+}
+
+Irssi::signal_add_first("send text", "event_send_text");
+Irssi::command_bind("paste", "paste");
+Irssi::command_bind("clear_buffer", "clear_buffer");
diff --git a/scripts/paste_kimmoke.pl b/scripts/paste_kimmoke.pl
new file mode 100644
index 0000000..9abe98e
--- /dev/null
+++ b/scripts/paste_kimmoke.pl
@@ -0,0 +1,110 @@
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '0.1';
+%IRSSI = (
+ authors => 'Kimmo Lehto',
+ contact => 'kimmo@a-men.org' ,
+ name => 'Paste-KimmoKe',
+ description => 'Provides /start, /stop, /play <-nopack> <-nospace> paste mechanism - start and stop recording and then replay without linebreaks. Also /see to view what was recorded.',
+ license => 'Public Domain',
+ changed => 'Wed Mar 27 14:51 EET 2002'
+);
+
+my $_active = undef;
+my @_record = undef;
+my $_recorded_stuff = undef;
+my $_nospace = undef;
+my $_nopack = undef;
+
+sub cmd_start
+{
+ my ($arg, $server, $witem) = @_;
+
+ if ($_active)
+ {
+ Irssi::print("ERROR - Already recording.");
+ return 0;
+ }
+
+ $_active = 1;
+ Irssi::print("Recording, enter /stop to end...");
+ @_record = ();
+ Irssi::signal_add_first("send text", "record");
+}
+
+sub cmd_stop
+{
+ my ($arg, $server, $witem) = @_;
+
+ if (!$_active)
+ {
+ Irssi::print("ERROR - Not recording.");
+ return 0;
+ }
+
+ $_active = undef;
+ Irssi::signal_remove("send text", "record");
+
+ Irssi::print('Recording ended. ' . ($#_record + 1) . ' lines captured. Use /see to see and /play to play recording without linefeeds (-help for reformatting options).');
+}
+
+sub record {
+ my ($data) = @_;
+ push @_record, $data;
+ Irssi::signal_stop();
+}
+
+
+
+sub reformat {
+ my ($arg) = @_;
+ my $data;
+
+ if ($arg =~ /\-nospace/)
+ {
+ $data = join("", @_record);
+ }
+ else
+ {
+ $data = join(" ", @_record);
+ }
+ if ($arg !~ /\-nopack/)
+ {
+ $data =~ s/\s+|\t+/ /g;
+ }
+ if ($arg =~ /help/i)
+ {
+ return("You can use -nospace if you wish to join the input lines without replacing linefeeds with spaces, or -nopack if you don\'t want to replace multiple spaces with only one space.");
+ }
+ return $data;
+}
+
+sub cmd_see {
+ my ($arg, $server, $witem) = @_;
+
+ @_record && Irssi::print(reformat($arg));
+ Irssi::print("End of recorded input.");
+}
+
+sub cmd_play {
+ my ($arg, $server, $witem) = @_;
+ if ($arg =~ /help/i) { Irssi::print(reformat($arg)); return 0; }
+ if (@_record)
+ {
+ Irssi::signal_emit("send text", reformat($arg), $server, $witem);
+ }
+ else
+ {
+ Irssi::print("ERROR - Nothing to play.");
+ }
+}
+
+Irssi::command_bind('start', 'cmd_start');
+Irssi::command_bind('stop', 'cmd_stop');
+Irssi::command_bind('see', 'cmd_see');
+Irssi::command_bind('play', 'cmd_play');
+
+
+
diff --git a/scripts/pelix.pl b/scripts/pelix.pl
new file mode 100644
index 0000000..4e1125f
--- /dev/null
+++ b/scripts/pelix.pl
@@ -0,0 +1,235 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+$VERSION = '0.3';
+%IRSSI = (
+ authors => 'Mankeli',
+ contact => 'mankeli@einari.org',
+ name => '#pelix Helpers',
+ description => 'This script allows you flood shit.',
+ license => 'GNU/GPL',
+);
+
+# INSTRUCTIONS:
+# /pelix [cmd] [length]
+#
+# cmds are: wtf, biy0, sepi, jupe and veez
+# (sepi cmd is experimental and should be handled with extreme care)
+
+# VERSION HISTORY:
+# 0.1 wtf
+# 0.1.5 biy0
+# 0.1.6 sepi
+# 0.2 jupe
+# 0.3 veez
+
+# biy0 script ripped from palomies mirc-script copyright(c) 2003 veezay/palomies.com(r) all rights reserved, used with permission.
+
+sub pelix_biyo
+{
+ my ($pituus) = @_;
+ my $temppi;
+ my $koht;
+ my $tod;
+ my $eka;
+ my $wanha;
+
+ $tod = int(rand(2));
+ if ($tod eq 0)
+ {
+ $koht = int(rand(6));
+ if ($koht eq 0) { $temppi = ":"; }
+ if ($koht eq 1) { $temppi = "."; }
+ if ($koht eq 2) { $temppi = "D"; }
+ if ($koht eq 3) { $temppi = "d"; }
+ if ($koht eq 4) { $temppi = ";"; }
+ if ($koht eq 5) { $temppi = ","; }
+ }
+ else
+ {
+ $temppi = ":";
+ }
+ $wanha = -1;
+ for ($koht=0; $koht<$pituus; $koht++)
+ {
+ $eka = int(rand(10));
+ if (($eka == 0) && ($wanha != 0)) { $temppi.=":"; }
+ if (($eka == 1) && ($wanha != 1)) { $temppi.="."; }
+ if (($eka == 2) && ($wanha != 2)) { $temppi.="d"; }
+ if (($eka == 3) && ($wanha != 3)) { $temppi.=";"; }
+ if (($eka == 4) && ($wanha != 4)) { $temppi.=","; }
+ if (($eka == 5) && ($wanha != 5)) { $temppi.=":"; }
+ if (($eka > 5) && ($eka <= 7) && ($wanha != $eka)) { $temppi.="D"; }
+ if (($eka == 9) && ($eka != $wanha)) { $temppi.="_"; }
+ }
+ return ($temppi);
+}
+
+sub pelix_wtf
+{
+ my ($pituus) = @_;
+ my $temppi;
+ my $koht;
+ $temppi = "";
+# srand();
+ for ($koht=0; $koht<$pituus; $koht++)
+ {
+ if (int(rand(2)) eq 0)
+ {
+ $temppi.=";D ";
+ }
+ else
+ {
+ $temppi.="? ";
+ }
+ }
+ return($temppi);
+}
+
+sub pelix_jupe
+{
+ my ($pituus) = @_;
+ my $temppi;
+ my $koht;
+ my $luku;
+ $temppi = "";
+# srand();
+ for ($koht=0; $koht<$pituus; $koht++)
+ {
+ $luku = int(rand(7));
+ if ($luku < 3)
+ {
+ $temppi.=":P";
+ }
+ elsif($luku == 3)
+ {
+ $temppi.=";PP;"
+ }
+ else
+ {
+ $temppi.="?";
+ }
+
+ if (int(rand(4)) < 3)
+ {
+ $temppi.=" ";
+ }
+ }
+ return($temppi);
+}
+
+sub pelix_veez
+{
+ my ($pituus) = @_;
+ my $temppi;
+ my $koht;
+ $temppi = "";
+ for ($koht=0; $koht<$pituus; $koht++)
+ {
+ if (int(rand(2)) eq 0)
+ {
+ $temppi.=";";
+ }
+ else
+ {
+ $temppi.=")";
+ }
+ }
+ return($temppi);
+
+}
+
+
+sub sepinsqd_smile
+{
+ my ($pituus) = @_;
+ my $temppi;
+ my $koht;
+ my $arvo;
+
+ $temppi = "";
+ for ($koht=0; $koht<$pituus; $koht++)
+ {
+ $arvo = int(rand(4));
+ if($arvo eq 0)
+ {
+ $temppi.="A";
+ }
+ elsif($arvo eq 1)
+ {
+ $temppi.="Å";
+ }
+ else
+ {
+ $temppi.=";";
+ }
+ }
+ return($temppi);
+}
+
+sub pelix
+{
+ my @teksti;
+# @version = $finger =~ /:\s*(\S+)\s*$/gm;
+ my ($data, $server, $witem) = @_;
+ my @arg = split(/ +/, $data);
+ my $tpit;
+
+ $tpit = @arg[1];
+
+
+ if (@arg[0] eq "biy0")
+ {
+ @teksti = pelix_biyo($tpit);
+ }
+ elsif (@arg[0] eq "wtf")
+ {
+ @teksti = pelix_wtf($tpit);
+ }
+ elsif (@arg[0] eq "jupe")
+ {
+ @teksti = pelix_jupe($tpit);
+ }
+ elsif (@arg[0] eq "veez")
+ {
+ @teksti = pelix_veez($tpit);
+ }
+ elsif (@arg[0] eq "sepi")
+ {
+ @teksti = sepinsqd_smile($tpit);
+ }
+ elsif (@arg[0] eq "")
+ {
+ Irssi::print("no ÄgZön specified.");
+ return;
+ }
+ else
+ {
+ Irssi::print("No such ÄgZön as @arg[0].");
+ return;
+ }
+
+ if (!$server || !$server->{connected})
+ {
+ Irssi::print("Not connected to server");
+ return;
+ }
+
+ if ($witem && ($witem->{type} eq "CHANNEL" || $witem->{type} eq "QUERY"))
+ {
+ $witem->command("MSG ".$witem->{name}." @teksti");
+ }
+ else
+ {
+ Irssi::print("No active channel/query in window");
+ }
+}
+
+sub pelix_help
+{
+ Irssi::print("Usage: runQ");
+}
+
+Irssi::command_bind('pelix', 'pelix');
+Irssi::command_bind('help pelix','pelix_help');
diff --git a/scripts/perlalias.pl b/scripts/perlalias.pl
new file mode 100644
index 0000000..1d1c712
--- /dev/null
+++ b/scripts/perlalias.pl
@@ -0,0 +1,1026 @@
+=head1 perlalias.pl - Perl-based command aliases for irssi
+
+This script provides an /alias-like function that uses small pieces of perl code to carry out the commands.
+
+=head2 Usage
+
+Install into irssi script directory and /run perlalias and/or put into autorun.
+
+=head2 Commands
+
+=over
+
+=item /perlalias
+
+Syntax: /perlalias [[[-]<alias>] [<code>]]
+
+Parameters: A name of the alias and the perl code to execute.
+
+If you prepend the alias with -, it will remove the alias.
+
+If you give no arguments, the list of defined aliases will be displayed.
+
+Description:
+
+Creates or updates an alias. Like any perl code, multiple statements must be separated using ; characters.
+No replacement of parameter values is done: any $text is a perl variable.
+
+Examples:
+
+/PERLALIAS UNACT foreach my $w (Irssi::windows) { $w->activity(0); }
+
+=back
+
+=over
+
+=item /perlunalias
+
+Syntax: /perlunalias <alias>
+
+Parameters: The alias to remove.
+
+Description:
+
+Removes the given alias.
+
+=back
+
+Notes on alias authoring:
+
+The following variables are available to you in in the body of your perlalias:
+
+* $_ contains the raw text of the arguments supplied to the command
+* @_ contains those some arguments split on whitespace
+* $server references the currently active server, if any, otherwise undef.
+* $witem references the currently active window item (channel, query, or other), if any. Otherwise undef.
+* Most of the irssi $X variables are available as well, producing results exactly as if you used Irssi::parse_special.
+* Note that $1, $2, etc do not map to the irssi variables. Those are regex variables. You want $_[0], $_[1], etc:
+** Unless you mess with $", $3- is basically "@_[2..$#_]", and $* is "@_" or simply $_ (which has repeated spaces intact)
+
+The alias is compiled once, when the alias is added or the script loads the saved aliases. As usual, your BEGIN {} blocks will run immediately at
+that time. If an alias encounters a fatal-error during compilation, the alias will still be stored and saved, and the error will be saved in the alias. The error will be redisplayed if you try to use the alias: no attempt to execute any code will be made. The alias will also be displayed differently in the /perlalias listing.
+
+You can use signal_add or command_bind as normal in your alias. However, if you use them normally, the signals and commands you
+add will be removed when the alias finishes executing. If you want a persistant signal or command, you must place it inside a
+BEGIN {} or UNITCHECK {} block (and you must pass the compile stage).
+
+Note that because you are adding code to an already-running perl state, CHECK {} blocks do not run.
+
+Additionally, all aliases added are linked to perlalias.pl: if it is unloaded, the aliases will be removed.
+
+You can retain data between multiple use of the alias using an 'our' variable. These variables are not shared with other aliases, and neither are named subs that you might declare.
+In addition, these variables aren't saved if the script is unloaded and reloaded (or if irssi restarts).
+
+The following directives are in effect on alias code:
+
+use strict;
+use warnings FATAL => qw(closure);
+
+All default warnings - those marked (S) or (D) in perldiag - are enabled and closure warnings are made fatal errors.
+
+Closure warnings are made fatal errors, so you get an error if you try to use an outer lexical (my/state) variable inside a named sub. This won't
+work as you might normally expect at file-scope as alias code is compiled once and run multiple times. All other warnings are off by default. If you
+want them, you can use warnings; as usual.
+
+Aliases can be saved and reloaded with the usual /save and /reload (including autosave). Saved aliases are loaded at script load. The textual content
+of the alias (including BEGIN {} and UNITCHECK {} blocks) are saved and will be re-executed when the alias next loads.
+
+=head2 ChangeLog
+
+=over
+
+=item 2.0
+
+Perl 5.22 or later is now mandatory.
+
+Major overhaul to how aliases get compiled and executed:
+
+* Aliases are now under the effect of 'use 5.22.0': perl version 5.22.0 is required both for perlalias itself and for aliases. In addition, all perl 5.22.0 feature bundles are enabled (see perldoc feature). Notably, 'state $var' is available by default.
+* Aliases are now compiled with strict on, default perl warnings (previously all warnings were off), and with closure warnings (see perldiag) enabled. This will help warn you of using outside 'my' variables inside named subs : this won't work as you expect!
+* Perlalias warnings will emit to the default window with a nicer looking output now.
+* Aliases now get their own individual package scopes, so your 'our' variables and named subs are no longer shared among aliases.
+* You can use 'shared state $Var' to share the $Var variable with your other aliases. You have to do this in each alias that wants to use the shared variable. You can share scalars, arrays, and hashes this way.
+** If you use an initializer, only the first alias to run that declares the state variable will decide the initial value of the variable.
+* You now have access to most of the $X-type special variables used in standard aliases, without needing to deal with parse_special().
+* Aliases that fail to compile are no longer rejected. They'll be registered, but when you try to execute them, the compile error message will simply be displayed again. Failed aliases will also display differently in the alias list.
+
+=item 1.3
+
+Made signal_add and command_bind usable within the alias code. They will persist if used inside a BEGIN block but will be removed
+after execution otherwise.
+
+=item 1.0
+
+First version.
+
+=back
+
+=cut
+
+# This need to be before pragmas, so that the eval runs in a pragma-free state
+sub _clean_eval { eval $_[0]; } ## no critic
+
+use 5.22.0;
+use strict;
+use warnings FATAL => qw(all);
+use Irssi;
+use Irssi::Irc;
+use Carp ();
+
+use B ();
+
+{ package Irssi::Nick; } # Keeps trying to look for this package but for some reason it doesn't get loaded.
+
+our $VERSION = '2.0.1';
+our %IRSSI = (
+ authors => 'aquanight',
+ contact => 'aquanight@gmail.com',
+ name => 'perlalias',
+ description => 'Quickly create commands from short perl blocks',
+ license => 'public domain'
+ );
+
+package Irssi::Script::perlalias::IrssiVar {
+ sub TIESCALAR {
+ my $class = shift;
+ my $irssivar = shift;
+ my $this = bless \$irssivar, $class;
+ return $this;
+ }
+
+ sub FETCH {
+ my $this = shift;
+ my $irssivar = $$this;
+ return Irssi::Script::perlalias::aliaspkg::parse_special($irssivar);
+ }
+
+ sub STORE { Carp::croak "Attempt to modify irssi special variable"; }
+}
+
+my $_eval_prep;
+BEGIN { $_eval_prep = ""; }
+
+# Base package which provides variables to the alias code.
+package Irssi::Script::perlalias::aliaspkg {
+ our $server;
+ our $witem;
+
+ our @_irssi_vars;
+ use vars map '$'.$_, @_irssi_vars = (
+ qw(A B C F I J K k M N O P Q R T V versiontime abiversion W Y Z sysname sysrelease sysarch topic tag chatnet itemname), # core
+ qw(H S X x usermode cumode cumode_space), # irc
+ qw(E L U), # gui
+ qw(winref winname), # fe
+ qw(D)); # notify-whois
+
+ BEGIN {
+ for my $var (@_irssi_vars) {
+ use Symbol ();
+ my $gr = Symbol::qualify_to_ref($var);
+ my $sv = *$gr{SCALAR};
+ tie $$sv, 'Irssi::Script::perlalias::IrssiVar' => "\$$var";
+ $_eval_prep .= "our \$$var;\n";
+ }
+ }
+
+ our %shared;
+
+ # Empty placeholder sub for our keyword.
+ sub shared {
+ }
+
+ sub parse_special {
+ my ($special) = @_;
+ defined $witem and return $witem->parse_special($special);
+ defined $server and return $server->parse_special($special);
+ return Irssi::parse_special($special);
+ }
+}
+
+# The below is intended to be representative of the template of an alias's package.
+#package Irssi::Script::perlalias::aliaspkg::perlalias {
+# BEGIN {
+# import Irssi::Script::perlalias::aliaspkg;
+# }
+#
+# our $_name = "name of the command";
+#
+# our $_text = "plaintext of the alias";
+#
+# sub invoke {
+# # The compiled version of the alias.
+# }
+#
+# our @_signals; # Data about the signals this alias has hooked
+# our @_commands: # Data about commands this alias has created
+#
+# our $_error; # Stored compilation error
+#}
+
+# Unfortunately, we can't really just use the alias name as a package name. Irssi commands have no restrictions on what characters are in them.
+# Nothing stops someone from wanting a command named mallet::gnome or something else weird. It's on them to figure out how to type in weird stuff
+# like ^W or whatever. Whitespace is somewhat safe due to the command format but not entirely.
+our %alias_packages = ();
+
+my $pkgindex = 0;
+
+sub next_package_name { sprintf("Irssi::Script::perlalias::aliaspkg::A%d", ++$pkgindex); };
+
+# These capture signal_add* and command_bind* invocations that occur during alias compilation (via BEGIN{}s) and execution.
+
+sub capture_signal_command {
+ my ($cmd, $irssi_proc, $store) = @_;
+ my $capture_handler = sub {
+ #exists $cmds{$cmd} or return;
+ #defined $cmds{$cmd}->{cmpcmd} or return;
+ #Carp::cluck "Capturing attempt to add signal";
+ $irssi_proc->(@_);
+ push @$store, $_[0], $_[1];
+ };
+ return $capture_handler;
+}
+
+sub cleanup_signals {
+ my ($remove_proc, @signals) = @_;
+ while (scalar(@signals) > 0) {
+ my ($signal, $handler) = splice @signals, 0, 2;
+ defined($signal) or return;
+ $remove_proc->($signal, $handler);
+ }
+}
+
+sub execute_alias;
+
+our $alias_depth = "";
+sub cmd__alias {
+ my ($data, $server, $witem) = @_;
+ return if $alias_depth;
+ # If they do Irssi::command("blerp") or anything like that, it needs to go to a real command, just like aliases do.
+ local $alias_depth = 1;
+ my $sig = Irssi::signal_get_emitted();
+ Irssi::signal_stop(); # Don't let any real command catch it.
+ my ($cmd) = ($sig =~ m/^command (.*)$/);
+ defined $cmd or Carp::confess "This is weird"; # What are we doing here?
+ execute_alias $cmd, $data, $server, $witem;
+}
+
+# The new alias handling code starts here:
+
+sub destroy_alias_package {
+ my ($name) = @_;
+ my $package = $alias_packages{$name};
+ return unless defined $package;
+ no strict 'refs';
+ my @signals = @{"${package}::signals"};
+ my @commands = @{"${package}::commands"};
+ cleanup_signals(\&Irssi::signal_remove, @signals);
+ cleanup_signals(\&Irssi::command_unbind, @commands);
+ delete $alias_packages{$name};
+ Irssi::command_unbind("$name", \&cmd__alias);
+ Symbol::delete_package($package);
+ return;
+}
+
+sub collect_shared_variables;
+
+sub setup_alias_package {
+ my ($name, $code) = @_;
+ # Terminate the existing alias, if there is one.
+ exists $alias_packages{$name} and destroy_alias_package $name;
+ Irssi::command_bind_first("$name", \&cmd__alias);
+ my $package = next_package_name;
+ $alias_packages{$name} = $package;
+ my $signals;
+ my $commands;
+ {
+ no strict 'refs';
+ ${"${package}::_text"} = $code;
+ ${"${package}::_name"} = $name;
+ @{"${package}::_signals"} = ();
+ $signals = \@{"${package}::_signals"};
+ @{"${package}::_commands"} = ();
+ $commands = \@{"${package}::_commands"};
+ ${"${package}::_error"} = undef;
+ }
+ no warnings 'redefine'; # Shut up about monkey patching
+ local *Irssi::signal_add = capture_signal_command($name, Irssi->can("signal_add"), $signals);
+ local *Irssi::signal_add_first = capture_signal_command($name, Irssi->can("signal_add_first"), $signals);
+ local *Irssi::signal_add_last = capture_signal_command($name, Irssi->can("signal_add_last"), $signals);
+ local *Irssi::signal_add_priority = capture_signal_command($name, Irssi->can("signal_add_priority"), $signals);
+ local *Irssi::command_bind = capture_signal_command($name, Irssi->can("command_bind"), $commands);
+ local *Irssi::command_bind_first = capture_signal_command($name, Irssi->can("command_bind_first"), $commands);
+ local *Irssi::command_bind_last = capture_signal_command($name, Irssi->can("command_bind_last"), $commands);
+ local $SIG{__WARN__} = sub {
+ Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_warning => $name);
+ Irssi::print($_[0], MSGLEVEL_CLIENTERROR);
+ };
+ my sub failed_alias { ## no critic
+ my $err = shift;
+ $err =~ /^ASSERT/ and die $err; ## no critic
+ no strict 'refs';
+ undef *{"${package}::invoke"}; # Kill the sub if it compiled but we failed shared-state setup.
+ ${"${package}::_error"} = $err;
+ Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_compile_error => $name);
+ Irssi::print($err, MSGLEVEL_CLIENTERROR);
+ cleanup_signals(\&Irssi::signal_remove, @$signals);
+ cleanup_signals(\&Irssi::command_unbind, @$commands);
+ }
+ _clean_eval qq{
+#line 1 "perlalias-eval-setup"
+ package Irssi::Script::perlalias::aliaspkg;
+ BEGIN { \*${package}::shared = \\&shared; }
+ our \$shared;
+ our \$witem;
+ $_eval_prep
+ package $package;
+ use 5.22.0;
+ use strict;
+ use warnings 'closure';
+ use Irssi;
+ sub invoke {
+#line 1 "perlalias $name"
+ $code;
+ }
+ 1;
+ } or do { failed_alias $@; return; };
+ eval {
+ collect_shared_variables $package;
+ 1;
+ } or do { failed_alias $@; return; };
+}
+
+sub execute_alias {
+ my ($name, $data, $server, $witem) = @_;
+ local $Irssi::Script::perlalias::aliaspkg::server = $server;
+ local $Irssi::Script::perlalias::aliaspkg::witem = $witem;
+ my $package = $alias_packages{$name};
+ return unless defined $package;
+ no strict 'refs';
+ my $proc = "$package"->can("invoke");
+ unless (defined $proc) {
+ my $err = ${"${package}::_error"};
+ defined $err or return; # Not sure how we'd get here with no error and no proc. Perhaps we lost a race?
+ Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_compile_error => $name);
+ Irssi::print($err, MSGLEVEL_CLIENTERROR);
+ }
+ my @signals;
+ my @commands;
+ no warnings 'redefine'; # SHUT UP ABOUT MONKEY PATCHING
+ local *Irssi::signal_add = capture_signal_command($name, Irssi->can("signal_add"), \@signals);
+ local *Irssi::signal_add_first = capture_signal_command($name, Irssi->can("signal_add_first"), \@signals);
+ local *Irssi::signal_add_last = capture_signal_command($name, Irssi->can("signal_add_last"), \@signals);
+ local *Irssi::signal_add_priority = capture_signal_command($name, Irssi->can("signal_add_priority"), \@signals);
+ local *Irssi::command_bind = capture_signal_command($name, Irssi->can("command_bind"), \@commands);
+ local *Irssi::command_bind_first = capture_signal_command($name, Irssi->can("command_bind_first"), \@commands);
+ local *Irssi::command_bind_last = capture_signal_command($name, Irssi->can("command_bind_last"), \@commands);
+ local $SIG{__WARN__} = sub {
+ Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_warning => $name);
+ Irssi::print($_[0], MSGLEVEL_CLIENTERROR);
+ };
+ local $_ = $data;
+ my @args = split / +/, $data;
+ eval { $proc->(@args);};
+ my $err = $@;
+ # signals/commands created during this step were not the result of a BEGIN{}/UNITCHECK{}/etc.
+ # These signals get removed after completion!
+ cleanup_signals(\&Irssi::signal_remove, @signals);
+ cleanup_signals(\&Irssi::command_unbind, @commands);
+ if ($err) {
+ Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_exec_error => $name);
+ Irssi::print($err, MSGLEVEL_CLIENTERROR);
+ }
+}
+
+sub list_commands {
+ my ($prefix) = @_;
+ my @whichones = sort grep /^\Q$prefix\E/, keys %alias_packages;
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'perlaliaslist_header');
+ for my $name (@whichones) {
+ my $package = $alias_packages{$name};
+ no strict 'refs';
+ my $text = ${"${package}::_text"};
+ if (defined "$package"->can("invoke")) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, perlaliaslist_line => $name, $text);
+ }
+ else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, perlaliaslist_line_error => $name, $text);
+ }
+ }
+}
+
+sub cmd_perlalias {
+ my ($data, $server, $witem) = @_;
+ my ($command, $script) = split /\s+/, $data, 2;
+ if (($command//"") eq "") {
+ list_commands "";
+ }
+ elsif ($command =~ m/^-/) {
+ $command = substr($command, 1);
+ if (exists $alias_packages{$command}) {
+ destroy_alias_package $command;
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, perlalias_removed => $command);
+ }
+ else {
+ Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_not_found => $command);
+ }
+ }
+ elsif (($script//"") eq "") {
+ list_commands $command;
+ }
+ else {
+ setup_alias_package $command, $script;
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, perlalias_added => $command);
+ }
+
+}
+
+sub cmd_perlunalias {
+ my ($data, $server, $witem) = @_;
+ my $command = $data;
+ if (exists $alias_packages{$command}) {
+ destroy_alias_package $command;
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, perlalias_removed => $command);
+ }
+ else {
+ Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_not_found => $command);
+ }
+}
+
+sub sig_setup_saved {
+ my ($main, $auto) = @_;
+ my $file = Irssi::get_irssi_dir() . "/perlalias.json";
+ open my $fd, '>', $file or return;
+ my $js = JSON::PP->new->utf8->pretty(0);
+ my $obj = [ map {
+ my $package = $alias_packages{$_};
+ no strict 'refs';
+ my $text = ${"${package}::_text"};
+ +{ command => $_, script => $text };
+ } keys %alias_packages ];
+ $fd->print($js->encode($obj));
+ close $fd;
+}
+
+use JSON::PP;
+
+use constant JSON_CONFIG => Irssi::get_irssi_dir() . "/perlalias.json";
+use constant LEGACY_CONFIG => Irssi::get_irssi_dir() . "/perlalias";
+
+sub sig_setup_reread {
+ my %newcmds;
+ my $fd;
+ if (open $fd, "<", JSON_CONFIG) {
+ my $js = JSON::PP->new->utf8->pretty(0);
+ local $/;
+ unless (eval {
+ my $obj = $js->decode(<$fd>);
+ for my $entry (@$obj) {
+ my ($cmd, $script) = $entry->@{qw/command script/};
+ if (exists $newcmds{$cmd}) {
+ Irssi::print("There is a duplicate record in the PerlAlias save file.", MSGLEVEL_CLIENTERROR);
+ Irssi::print("Offending alias: $cmd", MSGLEVEL_CLIENTERROR);
+ Irssi::print("Previous definition: " . $newcmds{$cmd}, MSGLEVEL_CLIENTERROR);
+ Irssi::print("Duplicate definition: $script", MSGLEVEL_CLIENTERROR);
+ }
+ $newcmds{$cmd} = $script;
+ }
+ 1;
+ }) { goto LEGACY_CONF; }
+ close $fd;
+ goto PROCESS;
+ }
+ else
+ {
+ LEGACY_CONF:
+ open my $fd, "<", LEGACY_CONFIG or return;
+ my $ln;
+ while (defined($ln = <$fd>)) {
+ chomp $ln;
+ my ($cmd, $script) = split /\t/, $ln, 2;
+ if (exists $newcmds{$cmd}) {
+ Irssi::print("There is a duplicate record in the PerlAlias save file.", MSGLEVEL_CLIENTERROR);
+ Irssi::print("Offending alias: $cmd", MSGLEVEL_CLIENTERROR);
+ Irssi::print("Previous definition: " . $newcmds{$cmd}, MSGLEVEL_CLIENTERROR);
+ Irssi::print("Duplicate definition: $script", MSGLEVEL_CLIENTERROR);
+ }
+ $newcmds{$cmd} = $script;
+ }
+ Irssi::print("Legacy config loaded. Please /save to upgrade config file.", MSGLEVEL_CLIENTNOTICE);
+ close $fd;
+ }
+ PROCESS:
+ # Scrub the existing list. Update existings, remove any that aren't in the config, then we'll add any that's new.
+ my @currentcmds = keys %alias_packages;
+ for my $cmd (@currentcmds) {
+ if (exists $newcmds{$cmd}) {
+ setup_alias_package($cmd, $newcmds{$cmd});
+ }
+ else {
+ destroy_alias_package($cmd);
+ }
+ delete $newcmds{$cmd};
+ }
+ # By this point all that should be in newcmds is any ... new commands.
+ for my $cmd (keys %newcmds) {
+ setup_alias_package($cmd, $newcmds{$cmd});
+ }
+}
+
+sub sig_complete_perlalias {
+ my ($lst, $win, $word, $line, $want_space) = @_;
+ $word//return;
+ $line//return;
+ $lst//return;
+ if ($line ne '') {
+ my $package = $alias_packages{$line};
+ no strict 'refs';
+ my $def = ${"${package}::_text"};
+ $def//return;
+ push @$lst, $def->{textcmd};
+ Irssi::signal_stop();
+ }
+ else {
+ push @$lst, (grep /^\Q$word\E/i, keys %alias_packages);
+ Irssi::signal_stop();
+ }
+}
+
+sub sig_complete_perlunalias {
+ my ($lst, $win, $word, $line, $want_space) = @_;
+ $lst//return;
+ $word//return;
+ push @$lst, (grep /^\Q$word\E/i, keys %alias_packages);
+}
+
+Irssi::signal_register({"complete command " => [qw(glistptr_char* Irssi::UI::Window string string intptr)]});
+Irssi::signal_add("complete command perlalias" => \&sig_complete_perlalias);
+Irssi::signal_add("complete command perlunalias" => \&sig_complete_perlunalias);
+
+Irssi::signal_add("setup saved" => \&sig_setup_saved);
+Irssi::signal_add("setup reread" => \&sig_setup_reread);
+
+Irssi::command_bind(perlalias => \&cmd_perlalias);
+Irssi::command_bind(perlunalias => \&cmd_perlunalias);
+
+my %formats = (
+ # $0 Name of alias
+ 'perlalias_compile_error' => '{error Error compiling alias {hilight $0}:}',
+ # $0 Name of alias
+ 'perlalias_exec_error' => '{error Error executing alias {hilight $0}:}',
+ 'perlalias_warning' => '{error Warning in alias {hilight $0}:}',
+ 'perlalias_cmd_in_use' => 'Command {hilight $0} is already in use',
+ 'perlalias_added' => 'PerlAlias {hilight $0} added',
+ 'perlalias_removed' => 'PerlAlias {hilight $0} removed',
+ 'perlalias_not_found' => 'PerlAlias {hilight $0} not found',
+ 'perlaliaslist_header' => '%#PerlAliases:',
+ # $0 Name of alias, $1 alias text
+ 'perlaliaslist_line' => '%#$[10]0 $1',
+ 'perlaliaslist_line_error' => '%#{error $[10]0} $1',
+);
+
+Irssi::theme_register([%formats]);
+
+sig_setup_reread;
+
+#__END__
+
+# For error helping:
+my $_skip_asserts = 0;
+sub assert :prototype(&$) {
+ return if $_skip_asserts;
+ my $condition = shift;
+ my $message = shift;
+ return if $condition->();
+ Carp::confess "ASSERT FAILURE: $message";
+}
+
+# There is going to be some pretty heavy stuff going on here.
+
+# Because every perlalias runs inside its own package, there are basically three classes of variables:
+#
+# # Variables that reset every time the alias runs -- my $x; (*)
+# # Variables that keep their value between different alias runs, but are not visible to other aliases -- state $x; our $y;
+# # Variables that keep their value between different alias runs, and are shared across aliases -- shared state $z;
+#
+# The 'shared state' declarator brings the third type into existence.
+#
+# Major credit to 'mst' and 'LeoNerd' of Freendoe/#perl for putting up with my awkward attempts at figuring this out.
+
+# Shared variables are now of the format:
+# [ <data>, <proc>, <pad>, <index> ]
+# <data> contains an instance of Tie::StdScalar, Tie::StdArray, or Tie::StdHash
+# <proc> contains an anonymous sub. Any time the variable is accessed, we call <proc> in void context.
+# <proc> will just be a small sub that contains a state with initializer. Calling it will trigger the initializer.
+# <pad> Contains an array reference which is a reference to the first PAD of <proc>, which will be where we find....
+# <index> The index number to the state's "initializer has run" controlling variable.
+# When setting up a new shared variable, that variable should be a state, and if it has its own initializer, we will link that state
+# variable's initializer-control variable to the one in the anonymous sub. Thus if either initializer runs, neither will run again.
+
+use Tie::Scalar ();
+use Tie::Array ();
+use Tie::Hash ();
+
+use Scalar::Util 'reftype';
+
+package Irssi::Script::perlalias::SharedVar {
+ sub create {
+ my ($class, $data, $proc, $pad, $index) = @_;
+ my $this = bless [$data, $proc, $pad, $index], $class;
+ return $this;
+ }
+
+ sub TIESCALAR {
+ my ($class, $to) = @_;
+ return $to;
+ }
+
+ sub TIEARRAY {
+ my ($class, $to) = @_;
+ return $to;
+ }
+
+ sub TIEHASH {
+ my ($class, $to) = @_;
+ return $to;
+ }
+
+ for my $method (qw/FETCH STORE FETCHSIZE STORESIZE CLEAR PUSH POP SHIFT UNSHIFT SPLICE EXTEND DELETE EXISTS
+ DESTROY UNTIE FIRSTKEY NEXTKEY SCALAR/) {
+ no strict 'refs';
+ *{"Irssi::Script::perlalias::SharedVar::$method"} = sub {
+ my $this = shift;
+ my ($data, $proc, $pad, $index) = @$this;
+ # Spring the state initializer.
+ $proc->() unless $method eq "DESTROY" || $method eq "UNTIE";
+ $data->$method(@_);
+ }
+ }
+};
+
+# Be careful with the array this returns. It is ONLY safe to access indexes linked to scalars!
+sub get_state_pad {
+ my $sub = shift;
+ assert {defined $sub} "Undefined proc";
+ assert {ref($sub) eq "CODE"} "Not a proc";
+ return B::svref_2object($sub)->PADLIST->ARRAYelt(1)->object_2svref;
+}
+
+# Keep the C-style for loop for child-op enumeration in one spot.
+sub op_kids {
+ my $op = shift;
+ assert {defined $op} "Got an undefined op";
+ assert {$op->UNIVERSAL::isa("B::OP")} "Invalid opcode class";
+ my @kids;
+ if ($op->flags & B::OPf_KIDS) {
+ for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
+ assert { defined $kid } "Undefined kid";
+ push @kids, $kid;
+ }
+ }
+ return @kids;
+}
+
+# prototype for a map-like operator, so we can have walk_ops { BLOCK } $op
+sub walk_ops :prototype(&@) {
+ my $sub = shift;
+ my @ops = @_;
+ my @return;
+ while (scalar @ops) {
+ my $op = shift @ops;
+ assert {defined $op} "Undefined op";
+ assert {$op->UNIVERSAL::isa("B::OP")} "Invalid opcode class";
+ next unless $$op;
+ local $_ = $op;
+ push @return, $sub->();
+ unshift @ops, op_kids $op;
+ }
+ return @return;
+}
+
+# Returns the sub, the array for its PAD, and the index of the state variable's control var.
+# Packs it all into an array that we can shove into %shared_init;
+sub generate_state_locker {
+ my $sub = sub { state $x = 42; };
+ my $pad = get_state_pad $sub;
+ my ($stateix) = walk_ops {
+ return () unless B::class($_) eq "LOGOP";
+ return () unless $_->name eq 'once';
+ return ($_->targ);
+ } B::svref_2object($sub)->ROOT;
+ return $sub, $pad, $stateix;
+}
+
+use constant true => !0;
+use constant false => !1;
+
+sub is_op_type {
+ my ($op, $name) = @_;
+ $op->name eq $name and return true;
+ $op->name eq 'null' or return false;
+ return B::ppname($op->targ) eq "pp_$name";
+}
+
+sub op_is_sub {
+ my ($pad, $op, $sub) = @_;
+ assert {defined $op} "Undefined op";
+ assert {$op->UNIVERSAL::isa("B::OP")} "Invalid opcode class";
+ if (!is_op_type($op, "rv2cv")) {
+ return false;
+ }
+ assert { ($op->flags & ~B::RV2CVOPCV_FLAG_MASK) == 0 } "Not possible: perl should've paniced already";
+ if ($op->private & B::OPpENTERSUB_AMPER) { return false; }
+ if ($op->flags & B::OPf_KIDS == 0) { return false; }
+ my $rvop = $op->first;
+ my $cv;
+ if (is_op_type($rvop, 'gv') || is_op_type($rvop, 'const')) {
+ if (B::class($rvop) eq "PADOP") {
+ $cv = $pad->ARRAYelt($rvop->padix)->object_2svref;
+ }
+ elsif (B::class($rvop) eq "SVOP") {
+ $cv = $rvop->sv->object_2svref;
+ }
+ else {
+ assert { 0 } "Impossible, class is: " . B::class($rvop);
+ }
+ if (reftype($cv) eq "GLOB") {
+ $cv = *$cv{CODE};
+ }
+ }
+ elsif (is_op_type($rvop, 'padcv')) {
+ return false; # Not needed at this time.
+ }
+ else {
+ return false;
+ }
+ if (reftype($cv) ne "CODE") { return false; }
+ return $cv == $sub;
+}
+
+use B::Concise ();
+
+sub collect_shared_variables {
+ my $package = shift;
+ my $invoke = $package->can("invoke");
+
+ my $invoke_cv = B::svref_2object $invoke;
+ my $invoke_pl = $invoke_cv->PADLIST;
+ my $invoke_pn = $invoke_pl->NAMES;
+
+ my $pad = $invoke_pl->ARRAYelt(1);
+ my $padobj = $pad->object_2svref;
+
+ my sub padname {
+ my $ix = shift;
+ return $invoke_pn->ARRAYelt($ix);
+ }
+
+ my $cop;
+
+ my sub op_die {
+ die sprintf("%s at %s line %d.\n", shift, $cop->file, $cop->line); ## no critic
+ }
+
+ my sub op_assert(&$) {
+ return if $_skip_asserts;
+ my $condition = shift;
+ my $message = shift;
+ return if $condition->();
+ my $concise = "";
+ open my $fd, ">", \$concise;
+ my $prev = B::Concise::walk_output;
+ B::Concise::walk_output $fd;
+ B::Concise::concise_subref(basic => $invoke, "${package}::invoke");
+ B::Concise::walk_output $prev; # Set back to
+ close $fd;
+ Carp::confess sprintf("ASSERT FAILURE: %s at %s line %d.\n%s\n", $message, $cop->file, $cop->line, $concise);
+ }
+
+ my sub register_state {
+ my ($name, $ref, $state_control_index) = @_;
+ op_assert {ref $ref} "Didn't get a reference";
+ # Is there an existing shared state:
+ my $current = $Irssi::Script::perlalias::aliaspkg::shared{$name};
+ unless(defined $current) {
+ # No current state, so we need to create one.
+ my $data;
+ for (substr($name, 0, 1) . ref($ref)) {
+ /^\$SCALAR$/ and do { $data = Tie::StdScalar->TIESCALAR(); }, last;
+ /^\@ARRAY$/ and do { $data = Tie::StdArray->TIEARRAY(); }, last;
+ /^\%HASH$/ and do { $data = Tie::StdHash->TIEHASH(); }, last;
+ op_die "Can't figure out what to do with '$name'";
+ }
+ $current = Irssi::Script::perlalias::SharedVar->create($data, generate_state_locker);
+ $Irssi::Script::perlalias::aliaspkg::shared{$name} = $current;
+ }
+ ref $current eq "Irssi::Script::perlalias::SharedVar" or Carp::confess "Corrupt state in shared table at '$name'";
+ for (ref($ref)) {
+ /^SCALAR$/ and do { tie $$ref, "Irssi::Script::perlalias::SharedVar", $current; }, last;
+ /^ARRAY$/ and do { tie @$ref, "Irssi::Script::perlalias::SharedVar", $current; }, last;
+ /^HASH$/ and do { tie %$ref, "Irssi::Script::perlalias::SharedVar", $current; }, last;
+ op_die "Can't figure out what to do with '$name'";
+ }
+ if (defined $state_control_index) {
+ use feature 'refaliasing';
+ no warnings 'experimental';
+ \($padobj->[$state_control_index]) = \($current->[2]->[$current->[3]]);
+ }
+ }
+
+ # state $x; state @x; state %x;
+ my sub try_basic_state {
+ my $op = shift;
+ if ($op->name eq "padsv" or $op->name eq "padav" or $op->name eq "padhv") {
+ # Correct candidate for a direct variable access. At this point, we return either the name and reference
+ # to the variable or we raise an exception.
+ my $padix = $op->targ;
+ my $pname = padname $padix;
+ my $name = $pname->PVX;
+ my $ref = $pad->ARRAYelt($padix)->object_2svref;
+ # Check that this is a proper introduction
+ unless ($op->private & B::OPpLVAL_INTRO) {
+ op_die "Can't share variable '$name' because of its previous life (are you missing a 'state'?)";
+ }
+ if ($pname->FLAGS & B::PADNAMEt_OUR) {
+ # Sanity check mostly. 'our' variables will look like a global in the optree
+ op_die "Can't share 'our' variable '$name'";
+ }
+ unless ($pname->FLAGS & B::PADNAMEt_STATE) {
+ op_die "Can't share 'my' variable '$name'";
+ }
+ # It's a properly declared state variable, return the name and reference.
+ assert {ref $ref} "B returned something undefined";
+ register_state $name, $ref;
+ return 1;
+ }
+ return "";
+ }
+
+ # state ($x, $y, @x, %y);
+ my sub try_multi_state {
+ my $op = shift;
+ #
+ if (is_op_type $op, 'list') {
+ my @kids = op_kids $op;
+ for my $k (@kids) {
+ $k->name eq 'null' and next;
+ try_basic_state $k or op_die "Invalid multiple-variable state";
+ }
+ return 1;
+ }
+ return "";
+ }
+
+ # state $x = 42;
+ # state @x = (1..5);
+ my sub try_initializer_state {
+ my $op = shift;
+ # Initializers use a null which then goes to a 'once' opcode...
+ if ($op->name eq 'null') {
+ $op = $op->first;
+ # There should be no siblings...
+ return () if $op->sibling->$*;
+ return () unless $op->name eq 'once';
+ my @once_kids = op_kids $op;
+ # once has the following moving parts:
+ # ->targ is the pad index of the control variable:
+ my $control_padix = $op->targ;
+ # It also has three child ops:
+ # The first is a 'null' op for some reason.
+ # The second will be some kind of assignment op. This is the initializer.
+ # The third will ALWAYS be a padsv REGARDLESS OF WHAT KIND OF THING (it's never a padav or padhv).
+ # The third is the variable that was initialized - we'll also see it in the initializer if we went looking.
+ # Because the only thing in perl syntax that generates a 'once' opcode right now is 'state', we can assume
+ # this is what we're dealing with:
+ my $varop = pop @once_kids;
+ op_assert {$varop->name eq 'padsv'} sprintf("Unexpected once child '%s'", $varop->name);
+ #op_die sprintf("Unexpected once child '%s'", $varop->name) unless $varop->name eq 'padsv'; ##### assert
+ my $svix = $varop->targ;
+ my $pname = padname $svix;
+ my $name = $pname->PVX;
+ # Sanity check:
+ if (($pname->FLAGS & (B::PADNAMEt_OUR | B::PADNAMEt_STATE)) != B::PADNAMEt_STATE) {
+ op_die "Unexpected non-state variable"; ##### assert
+ }
+ my $ref = $pad->ARRAYelt($svix)->object_2svref;
+ assert {ref $ref} "B returned something undefined";
+ register_state $name, $ref, $control_padix;
+ return 1;
+ }
+ return "";
+ }
+
+ # Just tries to detect certain incorrect uses of 'shared' to give a more useful error message.
+ my sub nicer_errors {
+ my $op = shift;
+ op_assert {defined $op} "Undefined opcode";
+ if (is_op_type($op, 'rv2sv') || is_op_type($op, 'rv2av') || is_op_type($op, 'rv2hv') || is_op_type($op, 'rv2gv')) {
+ # Possible pattern for a global symbol
+ my $nx = $op->first;
+ if ($nx->name eq 'gvsv' or $nx->name eq 'gv') {
+ # Under multiplicity, gvsv is a PADOP and has ->padix point to a PAD containing the GV
+ # Without, gvsv is an SVOP and has the GV directly.
+ my $gv;
+ if (B::class($nx) eq 'PADOP') {
+ my $gvix = $nx->padix;
+ my $gvslot = $pad->ARRAYelt($gvix);
+ $gv = $gvslot->object_2svref;
+ }
+ else { # B::class($nx) eq 'SVOP'
+ $gv = $op->sv->object_2svref;
+ }
+ my $name = *$gv{NAME};
+ if ($nx->name eq 'gvsv' or $op->name eq 'rv2sv') {
+ $name = '$' . $name;
+ }
+ elsif ($op->name eq 'rv2av') {
+ $name = '@' . $name;
+ }
+ elsif ($op->name eq 'rv2hv') {
+ $name = '%' . $name;
+ }
+ elsif ($op->name eq 'rv2gv') {
+ $name = '*' . $name;
+ }
+ else {
+ return; # Fallback to default message.
+ }
+ if ($op->private & B::OPpOUR_INTRO) { # our statement introduced a global
+ op_die "Can't share 'our' variable '$name'";
+ }
+ else { # Qualified, previously-declared, or 'no strict'
+ op_die "Can't share global symbol '$name'";
+ }
+ }
+ }
+ }
+
+ walk_ops {
+ if (B::class($_) eq "COP") {
+ $cop = $_;
+ return ();
+ }
+ return () unless B::class($_) eq "UNOP";
+ return () unless $_->name eq 'entersub';
+ my @argops = op_kids $_;
+ if (@argops == 1) {
+ @argops = op_kids $_->first;
+ }
+ op_assert {@argops > 1} "What no arguments?";
+ my $subop = pop @argops;
+ # Check if it is the sub shared...
+ return unless op_is_sub($pad, $subop, \&Irssi::Script::perlalias::aliaspkg::shared);
+ # At this point forward, we start triggering exceptions if we find something we don't like.
+ $argops[0]->name eq 'pushmark' and shift @argops;
+ # We want only a single argument.
+ for my $op (@argops) {
+ my ($name, $ref, $state_control_index);
+ try_basic_state($op) and next;
+ try_multi_state($op) and next;
+ try_initializer_state($op) and next;
+ nicer_errors $op;
+ op_die "Invalid use of shared";
+ }
+ } $invoke_cv->ROOT;
+}
+
+# Some assorted debugging aids... Use via /script exec I guess.
+sub dump_aliases {
+ while (my ($alias, $package) = each %alias_packages) {
+ Irssi::print("Alias '$alias' : Package '$package'");
+ no strict 'refs';
+ if ($alias eq ${"${package}::_name"}) {
+ Irssi::print "-> _name is correct";
+ }
+ else {
+ Irssi::print "-> !!! _name is not correct! " . ${"${package}::_name"};
+ }
+ Irssi::print "-> Original code: " . ${"${package}::_text"};
+ if (defined(my $err = ${"${package}::_error"})) {
+ Irssi::print "-> Script did not compile: $err";
+ }
+ else {
+ my $cv = "$package"->can("invoke");
+ Irssi::print "-> PADNAME listing: [index] [name] [flags]";
+ {
+ my $cvb = B::svref_2object($cv);
+ my $cvpl = $cvb->PADLIST;
+ my $cvpn = $cvpl->NAMES;
+ for my $ix ( 0 .. $cvpn->MAX) {
+ my $pn = $cvpn->ARRAYelt($ix);
+ if ($pn->isa("B::PADNAME")) {
+ Irssi::print sprintf("[%d] [%s] [%x]", $ix, $pn->PVX//"(null)", $pn->FLAGS);
+ }
+ }
+ }
+
+ Irssi::print "-> Concise dump:";
+ my $concise = "";
+ open my $fd, ">", \$concise;
+ my $prev = B::Concise::walk_output;
+ B::Concise::walk_output $fd;
+ B::Concise::concise_subref(basic => $cv, "${package}::invoke");
+ B::Concise::walk_output $prev; # Set back to
+ Irssi::print $concise;
+ }
+ }
+}
diff --git a/scripts/pggb_sound.pl b/scripts/pggb_sound.pl
new file mode 100644
index 0000000..9cedcd1
--- /dev/null
+++ b/scripts/pggb_sound.pl
@@ -0,0 +1,251 @@
+## This is the IRSSI-version!
+## OK, here we go.
+## For bugs/suggestions/help contact me at duck@cs.uni-frankfurt.de
+##
+## This script does nothing usefull but is extremely usefull to me ;-).
+## It should handle CTCP SOUNDs correctly - even if the waves are stored
+## in subdirs and/or on SMB shares.
+## It can also initiate CTCP SOUNDs, handle sound requests and request
+## waves automatically.
+##
+## This is my first perl script. Please be kind to me ;-).
+## I built it on top of someone else's work, but I don't know whom...
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.2.3.23b";
+%IRSSI = (
+ authors => 'Adam Duck',
+ contact => 'duck@cs.uni-frankfurt.de',
+ name => 'PGGB_sound',
+ description => 'does CTCP SOUNDs and other similar things.',
+ license => 'GPLv2',
+ url => '',
+ );
+
+Irssi::settings_add_bool('PGGB', 'SOUND_autosend', 1);
+Irssi::settings_add_bool('PGGB', 'SOUND_autoget', 0);
+Irssi::settings_add_bool('PGGB', 'SOUND_play', 1);
+Irssi::settings_add_int( 'PGGB', 'SOUND_display', 5);
+Irssi::settings_add_str( 'PGGB', 'SOUND_hilight', '(none)');
+Irssi::settings_add_str( 'PGGB', 'SOUND_DCC', '(none)');
+Irssi::settings_add_str( 'PGGB', 'SOUND_dir', '~/.irssi/');
+Irssi::settings_add_str( 'PGGB', 'SOUND_command', 'play');
+my $autoget = Irssi::settings_get_bool("SOUND_autoget");
+
+# You can use <nothing>, ".gz" or ".bz2" as extension, the script will
+# honour it accordingly. I chose ".gz" because it should be available
+# on most systems ...
+# Btw, this is NOT the time consuming part. It's `parse_dir'.
+my $cachefile = $ENV{HOME} . "/.irssi/wavdir.cache.gz";
+
+########################################
+# Changelog
+# Sat 23 Mar 2002, 12:26:39 fixed stupid bug in sound_autosend
+#
+# ------------------------------------------------------------
+# Don't edit below this line unless you are prepared to code!
+# ------------------------------------------------------------
+
+use File::Listing;
+use File::Basename;
+
+Irssi::command_bind("sound", "sound_command");
+Irssi::signal_add_last("complete word", "sound_complete");
+Irssi::signal_add("event privmsg", "sound_autosend");
+Irssi::signal_add("ctcp msg", "CTCP_sound");
+Irssi::signal_add('print text', 'hilight_sound');
+Irssi::signal_add('dcc created', 'DCC_sound');
+#IRC::add_message_handler("PRIVMSG", "sound_autoget");
+
+
+Irssi::theme_register([
+ 'ctcp', '{ctcp {hilight $0} $1}'
+ ]);
+
+sub help {
+ Irssi::print("USAGE: /sound setup|<somewav>(.wav)?");
+ Irssi::print("\nsetup: creates the (vital) cache file.");
+ Irssi::print("Please setup all variables through the /SET command (they all begin with \"SOUND_\").");
+ Irssi::print("\nIf you have copied new waves to your sounddir, be sure to run \"/sound setup\" again!");
+}
+
+sub find_wave {
+ unless ( -e "$cachefile" ) {
+ Irssi::print("Cache file not found...");
+ create_cache();}
+ my $sound = shift(@_);
+ unless ($sound =~ /^.*\.wav$/i) {$sound = $sound . ".*.wav"}
+ my $LISTING;
+ if ( -r $cachefile ) {
+ if ($cachefile =~ /\.gz$/i) { open(LISTING, "-|", "zcat $cachefile") }
+ elsif ($cachefile =~ /\.bz2$/i) { open(LISTING, "-|", "bzcat $cachefile") }
+ else { open(LISTING, "-|", "cat $cachefile") };
+ } else {
+ Irssi::print("Cache file not readable. Nani?!?");
+ return;}
+ my @dir = parse_dir(\*LISTING, '+0001');
+ close(LISTING);
+ my $result = [];
+ for (@dir) {
+ my ($fName, $fType, $fSize, $fMtime, $fMode) = @$_;
+ if (basename($fName) =~ /^$sound$/i) {
+ #Irssi::print "$fName, $fType, $fSize, $fMtime, $fMode";
+ push @$result, $fName;}}
+ return @$result;
+}
+
+sub create_cache {
+ my $sounddir = Irssi::settings_get_str("SOUND_dir") . "/";
+ # we need the "LC_CTYPE=en" here because dir_parse is unable
+ # to parse things like "Mär 3" (German locale) ...
+ Irssi::print("Creating $cachefile (this could take a while...)");
+ my $command = "/exec LC_CTYPE=en ls -lR $sounddir";
+ if ($cachefile =~ /\.gz$/i) { $command = $command . " | gzip" }
+ elsif ($cachefile =~ /\.bz2$/i) { $command = $command . " | bzip2" }
+ Irssi::command("$command > $cachefile");
+}
+
+sub onoff { shift(@_) ? return "ON" : return "OFF"; }
+
+sub sound_command {
+ my $sounddir = Irssi::settings_get_str("SOUND_dir") . "/";
+ my $soundcmd = Irssi::settings_get_str("SOUND_command");
+
+ my ($data, $server, $witem) = @_;
+ $data =~ /([\w\.]+)(.*)/;
+ my $sound = $1;
+ my $rest = $2;
+ $rest =~ s/ *//;
+ unless ($rest eq "") { $rest = " " . $rest;};
+ if ($sound =~ /^setup$/i) { create_cache(); return; }
+ if (!($sound =~ /.*\.wav/i)) { $sound = $sound . ".wav";}
+ if ($witem && ($witem->{type} eq "CHANNEL" ||
+ $witem->{type} eq "QUERY")) {
+ my $wavefile = (find_wave($sound))[0];
+ if ( -r $wavefile ) {
+ $witem->command("/CTCP $witem->{name} SOUND ".lc(basename($wavefile))."$rest");
+ my $playcmd = system("$soundcmd $wavefile &"); # that's not so good ...
+ } else {
+ $witem->print("\"$sound\" not found in \"$sounddir\" or cache file too old."); }
+ } else {
+ Irssi::print "There's no point in running a \"CTCP SOUND\" command here."; }
+ return 1;
+}
+
+sub sound_complete {
+ my ($complist, $window, $word, $linestart, $want_space) = @_;
+ if ($linestart =~ /^\/sound$/) {
+ my $coli = [];
+ for (find_wave($word)) { push(@$coli, basename($_)); }
+ my $max = Irssi::settings_get_int('SOUND_display');
+ if (@$coli > $max) {
+ $window->print("@$coli[0..($max-1)] ...");
+ } else {
+ push @$complist, @$coli; }}}
+
+sub sound_autosend {
+ if (!Irssi::settings_get_bool("SOUND_autosend")) { return 0; }
+ my ($server, $data, $nick, $address) = @_;
+ my $myname = $server->{nick};
+
+ $data =~ /(.*) :!$myname +(.*\.wav)/i;
+ if ($2 eq "") { return 0; }
+ my $channel = $1;
+ my $wavefile = (find_wave($2))[0];
+ if ($wavefile ne "") {
+ Irssi::print("DCC sending $wavefile to $nick");
+ $server->command("/DCC SEND $nick $wavefile");
+ } else {
+ $server->send_message($nick, "Sorry, $nick. $2 not found.", 1);
+ }
+ return 1;
+}
+
+sub hilight_sound {
+ my ($dest, $text, $stripped) = @_;
+ my $server = $dest->{server};
+ unless ($server->{usermode_away}) {
+ my $hiwave = Irssi::settings_get_str('SOUND_hilight');
+ if (($hiwave ne '(none)') &&
+ ($dest->{level} & (MSGLEVEL_HILIGHT|MSGLEVEL_MSGS)) &&
+ ($dest->{level} & MSGLEVEL_NOHILIGHT) == 0) {
+ play_wave(find_wave($hiwave));}}}
+
+sub DCC_sound {
+ my $dcc = shift(@_);
+ my $server = $dcc->{server};
+ Irssi::print("$dcc->{type}");
+ unless ($server->{usermode_away} || ($dcc->{type} eq "SEND")) {
+ my $hiwave = Irssi::settings_get_str('SOUND_DCC');
+ if ($hiwave ne '(none)') {
+ play_wave(find_wave($hiwave));}}}
+
+sub play_wave {
+ my $wave = shift(@_);
+ my $sndcmd = Irssi::settings_get_str("SOUND_command");
+ if (-r "$wave") {
+ system("$sndcmd \"$wave\" &");}}
+
+sub sound_autoget {
+ if (!$autoget) { return 0; }
+ my $sounddir = Irssi::settings_get_str("SOUND_dir") . "/";
+
+ my $line = shift (@_);
+ #:nick!host PRIVMSG channel :message
+ $line =~ /:(.*)!(\S+) PRIVMSG (.*) :(.*)/i;
+
+ my $name = $1;
+ my $channel = $3;
+ my $text = $4;
+ my $name = "$name";
+ my @wordlist = split(' ',$4);
+
+ if ($wordlist[0] eq "\001SOUND") {
+ my $tempsound = $wordlist[1];
+ $tempsound =~ s/[\r \001 \n]//;
+ IRC::print($tempsound);
+ if (!open(TEMPFILE, "<", $sounddir.$tempsound)) {
+ IRC::send_raw("PRIVMSG $name :!$name $tempsound\r\n");
+ } else {
+ close(TEMPFILE);
+ }
+ }
+ return 0;
+}
+
+sub CTCP_sound {
+ my $play = Irssi::settings_get_bool("SOUND_play");
+ my $soundcmd = Irssi::settings_get_str("SOUND_command");
+
+ my ($server, $args, $nick, $addr, $target) = @_;
+ $args =~ /^SOUND (.*\.wav)(.*)$/i;
+ if ($1 eq "") { return 0; }
+
+ my $sound = $1;
+ my $wavfile = (find_wave($1))[0];
+ my $output = "";
+ my $rest = $2;
+ $rest =~ s/^ *//;
+ if ( $rest ne "" ) { # this one is for P&P & co.
+ $output = $output . $rest
+ } else {
+ $output = $output . " plays $sound";
+ }
+ if ($wavfile eq "") {
+ $output = $output . " (not found)";
+ if ($autoget) {
+ Irssi::send_raw("PRIVMSG $nick :!$nick $sound\r\n");
+ }
+ } else {
+ if ($play) {
+ system("$soundcmd \"$wavfile\" &");
+ } else {
+ $output = $output . " (muted)";
+ }
+ }
+ my $wItem = $server->window_find_item($target);
+ $wItem->printformat(MSGLEVEL_CTCPS, 'ctcp', $nick, $output);
+ Irssi::signal_stop();
+}
diff --git a/scripts/phpdoc.pl b/scripts/phpdoc.pl
new file mode 100644
index 0000000..79018d2
--- /dev/null
+++ b/scripts/phpdoc.pl
@@ -0,0 +1,134 @@
+# Copyright (C) March, 19th 2002 Author FoxMaSk <odemah@phpfr.org>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#Requirement : get the file funcsummary.txt from the CVS of http://php.net
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.0.6";
+%IRSSI = (
+ authors => 'Foxmask',
+ contact => 'odemah@phpfr.org ',
+ name => 'PhpDoc',
+ description => 'Display all functions of the famous language PHP which is used in the funcsummary.txt file in the CVS of http://php.net',
+ license => 'GNU GPL',
+ url => 'http://team.gcu-squad.org/~odemah/'
+);
+
+#PARMS
+
+#file name that contains all function list and definition
+my $doc_file = "$ENV{HOME}/phpdoc/funcsummary.txt";
+my $cmd_php = "!man";
+my @channel_php = ();
+$channel_php[0] = "#phpfr";
+$channel_php[1] = "#phpfrance";
+my $mirror_php = "http://phpnet.phpfr.org/manual/fr/";
+#==========================END OF PARMS======================================
+
+#init array
+my @doc = ();
+my $x = 0;
+
+#The main function
+sub doc_find {
+ my ($server, $msg, $nick, $address, $target) = @_;
+
+ my $keyword="";
+ my $def="";
+ my $cmd="";
+
+ #split the *action* and the rest of the line
+ ($cmd,$keyword) = split / /,$msg,2;
+
+ #to query
+ if (lc($cmd) eq $cmd_php and (lc($target) eq $channel_php[0] or lc($target) eq $channel_php[1]) ) {
+ if ($keyword eq '') {
+ if ( $server->channel_find($target)->nick_find($nick)->{voice} or $server->channel_find($target)->nick_find($nick)->{op} ) {
+ $server->command("/msg -$server->{tag} $target $cmd_php: \002$cmd_php <function>\002 example $cmd_php mysql_connect");
+ } else {
+ $server->command("/msg $nick $cmd_php: \002$cmd_php <function>\002 example $cmd_php mysql_connect");
+ }
+ }
+ else {
+ for ($x=0;$x < @doc;$x++) {
+ #ignore comment
+ if ( $doc[$x] =~ /^(object|unknown|mixed|class|resource|void|bool|array|string|int) $keyword/) {
+ $def = $doc[$x];
+ chomp($def);
+ $def =~ s/\s+/ /g;
+ $keyword =~ s/_/-/g ;
+ $def .= ". More Details on ".$mirror_php ."function.".$keyword.".php";
+ last;
+ }
+ }
+
+ if ( $def ne '' ) {
+ $keyword =~ s/-/_/g ;
+ #if the user is voice or op ; display the description in the channel
+ if ( $server->channel_find($target)->nick_find($nick)->{voice} or $server->channel_find($target)->nick_find($nick)->{op} ) {
+ $server->command("/msg -$server->{tag} $target $def");
+ }
+ #else display it to the $nick only
+ else {
+ $server->command("/msg $nick \002$keyword\002=$def");
+ }
+ }
+ #definition not found ; so we tell it to $nick
+ else {
+ $server->command("/msg $nick $keyword does not exist");
+ Irssi::signal_stop();
+ }
+ }
+ }
+}
+
+
+#load datas from funcsummary.txt file
+sub load_doc {
+ my $doc_line="";
+ if (-e $doc_file) {
+ @doc = ();
+ Irssi::print("Loading doc from $doc_file");
+ local *DOC;
+ open(DOC,"$doc_file");
+ local $/ = "\n";
+ while (<DOC>) {
+ chomp();
+ #ignore comment and get all lines beginning with ... :
+ if ( /^(object|unknown|mixed|class|resource|void|bool|array|string|int)/) {
+ #getting the line description
+ $doc_line = $_;
+ chomp($doc_line);
+ #getting the line definition
+ $doc_line .= <DOC>;
+ chomp($doc_line);
+ push(@doc,$doc_line);
+ }
+ }
+ close DOC;
+ Irssi::print("Loaded " . scalar(@doc) . " record(s)");
+ } else {
+ Irssi::print("Cannot load $doc_file");
+ }
+}
+
+load_doc();
+
+Irssi::signal_add_last('message public', 'doc_find');
+Irssi::print("Php Doc Management $VERSION loaded!");
+
diff --git a/scripts/poison.pl b/scripts/poison.pl
new file mode 100644
index 0000000..f04da33
--- /dev/null
+++ b/scripts/poison.pl
@@ -0,0 +1,341 @@
+# by Stefan 'tommie' Tomanek
+#
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "2003020801";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "Poison",
+ description => "equips Irssi with an interface to giFT",
+ license => "GPLv2",
+ changed => "$VERSION",
+ modules => "IO::Socket::INET Data::Dumper",
+ commands => "poison"
+);
+
+use vars qw($forked %ids);
+use IO::Socket::INET;
+use Data::Dumper;
+use Irssi;
+use POSIX;
+
+sub show_help() {
+ my $help = $IRSSI{name}." $VERSION
+/poison
+ List current downloads
+/poison search <query>
+ Search for files on the network
+";
+ my $text = '';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP &draw_box($IRSSI{name}, $text, "help", 1);
+}
+
+sub giftconnect {
+ my $host = Irssi::settings_get_str('poison_host');
+ my $port = Irssi::settings_get_int('poison_port');
+ my $sock = IO::Socket::INET->new(PeerAddr => $host,
+ PeerPort => $port,
+ Proto => 'tcp');
+ return $sock;
+}
+
+sub draw_box ($$$$) { my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ unless ($colour) {
+ $box =~ s/%(.)/$1 eq '%'?$1:''/eg;
+ }
+ return $box;
+}
+
+sub round ($$) {
+ return $_[0] unless Irssi::settings_get_bool('poison_round_filesize');
+ if ($_[1] > 100000) {
+ return sprintf "%.2fMB", $_[0]/1024/1024;
+ } else {
+ return sprintf "%.2fKB", $_[0]/1024;
+ }
+}
+
+sub array2table {
+ my (@array) = @_;
+ my @width;
+ foreach my $line (@array) {
+ for (0..scalar(@$line)-1) {
+ my $l = $line->[$_];
+ $l =~ s/%[^%]//g;
+ $l =~ s/%%/%/g;
+ $width[$_] = length($l) if $width[$_]<length($l);
+ }
+ }
+ my $text;
+ foreach my $line (@array) {
+ for (0..scalar(@$line)-1) {
+ my $l = $line->[$_];
+ $text .= $line->[$_];
+ $l =~ s/%[^%]//g;
+ $l =~ s/%%/%/g;
+ $text .= " "x($width[$_]-length($l)+1) unless ($_ == scalar(@$line)-1);
+ }
+ $text .= "\n";
+ }
+ return $text;
+}
+
+sub bg_do ($$) {
+ my ($id, $sub) = @_;
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ return if $forked;
+ $forked = 1;
+ my $pid = fork();
+ if ($pid > 0) {
+ close $wh;
+ Irssi::pidwait_add($pid);
+ my $pipetag;
+ my @args = ($rh, \$pipetag); $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
+ } else {
+ eval {
+ my $result;
+ $result->{$id} = &$sub();
+ my $dumper = Data::Dumper->new([$result]);
+ $dumper->Purity(1)->Deepcopy(1);
+ my $data = $dumper->Dump;
+ print($wh $data);
+ close($wh);
+ };
+ POSIX::_exit(1);
+ }
+}
+
+sub pipe_input ($) {
+ my ($rh, $pipetag) = @{$_[0]};
+ my $text;
+ $text .= $_ foreach (<$rh>);
+ close($rh);
+ Irssi::input_remove($$pipetag);
+ $forked = 0;
+ return unless($text);
+ no strict;
+ my $result = eval "$text";
+ return unless ref $result;
+ print_results($result->{search}) if defined $result->{search};
+ print CLIENTCRAP '%R>>%n Added '.$result->{sources}.' source(s) for download' if defined $result->{sources};
+}
+
+sub search_file ($) {
+ my ($query) = @_;
+ my $sock = giftconnect();
+ return unless $sock;
+ $sock->print("SEARCH query(".$query.");\n");
+ my %results;
+ my %item;
+ my $meta = 0;
+ while ($_ = $sock->getline()) {
+ if ((not $meta) && / *(.*?)\((.*?)\)[^;]/) {
+ my ($key, $value) = ($1, $2);
+ $value =~ s/\\(.)/$1/g;
+ $item{$key} = $value;
+ } elsif (/META/) {
+ $meta = 1;
+ } elsif (/ITEM;/) {
+ $sock->close();
+ last;
+ } elsif (/;/) {
+ $meta = 0;
+ my %foo = %item;
+ %item = ();
+ $results{$foo{hash}} = \%foo;
+ }
+ }
+ return \%results;
+}
+
+sub get_file ($) {
+ my ($id) = @_;
+ return unless $ids{$id};
+ my $data = $ids{$id};
+ add_source($data);
+ bg_do('sources', sub { retrieve_sources($data->{hash}) } );
+}
+
+sub retrieve_sources ($) {
+ my ($hash) = @_;
+ my %sources;
+ foreach (@{ find_sources($hash) }) {
+ add_source($_);
+ $sources{$_->{user}} = 1;
+ }
+ return scalar keys %sources;
+}
+
+sub add_source (\%) {
+ my ($data) = @_;
+ my $sock = giftconnect();
+ return unless $sock;
+ my @bar = split('/', $data->{url});
+ my $file = $bar[-1];
+
+ my $line = "ADDSOURCE ";
+ $line .= "user(".$data->{user}.") ";
+ $line .= "hash(".$data->{hash}.") ";
+ $line .= "size(".$data->{size}.") ";
+ $line .= "url(".$data->{url}.") ";
+ $line .= "save(".$file.");";
+ $sock->print($line."\n");
+ $sock->close();
+}
+
+sub find_sources ($) {
+ my ($hash) = @_;
+ my $sock = giftconnect();
+ return unless $sock;
+ $sock->print("LOCATE query(".$hash.");\n");
+ my %item;
+ my @sources;
+ my $meta = 0;
+ while ($_ = $sock->getline()) {
+ if ((not $meta) && (/ *(.*?)\((.*?)\)[^;]/)) {
+ my ($key, $value) = ($1, $2);
+ #print $key." => ".$value;
+ $value =~ s/\\(.)/$1/g;
+ $item{$key} = $value;
+ } elsif (/META/) {
+ $meta = 1;
+ } elsif (/ITEM;/) {
+ $sock->close();
+ last;
+ } elsif (/;/) {
+ $meta = 0;
+ my %foo = %item;
+ %item = ();
+ push @sources, \%foo;
+ }
+ }
+ return \@sources;
+}
+
+sub get_downloads {
+ my %downloads;
+ my $sock = giftconnect();
+ return unless $sock;
+ $sock->print("ATTACH client(".$IRSSI{name}.") version(".$VERSION."); DETACH;");
+ my %downloads;
+ my ($add, $source) = (0,0);
+ my %item;
+ while ($_ = $sock->getline()) {
+ if (/^DOWNLOAD_ADD\((\d+)\)/) {
+ $add = 1;
+ $item{sessionid} = $1;
+ } elsif (/SOURCE/) {
+ $source = 1;
+ } elsif (/};/) {
+ $source = 0;
+ $add = 0;
+ my %foo = %item;
+ $downloads{$foo{file}} = \%foo;
+ } else {
+ if (($add && not $source) && /^ (.*?)\((.*?)\)$/) {
+ my ($key, $value) = ($1, $2);
+ $value =~ s/\\(.)/$1/g;
+ $item{$key} = $value;
+ }
+ }
+ }
+ return \%downloads;
+}
+
+sub print_results ($) {
+ my ($results) = @_;
+ my @array;
+ %ids = ();
+ my $i = 1;
+ foreach (sort {uc($a) cmp uc($b)} keys %$results) {
+ my @bar = split('/', $results->{$_}{url});
+ my $file = $bar[-1];
+ $file =~ s/%20/ /g;
+ $file =~ s/%/%%/g;
+ my @line;
+ push @line, "%9".$i."%9";
+ push @line, "%9".$file."%9";
+ push @line, $results->{$_}{size};
+ push @line, $results->{$_}{availability};
+ push @array, \@line;
+ $ids{$i} = $results->{$_};
+ $i++;
+ }
+ my $text = array2table(@array);
+ print CLIENTCRAP draw_box("Poison", $text, "Results", 1) if $text;
+}
+
+sub print_downloads ($) {
+ my ($downloads) = @_;
+ my $text;
+ foreach (sort {uc($a) cmp uc($b)} keys %$downloads) {
+ if ($downloads->{$_}{state} eq 'Active') {
+ $text .= '%bo%n';
+ } elsif ($downloads->{$_}{state} eq 'Paused') {
+ $text .= '%yo%n';
+ }
+ my $percent = $downloads->{$_}{size} > 0 ? ($downloads->{$_}{transmit} / $downloads->{$_}{size}) * 100 : 0;
+ my $file = $_;
+ $file =~ s/%20/ /g;
+ $file =~ s/%/%%/g;
+ $text .= " %9".$file."%9";
+ $text .= "\n";
+ $text .= ' ';
+ $text .= round($downloads->{$_}{transmit}, $downloads->{$_}{size}).'/';
+ $text .= round($downloads->{$_}{size}, $downloads->{$_}{size});
+ $percent =~ s/(\..).*/$1/g;
+ $text .= " (".$percent."%%)";
+ $text .= "\n"
+ }
+ print CLIENTCRAP draw_box("Poison", $text, "Downloads", 1);
+}
+
+
+
+sub cmd_poison ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @args = split(/ /, $args);
+ if (@args == 0) {
+ print_downloads(get_downloads());
+ } elsif ($args[0] eq 'search') {
+ shift @args;
+ if ($forked) {
+ print CLIENTCRAP '%R>>%n Already searching...';
+ } else {
+ print CLIENTCRAP '%R>>%n Search in progress...';
+ }
+ bg_do 'search', sub { search_file(join(' ', @args)) };
+ #print_results search_file(join(' ', @args));
+ } elsif ($args[0] eq 'get' && $args[1]) {
+ get_file($args[1]);
+ } elsif ($args[0] eq 'help') {
+ show_help();
+ }
+}
+
+Irssi::settings_add_str('poison', 'poison_host', 'localhost');
+Irssi::settings_add_int('poison', 'poison_port', 1213);
+Irssi::settings_add_bool('poison', 'poison_round_filesize', 1);
+
+Irssi::command_bind('poison', \&cmd_poison);
+
+foreach my $cmd ('help', 'search', 'get') {
+ Irssi::command_bind('poison '.$cmd => sub {
+ cmd_poison("$cmd ".$_[0], $_[1], $_[2]); });
+}
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded, /poison help';
+
diff --git a/scripts/postpone.pl b/scripts/postpone.pl
new file mode 100644
index 0000000..11011f2
--- /dev/null
+++ b/scripts/postpone.pl
@@ -0,0 +1,119 @@
+# by Stefan 'tommie' Tomanek <stefan@pico.ruhr.de>
+#
+#
+
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "20170204";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "postpone",
+ description => "Postpones messages sent to a splitted user and resends them when the nick rejoins",
+ license => "GPLv2",
+ changed => "$VERSION",
+ commands => "postpone"
+);
+
+use Irssi 20020324;
+use vars qw(%messages);
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub show_help() {
+ my $help="Postpone $VERSION
+/postpone help
+ Display this help
+/postpone flush <nick>
+ Flush postponed messages to <nick>
+/postpone discard <nick>
+ Discard postponed messages to <nick>
+/postpone list
+ List postponed messages
+";
+ my $text = '';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP &draw_box("Postpone", $text, "help", 1);
+}
+
+
+sub event_send_text ($$$) {
+ my ($line, $server, $witem) = @_;
+ return unless ($witem && $witem->{type} eq "CHANNEL");
+ if ($line =~ /^(\w+?): (.*)$/) {
+ my ($target, $msg) = ($1,$2);
+ if ($witem->nick_find($target)) {
+ # Just leave me alone
+ return;
+ } else {
+ $witem->print("%B>>%n %U".$target."%U is not here, message has been postponed: \"".$line."\"", MSGLEVEL_CLIENTCRAP);
+ push @{$messages{$server->{tag}}{$witem->{name}}{$target}}, $line;
+ Irssi::signal_stop();
+ }
+ }
+}
+
+sub event_message_join ($$$$) {
+ my ($server, $channel, $nick, $address) = @_;
+ return unless (defined $messages{$server->{tag}});
+ return unless (defined $messages{$server->{tag}}{$channel});
+ return unless (defined $messages{$server->{tag}}{$channel}{$nick});
+ return unless (scalar(@{$messages{$server->{tag}}{$channel}{$nick}}) > 0);
+ my $chan = $server->channel_find($channel);
+ $chan->print("%B>>%n Sending postponed messages for ".$nick, MSGLEVEL_CLIENTCRAP);
+ while (scalar(@{$messages{$server->{tag}}{$channel}{$nick}}) > 0) {
+ my $msg = pop @{$messages{$server->{tag}}{$channel}{$nick}};
+ $server->command('MSG '.$channel.' '.$msg);
+ }
+
+}
+
+sub cmd_postpone ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @arg = split(/ /, $args);
+ if (scalar(@arg) < 1) {
+ #foo
+ } elsif (($arg[0] eq 'discard' || $arg[0] eq 'flush') && defined $arg[1]) {
+ return unless ($witem && $witem->{type} eq "CHANNEL");
+ while (scalar(@{$messages{$server->{tag}}{$witem->{name}}{$arg[1]}}) > 0) {
+ my $msg = pop @{$messages{$server->{tag}}{$witem->{name}}{$arg[1]}};
+ $server->command('MSG '.$witem->{name}.' '.$msg) if $arg[0] eq 'flush';
+ }
+ } elsif ($arg[0] eq 'list') {
+ my $text;
+ foreach (keys %messages) {
+ $text .= $_."\n";
+ foreach my $channel (keys %{$messages{$_}}) {
+ $text .= " %U".$channel."%U \n";
+ foreach my $nick (sort keys %{$messages{$_}{$channel}}) {
+ $text .= ' |'.$_."\n" foreach @{$messages{$_}{$channel}{$nick}};
+ }
+ }
+ }
+ print CLIENTCRAP &draw_box('Postpone', $text, 'messages', 1);
+ } elsif ($arg[0] eq 'help') {
+ show_help();
+ }
+}
+
+Irssi::command_bind('postpone', \&cmd_postpone);
+
+Irssi::signal_add('send text', \&event_send_text);
+Irssi::signal_add('message join', \&event_message_join);
+
+print CLIENTCRAP "%B>>%n Postpone ".$VERSION." loaded: /postpone help for help";
+
diff --git a/scripts/ppl.pl b/scripts/ppl.pl
new file mode 100644
index 0000000..a3d8e5b
--- /dev/null
+++ b/scripts/ppl.pl
@@ -0,0 +1,210 @@
+# Copyright 2001 by Maciek Freudenheim <fahren@bochnia.pl>
+# /thanks to elluin & lemur/
+# Copyright 2002 by Marco d'Itri <md@linux.it>
+#
+# You can use this software under the terms of the GNU General Public License.
+
+# ppl.pl for Irssi (port of asmodean's /ppl command from skuld3)
+#
+# Usage: /ppl [-o -v -i | -l] [-g | -h] [-p <n!u@h>] [-m <*ircserver*>]
+# [-N | -H | -M | -D]
+# To list ops | voices | normal | ircops
+# To list away / unaway people, and
+# To list people matching n!u@h or using server matching *ircserver*
+# Multiple options can be combined
+
+use Irssi;
+use POSIX qw(strftime);
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '20020128';
+%IRSSI = (
+ authors => 'Maciek Freudenheim, Marco d\'Itri',
+ contact => 'fahren@bochnia.pl, md@linux.it',
+ name => 'ppl',
+ description => 'port of asmodean\'s /ppl command from skuld3',
+ license => 'GPL v2',
+ url => 'http://www.linux.it/~md/irssi/',
+);
+
+my $ServerRewrite = '\.openprojects\.net$';
+my $At_Pos = 30;
+
+Irssi::theme_register([
+# 0 mode, 1 nick, 2 filler1, 3 user, 4 host, 5 filler2, 6 server, 7 hops
+ 'ppl_line' => '%W$0%n$1%K$2%n$3%B@%n$4%K$5%n$6%C$7%n',
+ 'ppl_end' => '%y>>%n $0 - matched %_$1%_ users '
+ . '(*=%_$2%_ -o=%_$3%_ +v=%_$4%_ +o=%_$5%_)'
+]);
+
+Irssi::command_bind('ppl' => 'cmd_ppl');
+Irssi::signal_add('redir ppl_line' => 'red_ppl_line');
+Irssi::signal_add('redir ppl_end' => 'red_ppl_end');
+
+my @users;
+my %ppl;
+
+sub cmd_ppl {
+ my ($pars, $server, $winit) = @_;
+
+ if (not $winit or $winit->{type} ne 'CHANNEL') {
+ Irssi::print('%R>>>%n You have to join channel first :\\',
+ MSGLEVEL_CRAP);
+ return;
+ }
+
+ $ppl{o} = $ppl{v} = $ppl{l} = $ppl{m} = $ppl{i} = 0;
+
+ my $ppl = '';
+ my @data = split(/ /, $pars);
+ while ($_ = shift(@data)) {
+ /^-N$/ and $ppl{SORT} = 'nick', next;
+ /^-H$/ and $ppl{SORT} = 'host', next;
+ /^-M$/ and $ppl{SORT} = 'mode', next;
+ /^-D$/ and $ppl{SORT} = 'distance', next;
+ /^-o$/ and $ppl{show_o} = 1, next;
+ /^-i$/ and $ppl{show_i} = 1, next;
+ /^-v$/ and $ppl{show_v} = 1, next;
+ /^-l$/ and $ppl{show_l} = 1, next;
+ /^-g$/ and $ppl{only_G} = 1, next;
+ /^-h$/ and $ppl{only_H} = 1, next;
+ /^-s$/ and $ppl{s} = shift(@data), next;
+ /^-p$/ and $ppl{h} = shift(@data), next;
+ Irssi::print("Unknown option: $_");
+ return;
+ }
+
+ $ppl{show_o} = $ppl{show_i} = $ppl{show_v} = $ppl{show_l} = 1
+ unless exists $ppl{show_o} or exists $ppl{show_i}
+ or exists $ppl{show_v} or exists $ppl{show_l};
+
+ $ppl{w} = Irssi::active_win()->{width};
+ $ppl{c} = $winit->{name};
+
+ if (Irssi::settings_get_bool('timestamps')) {
+ my $ts_for = Irssi::settings_get_str('timestamp_format');
+ $ppl{w} -= (length(strftime($ts_for, localtime)) + 1);
+ }
+
+ $server->redirect_event('who', 1, $ppl{c}, 0, undef, {
+ 'event 315' => 'redir ppl_end',
+ 'event 352' => 'redir ppl_line',
+ });
+ $server->send_raw("WHO :$ppl{c}");
+}
+
+sub red_ppl_line {
+ my ($s, $data) = @_;
+
+ my (undef, undef, $user, $host, $server, $nick, $mode, $hops)
+ = split(/ /, $data);
+
+ return if $mode =~ /^G/ and $ppl{only_H};
+ return if $mode =~ /^H/ and $ppl{only_G};
+
+ if ($ppl{h}) {
+ return unless $s->mask_match($ppl{h}, $nick, $user, $host);
+ }
+ if ($ppl{s}) {
+ return unless $server =~ /$ppl{s}/;
+ }
+
+ if ($mode =~ /\*/) {
+ return unless $ppl{show_i};
+ $ppl{i}++;
+ }
+ if ($mode =~ /@/) {
+ return unless $ppl{show_o};
+ $ppl{o}++;
+ } elsif ($mode =~ /\+/) {
+ return unless $ppl{show_v};
+ $ppl{v}++;
+ } else {
+ return unless $ppl{show_l};
+ $ppl{l}++;
+ }
+ $ppl{m}++;
+
+ $mode = sprintf('%-2.2s', $mode);
+ if (length($nick) + length($user) > $At_Pos - 4) {
+ $user = substr($user, 0, 11);
+ $nick = substr($nick, 0, $At_Pos - 4 - length $user);
+ }
+ $server =~ s/$ServerRewrite//o if $ServerRewrite;
+ if (length($host) + length($server) > $ppl{w} - $At_Pos - 2) {
+ $host = substr($host, 0, $ppl{w} - $At_Pos - 2);
+ my $len = $ppl{w} - $At_Pos - 3 - length($host);
+ $server = substr($server, 0, $len > 0 ? $len : 0);
+ }
+ my $filler1 = '.' x ($At_Pos - 3 - length($nick) - length($user));
+ my $filler2 = '.' x ($ppl{w} - $At_Pos - 2
+ - length($host) - length($server));
+ $hops =~ s/^://;
+
+ if ($ppl{SORT}) {
+ push(@users,
+ [$mode, $nick, $filler1, $user, $host, $filler2, $server, $hops]);
+ } else {
+ $s->printformat($ppl{c}, MSGLEVEL_CLIENTCRAP, 'ppl_line',
+ $mode, $nick, $filler1, $user, $host, $filler2, $server, $hops);
+ }
+}
+
+sub red_ppl_end {
+ my ($server, $data) = @_;
+
+ if ($ppl{SORT}) {
+ if ($ppl{SORT} eq 'host') {
+ @users = sort sort_domain @users;
+ } elsif ($ppl{SORT} eq 'mode') {
+ @users = sort sort_mode @users;
+ } elsif ($ppl{SORT} eq 'nick') {
+ @users = sort { lc $a->[1] cmp lc $b->[1] } @users;
+ } elsif ($ppl{SORT} eq 'distance') {
+ @users = sort { lc $a->[7] cmp lc $b->[7] } @users;
+ }
+
+ foreach (@users) {
+ $server->printformat($ppl{c}, MSGLEVEL_CLIENTCRAP, 'ppl_line', @$_);
+ }
+ undef @users;
+ }
+ $server->printformat($ppl{c}, MSGLEVEL_CLIENTCRAP, 'ppl_end',
+ $ppl{c}, $ppl{m}, $ppl{i}, $ppl{l}, $ppl{v}, $ppl{o});
+ undef %ppl;
+}
+
+sub sort_domain {
+ my @doma = split(/\./, lc $a->[4]);
+ my @domb = split(/\./, lc $b->[4]);
+
+ # sort IP addresses
+ if ($doma[$#doma] =~ /^\d+$/ and $domb[$#domb] =~ /^\d+$/) {
+ return $doma[0] <=> $domb[0] || $doma[1] <=> $domb[1]
+ || $doma[2] <=> $domb[2] || $doma[3] <=> $domb[3];
+ }
+
+ $doma[$#doma] cmp $domb[$#domb]
+ ||
+ $doma[$#doma - 1] cmp $domb[$#domb - 1]
+ ||
+ $doma[$#doma - 2] cmp $domb[$#domb - 2]
+}
+
+sub sort_mode {
+ return; # FIXME unfinished
+ my ($sa, $ma) = split(//, $a->[0]);
+ my ($sb, $mb) = split(//, $b->[0]);
+
+# Irssi::print("=== <$sa> <$ma>");
+
+# if ($sa eq $sb) {
+# return ?
+# }
+ return -1 if $sa eq 'G';
+ return 1 if $sb eq 'G';
+}
+
+# vim: set tabstop=4
diff --git a/scripts/print_signals.pl b/scripts/print_signals.pl
new file mode 100644
index 0000000..5891387
--- /dev/null
+++ b/scripts/print_signals.pl
@@ -0,0 +1,319 @@
+# print_signals.pl — Irssi script to help with inspecting signals
+#
+# © 2017,2021 martin f. krafft <madduck@madduck.net>
+# Released under the MIT licence.
+#
+### Usage:
+#
+# /script load print_signals
+#
+# and then use e.g. tail -F /tmp/irssi_signals.log outside of irssi.
+#
+### Settings:
+#
+# /set print_signals_to_file ["/tmp/irssi_signals.log"]
+# Set the file to which to log all signals and their data
+#
+# /set print_signals_limit_regexp [""]
+# Specify a regexp to limit the signals being captured, e.g. "^window".
+# Default is no limit.
+#
+# # Please note that exclude takes precedence over limit:
+#
+# /set print_signals_exclude_regexp ["print text|key press|textbuffer"]
+# Specify a regexp to exclude signals from being captured. Default is not to
+# fire on signals about printing text or key presses.
+#
+### Changelog:
+#
+# 2021-11-04 v1.2
+# * Omit signals that cannot be enumerated
+#
+# 2021-09-20 v1.1
+# * Unload signal handlers when script is unloaded
+# * Update list of signals from upstream
+#
+# 2017-02-03 v1.0
+#
+# * Initial release.
+#
+
+use strict;
+use warnings;
+use vars qw($VERSION %IRSSI);
+use Irssi;
+use Data::Dumper;
+
+$VERSION = '1.2';
+
+%IRSSI = (
+ authors => 'martin f. krafft',
+ contact => 'madduck@madduck.net',
+ name => 'print signals debugger',
+ description => 'hooks into almost every signal and writes the information provided to a file',
+ license => 'MIT',
+ changed => '2021-11-04'
+);
+
+Irssi::settings_add_str('print_signals', 'print_signals_to_file', '/tmp/irssi_signals.log');
+Irssi::settings_add_str('print_signals', 'print_signals_limit_regexp', '');
+Irssi::settings_add_str('print_signals', 'print_signals_exclude_regexp',
+ 'print text|key press|textbuffer|rawlog|log written');
+
+$Data::Dumper::Sortkeys = 1;
+$Data::Dumper::Pad = ' ';
+
+sub signal_handler {
+ my $signal = shift(@_);
+ my $limitre = Irssi::settings_get_str('print_signals_limit_regexp');
+ return unless $signal =~ qr/$limitre/;
+ my $excludere = Irssi::settings_get_str('print_signals_exclude_regexp');
+ return if $signal =~ qr/$excludere/;
+ my @names = shift(@_);
+ my @data = shift(@_);
+ my $outfile = Irssi::settings_get_str('print_signals_to_file');
+ my $fh;
+ if (!open($fh, '>>', $outfile)) {
+ Irssi::print("cannot append to log file $outfile while handling signal '$signal'");
+ return;
+ };
+ print $fh "\n== $signal ==\n";
+ print $fh Data::Dumper->Dump(@data, @names);
+ close($fh);
+}
+
+# TODO: a programmatic way to extract the list of all signals from Irssi
+# itself, along with descriptive names of the arguments.
+# curl -s https://raw.githubusercontent.com/irssi/irssi/master/docs/signals.txt | sed -rne 's,^ ",",p'
+my $signals = <<_END;
+"gui exit"
+"gui dialog", char *type, char *text
+"send command", char *command, SERVER_REC, WI_ITEM_REC
+"chat protocol created", CHAT_PROTOCOL_REC
+"chat protocol updated", CHAT_PROTOCOL_REC
+"chat protocol destroyed", CHAT_PROTOCOL_REC
+"channel created", CHANNEL_REC, int automatic
+"channel destroyed", CHANNEL_REC
+"chatnet created", CHATNET_REC
+"chatnet destroyed", CHATNET_REC
+"commandlist new", COMMAND_REC
+"commandlist remove", COMMAND_REC
+"error command", int err, char *cmd
+"send command", char *args, SERVER_REC, WI_ITEM_REC
+"send text", char *line, SERVER_REC, WI_ITEM_REC
+"command "<cmd>, char *args, SERVER_REC, WI_ITEM_REC
+"default command", char *args, SERVER_REC, WI_ITEM_REC
+"ignore created", IGNORE_REC
+"ignore destroyed", IGNORE_REC
+"ignore changed", IGNORE_REC
+"log new", LOG_REC
+"log remove", LOG_REC
+"log create failed", LOG_REC
+"log locked", LOG_REC
+"log started", LOG_REC
+"log stopped", LOG_REC
+"log rotated", LOG_REC
+"log written", LOG_REC, char *line
+"module loaded", MODULE_REC, MODULE_FILE_REC
+"module unloaded", MODULE_REC, MODULE_FILE_REC
+"module error", int error, char *text, char *rootmodule, char *submodule
+"tls handshake finished", SERVER_REC, TLS_REC
+"nicklist new", CHANNEL_REC, NICK_REC
+"nicklist remove", CHANNEL_REC, NICK_REC
+"nicklist changed", CHANNEL_REC, NICK_REC, char *old_nick
+"nicklist host changed", CHANNEL_REC, NICK_REC
+"nicklist account changed", CHANNEL_REC, NICK_REC, char *account
+"nicklist gone changed", CHANNEL_REC, NICK_REC
+"nicklist serverop changed", CHANNEL_REC, NICK_REC
+"pidwait", int pid, int status
+"query created", QUERY_REC, int automatic
+"query destroyed", QUERY_REC
+"query nick changed", QUERY_REC, char *orignick
+"window item name changed", WI_ITEM_REC
+"query address changed", QUERY_REC
+"query server changed", QUERY_REC, SERVER_REC
+"rawlog", RAWLOG_REC, char *data
+"server looking", SERVER_REC
+"server connected", SERVER_REC
+"server connecting", SERVER_REC, ulong *ip
+"server connect failed", SERVER_REC
+"server disconnected", SERVER_REC
+"server quit", SERVER_REC, char *msg
+"server sendmsg", SERVER_REC, char *target, char *msg, int target_type
+"setup changed"
+"setup reread", char *fname
+"setup saved", char *fname, int autosaved
+"ban type changed", char *bantype
+"channel joined", CHANNEL_REC
+"channel wholist", CHANNEL_REC
+"channel sync", CHANNEL_REC
+"channel topic changed", CHANNEL_REC
+"ctcp msg", SERVER_REC, char *args, char *nick, char *addr, char *target
+"ctcp msg "<cmd>, SERVER_REC, char *args, char *nick, char *addr, char *target
+"default ctcp msg", SERVER_REC, char *args, char *nick, char *addr, char *target
+"ctcp reply", SERVER_REC, char *args, char *nick, char *addr, char *target
+"ctcp reply "<cmd>, SERVER_REC, char *args, char *nick, char *addr, char *target
+"default ctcp reply", SERVER_REC, char *args, char *nick, char *addr, char *target
+"ctcp action", SERVER_REC, char *args, char *nick, char *addr, char *target
+"awaylog show", LOG_REC, int away_msgs, int filepos
+"server nick changed", SERVER_REC
+"event connected", SERVER_REC
+"server cap ack "<cmd>, SERVER_REC
+"server cap nak "<cmd>, SERVER_REC
+"server cap new "<cmd>, SERVER_REC
+"server cap delete "<cmd>, SERVER_REC
+"server cap end", SERVER_REC
+"server cap req", SERVER_REC, char *caps
+"server sasl failure", SERVER_REC, char *reason
+"server sasl success", SERVER_REC
+"server event", SERVER_REC, char *data, char *sender_nick, char *sender_address
+"server event tags", SERVER_REC, char *data, char *sender_nick, char *sender_address, char *tags
+"event "<cmd>, SERVER_REC, char *args, char *sender_nick, char *sender_address
+"default event", SERVER_REC, char *data, char *sender_nick, char *sender_address
+"whois default event", SERVER_REC, char *args, char *sender_nick, char *sender_address
+"server incoming", SERVER_REC, char *data
+"redir "<cmd>, SERVER_REC, char *args, char *sender_nick, char *sender_address
+"server lag", SERVER_REC
+"server lag disconnect", SERVER_REC
+"massjoin", CHANNEL_REC, GSList of NICK_RECs
+"ban new", CHANNEL_REC, BAN_REC
+"ban remove", CHANNEL_REC, BAN_REC, char *setby
+"channel mode changed", CHANNEL_REC, char *setby
+"nick mode changed", CHANNEL_REC, NICK_REC, char *setby, char *mode, char *type
+"user mode changed", SERVER_REC, char *old
+"away mode changed", SERVER_REC
+"netsplit server new", SERVER_REC, NETSPLIT_SERVER_REC
+"netsplit server remove", SERVER_REC, NETSPLIT_SERVER_REC
+"netsplit new", NETSPLIT_REC
+"netsplit remove", NETSPLIT_REC
+"dcc ctcp "<cmd>, char *args, DCC_REC
+"default dcc ctcp", char *args, DCC_REC
+"dcc unknown ctcp", char *args, char *sender, char *sendaddr
+"dcc reply "<cmd>, char *args, DCC_REC
+"default dcc reply", char *args, DCC_REC
+"dcc unknown reply", char *args, char *sender, char *sendaddr
+"dcc chat message", DCC_REC, char *msg
+"dcc created", DCC_REC
+"dcc destroyed", DCC_REC
+"dcc connected", DCC_REC
+"dcc rejecting", DCC_REC
+"dcc closed", DCC_REC
+"dcc request", DCC_REC, char *sendaddr
+"dcc request send", DCC_REC
+"dcc chat message", DCC_REC, char *msg
+"dcc transfer update", DCC_REC
+"dcc get receive", DCC_REC
+"dcc error connect", DCC_REC
+"dcc error file create", DCC_REC, char *filename
+"dcc error file open", char *nick, char *filename, int errno
+"dcc error get not found", char *nick
+"dcc error send exists", char *nick, char *filename
+"dcc error unknown type", char *type
+"dcc error close not found", char *type, char *nick, char *filename
+"autoignore new", SERVER_REC, AUTOIGNORE_REC
+"autoignore remove", SERVER_REC, AUTOIGNORE_REC
+"flood", SERVER_REC, char *nick, char *host, int level, char *target
+"notifylist new", NOTIFYLIST_REC
+"notifylist remove", NOTIFYLIST_REC
+"notifylist joined", SERVER_REC, char *nick, char *user, char *host, char *realname, char *awaymsg
+"notifylist away changed", SERVER_REC, char *nick, char *user, char *host, char *realname, char *awaymsg
+"notifylist left", SERVER_REC, char *nick, char *user, char *host, char *realname, char *awaymsg
+"proxy client connecting", CLIENT_REC
+"proxy client connected", CLIENT_REC
+"proxy client disconnected", CLIENT_REC
+"proxy client command", CLIENT_REC, char *args, char *data
+"proxy client dump", CLIENT_REC, char *data
+"gui print text", WINDOW_REC, int fg, int bg, int flags, char *text, TEXT_DEST_REC
+"gui print text finished", WINDOW_REC, TEXT_DEST_REC
+"complete word", GList * of char *s, WINDOW_REC, char *word, char *linestart, int *want_space
+"irssi init read settings"
+"exec new", PROCESS_REC
+"exec remove", PROCESS_REC, int status
+"exec input", PROCESS_REC, char *text
+"message public", SERVER_REC, char *msg, char *nick, char *address, char *target
+"message private", SERVER_REC, char *msg, char *nick, char *address, char *target
+"message own_public", SERVER_REC, char *msg, char *target
+"message own_private", SERVER_REC, char *msg, char *target, char *orig_target
+"message join", SERVER_REC, char *channel, char *nick, char *address, char *account, char *realname
+"message part", SERVER_REC, char *channel, char *nick, char *address, char *reason
+"message quit", SERVER_REC, char *nick, char *address, char *reason
+"message kick", SERVER_REC, char *channel, char *nick, char *kicker, char *address, char *reason
+"message nick", SERVER_REC, char *newnick, char *oldnick, char *address
+"message own_nick", SERVER_REC, char *newnick, char *oldnick, char *address
+"message invite", SERVER_REC, char *channel, char *nick, char *address
+"message invite_other", SERVER_REC, char *channel, char *invited, char *nick, char *address
+"message topic", SERVER_REC, char *channel, char *topic, char *nick, char *address
+"message host_changed", SERVER_REC, char *nick, char *newaddress, char *oldaddress
+"message account_changed", SERVER_REC, char *nick, char *address, char *account
+"message away_notify", SERVER_REC, char *nick, char *address, char *awaymsg
+"keyinfo created", KEYINFO_REC
+"keyinfo destroyed", KEYINFO_REC
+"print text", TEXT_DEST_REC *dest, char *text, char *stripped
+"print format", THEME_REC *theme, char *module, TEXT_DEST_REC *dest, formatnum_args
+"print noformat", TEXT_DEST_REC *dest, char *text
+"theme created", THEME_REC
+"theme destroyed", THEME_REC
+"window hilight", WINDOW_REC
+"window hilight check", TEXT_DEST_REC, char *msg, int *data_level, int *should_ignore
+"window dehilight", WINDOW_REC
+"window activity", WINDOW_REC, int old_level
+"window item hilight", WI_ITEM_REC
+"window item activity", WI_ITEM_REC, int old_level
+"window item new", WINDOW_REC, WI_ITEM_REC
+"window item remove", WINDOW_REC, WI_ITEM_REC
+"window item moved", WINDOW_REC, WI_ITEM_REC, WINDOW_REC
+"window item changed", WINDOW_REC, WI_ITEM_REC
+"window item server changed", WINDOW_REC, WI_ITEM_REC
+"window created", WINDOW_REC
+"window destroyed", WINDOW_REC
+"window changed", WINDOW_REC, WINDOW_REC old
+"window changed automatic", WINDOW_REC
+"window server changed", WINDOW_REC, SERVER_REC
+"window refnum changed", WINDOW_REC, int old
+"window name changed", WINDOW_REC
+"window history changed", WINDOW_REC, char *oldname
+"window level changed", WINDOW_REC
+"default event numeric", SERVER_REC, char *data, char *nick, char *address
+"message irc op_public", SERVER_REC, char *msg, char *nick, char *address, char *target
+"message irc own_wall", SERVER_REC, char *msg, char *target
+"message irc own_action", SERVER_REC, char *msg, char *target
+"message irc action", SERVER_REC, char *msg, char *nick, char *address, char *target
+"message irc own_notice", SERVER_REC, char *msg, char *target
+"message irc notice", SERVER_REC, char *msg, char *nick, char *address, char *target
+"message irc own_ctcp", SERVER_REC, char *cmd, char *data, char *target
+"message irc ctcp", SERVER_REC, char *cmd, char *data, char *nick, char *address, char *target
+"message irc mode", SERVER_REC, char *channel, char *nick, char *addr, char *mode
+"message dcc own", DCC_REC *dcc, char *msg
+"message dcc own_action", DCC_REC *dcc, char *msg
+"message dcc own_ctcp", DCC_REC *dcc, char *cmd, char *data
+"message dcc", DCC_REC *dcc, char *msg
+"message dcc action", DCC_REC *dcc, char *msg
+"message dcc ctcp", DCC_REC *dcc, char *cmd, char *data
+"gui key pressed", int key
+"beep"
+"gui print text after finished", WINDOW_REC, LINE_REC *line, LINE_REC *prev_line, TEXT_DEST_REC
+"gui textbuffer line removed", TEXTBUFFER_VIEW_REC *view, LINE_REC *line, LINE_REC *prev_line
+"otr event", SERVER_REC, char *nick, char *status
+_END
+
+my %handlers = ();
+
+sub load {
+ foreach my $sigline (split(/\n/, $signals)) {
+ my ($sig, @args) = split(/, /, $sigline);
+ $sig =~ y/"//d;
+ next if ( $sig =~ m/<.*>/ );
+ my $handler = sub { signal_handler($sig, \@args, \@_); };
+ Irssi::signal_add_first($sig, $handler);
+ $handlers{$sig} = $handler;
+ }
+}
+
+sub UNLOAD {
+ while (my ($sig, $handler) = each %handlers) {
+ Irssi::signal_remove($sig, $handler);
+ }
+ %handlers = ();
+}
+
+load();
diff --git a/scripts/q_username.pl b/scripts/q_username.pl
new file mode 100644
index 0000000..6652ddf
--- /dev/null
+++ b/scripts/q_username.pl
@@ -0,0 +1,26 @@
+# Prints the Q username in right format
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.1";
+%IRSSI = (
+ authors=> "Teemu \'jamov\' Koskinen",
+ contact=> "teemu.koskinen\@mbnet.fi",
+ name=> "q_username",
+ description=> "Prints the Q username in right format",
+ license=> "Public Domain",
+);
+
+Irssi::theme_register([whois_auth => ' authnick : $1']);
+
+sub event_whois_auth {
+ my ($server, $data) = @_;
+ my ($num, $nick, $auth_nick) = split(/ +/, $_[1], 3);
+ $auth_nick =~ s/\:is authed as //;
+
+ $server->printformat($nick, MSGLEVEL_CRAP, 'whois_auth', $nick, $auth_nick);
+ Irssi::signal_stop();
+}
+
+Irssi::signal_add('event 330', 'event_whois_auth');
diff --git a/scripts/query-connection-notifier.pl b/scripts/query-connection-notifier.pl
new file mode 100644
index 0000000..450512f
--- /dev/null
+++ b/scripts/query-connection-notifier.pl
@@ -0,0 +1,67 @@
+use Irssi;
+use Irssi::UI;
+use Irssi::TextUI;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '0.1';
+%IRSSI = (
+ author => 'meh',
+ contact => 'meh@schizofreni.co',
+ name => 'Query connection notification',
+ description => 'Notify in the query window when the nick connects',
+ license => 'WTFPL',
+);
+
+Irssi::theme_register([
+ 'connect', '{channick_hilight $0} {chanhost_hilight $1} has connected'
+]);
+
+my %quit;
+
+Irssi::signal_add 'message join' => sub {
+ my ($server, $channel, $nick, $address) = @_;
+
+ if ($quit{"$server->{tag}:$nick"}) {
+ delete $quit{"$server->{tag}:$nick"};
+
+ foreach $query (Irssi::queries()) {
+ if ($query->{server_tag} eq $server->{tag} && $query->{name} eq $nick) {
+ $query->printformat(MSGLEVEL_JOINS, 'connect', $nick, $address);
+
+ break;
+ }
+ }
+ }
+};
+
+Irssi::signal_add 'message quit' => sub {
+ my ($server, $nick, $address, $reason) = @_;
+
+ $quit{"$server->{tag}:$nick"} = 1;
+};
+
+Irssi::signal_add 'query created' => sub {
+ my ($query, $automatic) = @_;
+
+ foreach $channel ($query->{server}->channels) {
+ foreach $nick ($channel->nicks) {
+ if ($nick eq $query->{name}) {
+ return;
+ }
+ }
+ }
+
+ $quit{"$query->{server}->{tag}:$query->{name}"} = 1;
+};
+
+Irssi::signal_add 'query destroyed' => sub {
+ my ($query) = @_;
+
+ delete $quit{"$query->{server}->{tag}:$query->{name}"};
+};
+
+Irssi::signal_add 'message private' => sub {
+ my ($server, $msg, $nick, $address) = @_;
+
+ delete $quit{"$server->{tag}:$nick"};
+};
diff --git a/scripts/query.pl b/scripts/query.pl
new file mode 100644
index 0000000..7fc13fa
--- /dev/null
+++ b/scripts/query.pl
@@ -0,0 +1,593 @@
+#
+# Copyright (C) 2001-2021 by Peder Stray <peder.stray@gmail.com>
+#
+
+use strict;
+use Irssi 20020428.1608;
+
+use Text::Abbrev;
+use POSIX;
+
+use vars qw{$VERSION %IRSSI};
+($VERSION) = '$Revision: 1.26.1 $' =~ / (\d+(\.\d+)+) /;
+%IRSSI = (
+ name => 'query',
+ authors => 'Peder Stray',
+ contact => 'peder.stray@gmail.com',
+ url => 'https://github.com/pstray/irssi-query',
+ license => 'GPL',
+ description => 'Give you more control over when to jump to query windows and when to just tell you one has been created. Enhanced autoclose.',
+ );
+
+use vars qw(%state);
+*state = \%Query::state; # used for tracking idletime and state
+
+my($own);
+my(%defaults); # used for storing defaults
+my($query_opts) = {}; # stores option abbrevs
+
+sub load_defaults {
+ my $file = Irssi::get_irssi_dir."/query";
+ local *FILE;
+
+ %defaults = ();
+ open FILE, "<", $file;
+ while (<FILE>) {
+ my($mask,$maxage,$immortal) = split;
+ $defaults{$mask}{maxage} = $maxage;
+ $defaults{$mask}{immortal} = $immortal;
+ }
+ close FILE;
+}
+
+sub save_defaults {
+ my $file = Irssi::get_irssi_dir."/query";
+ local *FILE;
+
+ open FILE, ">", $file;
+ for (keys %defaults) {
+ my $d = $defaults{$_};
+ print FILE join("\t", $_,
+ exists $d->{maxage} ? $d->{maxage} : -1,
+ exists $d->{immortal} ? $d->{immortal} : -1,
+ ), "\n";
+ }
+ close FILE;
+}
+
+sub sec2str {
+ my($sec) = @_;
+ my($ret);
+ use integer;
+
+ $ret = ($sec%60)."s ";
+ $sec /= 60;
+
+ $ret = ($sec%60)."m ".$ret;
+ $sec /= 60;
+
+ $ret = ($sec%24)."h ".$ret;
+ $sec /= 24;
+
+ $ret = $sec."d ".$ret;
+
+ $ret =~ s/\b0[dhms] //g;
+ $ret =~ s/ $//;
+
+ return $ret;
+}
+
+sub str2sec {
+ my($str) = @_;
+
+ for ($str) {
+ s/\s+//g;
+ s/d/*24h/g;
+ s/h/*60m/g;
+ s/m/*60s/g;
+ s/s/+/g;
+ s/\+$//;
+ }
+
+ if ($str =~ /^[0-9*+]+$/) {
+ $str = eval $str;
+ }
+ else {
+ $str = 0;
+ }
+
+ return $str;
+}
+
+sub set_defaults {
+ my($serv,$nick,$address) = @_;
+ my $tag = lc $serv->{tag};
+
+ return unless $address;
+ $state{$tag}{$nick}{address} = $address;
+
+ for my $mask (sort {userhost_cmp($serv,$a,$b)}keys %defaults) {
+ if ($serv->mask_match_address($mask, $nick, $address)) {
+ for my $key (keys %{$defaults{$mask}}) {
+ $state{$tag}{$nick}{$key} = $defaults{$mask}{$key}
+ if $defaults{$mask}{$key} >= 0;
+ }
+ }
+ }
+}
+
+sub time2str {
+ my($time) = @_;
+ return strftime("%c", localtime $time);
+}
+
+sub userhost_cmp {
+ my($serv, $am, $bm) = @_;
+ my($an,$aa) = split "!", $am;
+ my($bn,$ba) = split "!", $bm;
+ my($t1,$t2);
+
+ $t1 = $serv->mask_match_address($bm, $an, $aa);
+ $t2 = $serv->mask_match_address($am, $bn, $ba);
+
+ return $t1 - $t2 if $t1 || $t2;
+
+ $an = $bn = '*';
+ $am = "$an!$aa";
+ $bm = "$bn!$ba";
+
+ $t1 = $serv->mask_match_address($bm, $an, $aa);
+ $t2 = $serv->mask_match_address($am, $bn, $ba);
+
+ return $t1 - $t2 if $t1 || $t2;
+
+ for ($am, $bm, $aa, $ba) {
+ s/(\*!)?[^*]*@/$1*/;
+ }
+
+ $t1 = $serv->mask_match_address($bm, $an, $aa);
+ $t2 = $serv->mask_match_address($am, $bn, $ba);
+
+ return $t1 - $t2 if $t1 || $t2;
+
+ return 0;
+
+}
+
+sub sig_message_own_private {
+ my($server,$msg,$nick,$orig_target) = @_;
+ $own = $nick;
+}
+
+sub sig_message_private {
+ my($server,$msg,$nick,$addr) = @_;
+ undef $own;
+}
+
+sub sig_print_message {
+ my($dest, $text, $strip) = @_;
+
+ return unless $dest->{level} & MSGLEVEL_MSGS;
+
+ my $server = $dest->{server};
+
+ return unless $server;
+
+ my $witem = $server->window_item_find($dest->{target});
+ my $tag = lc $server->{tag};
+
+ return unless $witem->{type} eq 'QUERY';
+
+ $state{$tag}{$witem->{name}}{time} = time;
+}
+
+sub sig_query_address_changed {
+ my($query) = @_;
+
+ set_defaults($query->{server}, $query->{name}, $query->{address});
+
+}
+
+sub sig_query_created {
+ my ($query, $auto) = @_;
+ my $qwin = $query->window();
+ my $awin = Irssi::active_win();
+
+ my $serv = $query->{server};
+ my $nick = $query->{name};
+ my $tag = lc $query->{server_tag};
+
+ if ($auto && $qwin->{refnum} != $awin->{refnum}) {
+ if ($own eq $query->{name}) {
+ if (Irssi::settings_get_bool('query_autojump_own')) {
+ $qwin->set_active();
+ } else {
+ $awin->printformat(MSGLEVEL_CLIENTCRAP, 'query_created',
+ $nick, $query->{server_tag},
+ $qwin->{refnum})
+ if Irssi::settings_get_bool('query_noisy');
+ }
+ } else {
+ if (Irssi::settings_get_bool('query_autojump')) {
+ $qwin->set_active();
+ } else {
+ $awin->printformat(MSGLEVEL_CLIENTCRAP, 'query_created',
+ $nick, $query->{server_tag},
+ $qwin->{refnum})
+ if Irssi::settings_get_bool('query_noisy');
+ }
+ }
+ }
+ undef $own;
+
+ $state{$tag}{$nick} = { time => time };
+
+ if (ref($serv) eq 'Irssi::Irc::Server') {
+ $serv->redirect_event('userhost', 1, ":$nick", -1, undef,
+ {
+ "event 302" => "redir query userhost",
+ "" => "event empty",
+ });
+ $serv->send_raw("USERHOST :$nick");
+ }
+}
+
+sub sig_query_destroyed {
+ my($query) = @_;
+
+ delete $state{lc $query->{server_tag}}{$query->{name}};
+}
+
+sub sig_query_nick_changed {
+ my($query,$old_nick) = @_;
+ my($tag) = lc $query->{server_tag};
+
+ $state{$tag}{$query->{name}} = delete $state{$tag}{$old_nick};
+}
+
+sub sig_redir_query_userhost {
+ my($serv,$data) = @_;
+
+ $data =~ s/^\S*\s*://;
+ for (split " ", $data) {
+ if (/([^=*]+)\*?=.(.+)/) {
+ set_defaults($serv, $1, $2);
+ }
+ }
+}
+
+sub sig_session_restore {
+ open STATE, "<", sprintf "%s/query.state", Irssi::get_irssi_dir;
+ %state = (); # only needed if bound as command
+ while (<STATE>) {
+ chomp;
+ my($tag,$nick,%data) = split "\t";
+ for my $key (keys %data) {
+ $state{lc $tag}{$nick}{$key} ||= $data{$key};
+ }
+ }
+ close STATE;
+}
+
+sub sig_session_save {
+ open STATE, ">", sprintf "%s/query.state", Irssi::get_irssi_dir;
+ for my $tag (keys %state) {
+ for my $nick (keys %{$state{$tag}}) {
+ print STATE join("\t",$tag,$nick,%{$state{$tag}{$nick}}), "\n";
+ }
+ }
+ close STATE;
+}
+
+sub check_queries {
+ my(@queries) = Irssi::queries;
+
+ my($defmax) = Irssi::settings_get_time('query_autoclose')/1000;
+ my($minage) = Irssi::settings_get_time('query_autoclose_grace')/1000;
+ my($win) = Irssi::active_win;
+
+ for my $query (@queries) {
+ my $tag = lc $query->{server_tag};
+ my $name = $query->{name};
+ my $state = $state{$tag}{$name};
+
+ my $age = time - $state->{time};
+ my $maxage = $defmax;
+
+ $maxage = $state->{maxage} if defined $state->{maxage};
+
+ # skip the ones we have marked as immortal
+ next if $state->{immortal};
+
+ # maxage = 0 means we have disabled autoclose
+ next unless $maxage;
+
+ # not old enough
+ next if $age < $maxage;
+
+ # unseen messages
+ next if $query->{data_level} > 1;
+
+ # active window
+ next if $query->is_active &&
+ $query->window->{refnum} == $win->{refnum};
+
+ # graceperiod
+ next if time - $query->{last_unread_msg} < $minage;
+
+ # kill it off
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'query_closed',
+ $query->{name}, $query->{server_tag})
+ if Irssi::settings_get_bool('query_noisy');
+ $query->destroy;
+
+ }
+}
+
+sub cmd_query {
+ my($data,$server,$witem) = @_;
+ my(@data) = split " ", $data;
+
+ my(@params,@opts,$query,$tag,$nick);
+ my($state,$info,$save);
+
+ while (@data) {
+ my $param = shift @data;
+
+ if ($param =~ s/^-//) {
+ my $opt = $query_opts->{lc $param};
+
+ if ($opt) {
+
+ if ($opt eq 'window') {
+ push @opts, "-$param";
+
+ } elsif ($opt eq 'immortal') {
+ $state->{immortal} = 1;
+
+ } elsif ($opt eq 'info') {
+ $info = 1;
+
+ } elsif ($opt eq 'mortal') {
+ $state->{immortal} = 0;
+
+ } elsif ($opt eq 'timeout') {
+ $state->{maxage} = str2sec shift @data;
+
+ } elsif ($opt eq 'save') {
+ $save++;
+
+ } else {
+ # unhandled known opt
+
+ }
+
+ } elsif ($tag = Irssi::server_find_tag($param)) {
+ $tag = $tag->{tag};
+ push @opts, "-$tag";
+
+ } else {
+ # bogus opt...
+ push @opts, "-$param";
+
+ }
+
+ } else {
+ # normal parameter
+ push @params, $param;
+
+ }
+ }
+
+ if (@params) {
+ Irssi::signal_continue("@opts @params",$server,$witem);
+
+ # find the query...
+ my $serv = Irssi::server_find_tag($tag || $server->{tag});
+ return unless $serv;
+ $query = $serv->window_item_find($params[0]);
+
+ } else {
+
+ if ($witem && $witem->{type} eq 'QUERY') {
+ $query = $witem;
+ }
+
+ }
+
+ if ($query) {
+ $nick = $query->{name};
+ $tag = lc $query->{server_tag};
+
+ my $opts;
+ for (keys %$state) {
+ $state{$tag}{$nick}{$_} = $state->{$_};
+ $opts++;
+ }
+
+ $state = $state{$tag}{$nick};
+
+ if ($info) {
+ Irssi::signal_stop();
+ my(@items,$key,$val);
+
+ my $timeout = Irssi::settings_get_time('query_autoclose')/1000;
+ $timeout = $state->{maxage} if defined $state->{maxage};
+
+ if ($timeout) {
+ $timeout .= " (".sec2str($timeout).")";
+ } else {
+ $timeout .= " (Off)";
+ }
+
+ @items = (
+ Server => $query->{server_tag},
+ Nick => $nick,
+ Address => $state->{address},
+ Created => time2str($query->{createtime}),
+ Immortal => $state->{immortal}?'Yes':'No',
+ Timeout => $timeout,
+ Idle => sec2str(time - $state->{time}),
+ );
+
+ $query->printformat(MSGLEVEL_CLIENTCRAP, 'query_info_header');
+ while (($key,$val) = splice @items, 0, 2) {
+ $query->printformat(MSGLEVEL_CLIENTCRAP, 'query_info',
+ $key, $val);
+ }
+ $query->printformat(MSGLEVEL_CLIENTCRAP, 'query_info_footer');
+
+ return;
+ }
+
+ if ($save) {
+ Irssi::signal_stop;
+
+ unless ($state->{address}) {
+ $query->printformat(MSGLEVEL_CLIENTCRAP,
+ 'query_crap', 'This query has no address yet');
+ return;
+ }
+
+ my $mask = Irssi::Irc::get_mask($nick, $state->{address},
+ Irssi::Irc::MASK_USER |
+ Irssi::Irc::MASK_DOMAIN
+ );
+
+ for (qw(immortal maxage)) {
+ if (exists $state->{$_}) {
+ $defaults{$mask}{$_} = $state->{$_};
+ } else {
+ delete $defaults{$mask}{$_};
+ }
+ }
+
+ save_defaults;
+
+ return;
+ }
+
+ if (!@params) {
+ Irssi::signal_stop;
+ return if $opts;
+
+ if ($state{$tag}{$nick}{immortal}) {
+ $witem->printformat(MSGLEVEL_CLIENTCRAP,
+ 'query_crap', 'This query is immortal');
+ } else {
+ $witem->command("unquery")
+ if Irssi::settings_get_bool('query_unqueries');
+ }
+
+ }
+
+ }
+
+}
+
+sub cmd_unquery {
+ my($data,$server,$witem) = @_;
+ my($param) = split " ", $data;
+ my($query,$tag,$nick);
+
+ if ($param) {
+ $query = $server->query_find($param) if $server;
+ } else {
+ $query = $witem if $witem && $witem->{type} eq 'QUERY';
+ }
+
+ if ($query) {
+ $nick = $query->{name};
+ $tag = lc $query->{server_tag};
+
+ if ($state{$tag}{$nick}{immortal}) {
+ if ($param) {
+ $witem->printformat(MSGLEVEL_CLIENTCRAP,
+ 'query_crap',
+ "Query with $nick is immortal");
+ } else {
+ $witem->printformat(MSGLEVEL_CLIENTCRAP,
+ 'query_crap',
+ 'This query is immortal');
+ }
+ Irssi::signal_stop;
+ }
+ }
+}
+
+Irssi::command_bind('query', 'cmd_query');
+Irssi::command_bind('unquery', 'cmd_unquery');
+Irssi::command_set_options('query', 'immortal mortal info save +timeout');
+abbrev $query_opts, qw(window immortal mortal info save timeout);
+
+#Irssi::command_bind('debug', sub { print Dumper \%state });
+#Irssi::command_bind('query_save', 'sig_session_save');
+#Irssi::command_bind('query_restore', 'sig_session_restore');
+
+Irssi::theme_register(
+[
+ 'query_created',
+ '{line_start}{hilight Query:} started with {nick $0} [$1] in window $2',
+
+ 'query_closed',
+ '{line_start}{hilight Query:} closed with {nick $0} [$1]',
+
+ 'query_info_header', '',
+
+ 'query_info_footer', '',
+
+ 'query_crap',
+ '{line_start}{hilight Query:} $0',
+
+ 'query_warn',
+ '{line_start}{hilight Query:} {error Warning:} $0',
+
+ 'query_info',
+ '%#$[8]0: $1',
+
+]);
+
+Irssi::settings_add_bool('query', 'query_autojump_own', 1);
+Irssi::settings_add_bool('query', 'query_autojump', 0);
+Irssi::settings_add_bool('query', 'query_noisy', 1);
+Irssi::settings_add_bool('query', 'query_unqueries',
+ Irssi::version < 20020919.1507 ||
+ Irssi::version >= 20021006.1620 );
+
+Irssi::settings_add_time('query', 'query_autoclose', 0);
+Irssi::settings_add_time('query', 'query_autoclose_grace', '5min');
+
+Irssi::signal_add_last('message own_private', 'sig_message_own_private');
+Irssi::signal_add_last('message private', 'sig_message_private');
+
+Irssi::signal_add_last('query created', 'sig_query_created');
+
+Irssi::signal_add('print text', 'sig_print_message');
+
+Irssi::signal_add('query address changed', 'sig_query_address_changed');
+Irssi::signal_add('query destroyed', 'sig_query_destroyed');
+Irssi::signal_add('query nick changed', 'sig_query_nick_changed');
+
+Irssi::signal_add('redir query userhost', 'sig_redir_query_userhost');
+
+Irssi::signal_add('session save', 'sig_session_save');
+Irssi::signal_add('session restore', 'sig_session_restore');
+
+Irssi::timeout_add(5000, 'check_queries', undef);
+
+load_defaults;
+
+for my $query (Irssi::queries) {
+ my($tag) = lc $query->{server_tag};
+ my($nick) = $query->{name};
+
+ $state{$tag}{$nick}{time}
+ ||= $query->{last_unread_msg} || $query->{createtime} || time;
+
+ set_defaults($query->{server}, $nick, $query->{address});
+}
+
+if (Irssi::settings_get_time("autoclose_query")) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'query_warn',
+ "autoclose_query is set, please set to 0");
+}
diff --git a/scripts/queryresume.pl b/scripts/queryresume.pl
new file mode 100644
index 0000000..b4b090e
--- /dev/null
+++ b/scripts/queryresume.pl
@@ -0,0 +1,64 @@
+# QueryResume by Stefan Tomanek <stefan@pico.ruhr.de>
+#
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '2003021201';
+%IRSSI = (
+ authors => 'Stefan \'tommie\' Tomanek',
+ contact => 'stefan@pico.ruhr.de',
+ name => 'QueryResume',
+ description => 'restores the last lines of a query on re-creation',
+ license => 'GPLv2',
+ modules => 'Date::Format File::Glob',
+ changed => $VERSION,
+);
+
+use Irssi 20020324;
+use Date::Format;
+use File::Glob ':glob';
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub sig_window_item_new ($$) {
+ my ($win, $witem) = @_;
+ return unless (ref $witem && $witem->{type} eq 'QUERY');
+ my @data;
+ my $filename = Irssi::settings_get_str('autolog_path');
+ my $servertag = $witem->{server}->{tag};
+ my $name = lc $witem->{name};
+ $filename =~ s/(\$tag|\$1)/$servertag/g;
+ $filename =~ s/\$0/$name/g;
+ my @lt = localtime(time);
+ my $zone;
+ $filename = strftime($filename, @lt, $zone);
+ $filename =~ s/(\[|\])/\\$1/g;
+ local *F;
+ open(F, "<", bsd_glob($filename));
+ my $lines = Irssi::settings_get_int('queryresume_lines');
+ foreach (<F>) {
+ unless (/^--- Log/) {
+ push(@data, $_);
+ shift(@data) if (@data > $lines);
+ }
+ }
+ my $text;
+ $text .= $_ foreach @data;
+ $text =~ s/%/%%/g;
+ $witem->print(draw_box('QueryResume', $text, $filename, 1), MSGLEVEL_CLIENTCRAP) if $text;
+}
+
+Irssi::settings_add_int($IRSSI{name}, 'queryresume_lines', 10);
+
+Irssi::signal_add('window item new', 'sig_window_item_new');
+
diff --git a/scripts/quiet.pl b/scripts/quiet.pl
new file mode 100644
index 0000000..df09971
--- /dev/null
+++ b/scripts/quiet.pl
@@ -0,0 +1,90 @@
+# Copyright (c) 2006 Christoph Berg <cb@df7cb.de>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+
+# This script adds support for +q (quiet user) channel modes to irssi.
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '0.2';
+%IRSSI = (
+ authors => 'Christoph Berg',
+ contact => 'cb@df7cb.de',
+ name => 'quiet',
+ description => 'support for +q (quiet user) channel mode',
+ license => '2-clause BSD',
+);
+
+# :helium.oftc.net 344 Tauon #test test!*@* cryogen!stu@o.net 1164222156
+# :helium.oftc.net 345 Tauon #test :End of Channel Quiet List
+
+sub event_quiet_list
+{
+ my ($server, $data, $srvname) = @_;
+ my ($target, $channel, $mask, $by, $time) = split(/\s+/, $data);
+ $time = time() - $time if $time;
+ $server->window_find_item($channel)->printformat(MSGLEVEL_CRAP,
+ $by ? "quietlist_long" : "quietlist", $channel, $mask, $by, $time);
+}
+
+sub event_quiet_list_end
+{
+ my ($server, $data, $srvname) = @_;
+ my ($target, $channel, $text) = split(/\s+/, $data, 3);
+ $text =~ s/^://;
+ $server->window_find_item($channel)->print($text, MSGLEVEL_CRAP);
+}
+
+sub do_quiet
+{
+ my ($data, $server, $witem, $quiet) = @_;
+ my $support = $server->isupport("CHANMODES");
+ if ($support !~ /q/) {
+ Irssi::print("This server does not support channel mode +q");
+ return;
+ }
+ if (!$witem or $witem->{type} ne "CHANNEL") {
+ Irssi::print("Not joined to any channel");
+ return;
+ }
+ my @data = split /\s+/, $data;
+ my $mode = @data > 0 ? ($quiet ? "+" : "-") . ("q" x (@data)) . " @data" : "+q";
+ $witem->command("mode $witem->{name} $mode");
+}
+
+sub quiet { do_quiet(@_, 1); }
+sub unquiet { do_quiet(@_, 0); }
+
+Irssi::theme_register([
+ "quietlist" => '{channel $0}: ban quiet {ban $1}',
+ "quietlist_long" => '{channel $0}: ban quiet {ban $1} {comment by {nick $2}, $3 secs ago}',
+]);
+
+Irssi::signal_add("event 344", "event_quiet_list");
+Irssi::signal_add("event 345", "event_quiet_list_end");
+
+Irssi::command_bind('quiet', 'quiet');
+Irssi::command_bind('unquiet', 'unquiet');
diff --git a/scripts/quitrand.pl b/scripts/quitrand.pl
new file mode 100644
index 0000000..cfa1b38
--- /dev/null
+++ b/scripts/quitrand.pl
@@ -0,0 +1,52 @@
+# If quit message isn't given, quit with a random message
+# read from ~/.irssi/irssi.quit
+
+use Irssi;
+use Irssi::Irc;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.00";
+%IRSSI = (
+ authors => 'Fernando J. Pereda',
+ contact => 'ferdy@ferdyx.org',
+ name => 'quitrand',
+ description => 'Random quit messages - based on quitmsg (Timo Sirainen)',
+ license => 'GPLv2',
+);
+
+my $quitfile = glob "~/.irssi/irssi.quit";
+
+sub cmd_quit {
+ my ($data, $server, $channel) = @_;
+
+ open(f,"<",$quitfile);
+ my @contenido = <f>;
+ close(f);
+
+ my $numlines = 0;
+
+ foreach my $nada (@contenido) {
+ $numlines++;
+ }
+
+ my $line = int(rand($numlines))+1;
+
+ my $quitmsg = "[IRSSI] ".$contenido[$line];
+
+ chop($quitmsg);
+
+ print($quitmsg);
+
+ foreach my $sv (Irssi::servers()) {
+ foreach my $item ($sv->channels()) {
+ $item->command("PART ".$item->{name}." $quitmsg");
+ }
+ }
+
+ foreach my $svr (Irssi::servers()) {
+ $svr->command("DISCONNECT ".$svr->{tag}." $quitmsg");
+ }
+}
+
+Irssi::command_bind('quit', 'cmd_quit');
diff --git a/scripts/quiz.pl b/scripts/quiz.pl
new file mode 100644
index 0000000..46e34d8
--- /dev/null
+++ b/scripts/quiz.pl
@@ -0,0 +1,451 @@
+# Quiz script for irssi
+# (C) Simon Huggins 2001
+# huggie@earth.li
+
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the Free
+# Software Foundation; either version 2 of the License, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+# for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc., 59
+# Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# TODO:
+# - Do something when people quit (remove from team, readd when
+# rejoin?)
+# - Store questions asked in a file rather than just in memory so it
+# can be restarted without a problem.
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi 20020217.1542 (); # Version 0.8.1
+$VERSION = "0.8";
+%IRSSI = (
+authors => "Simon Huggins",
+contact => "huggie-irssi\@earth.li",
+name => "Quiz",
+description => "Turns irssi into a quiz bot",
+license => "GPLv2",
+url => "http://the.earth.li/~huggie/irssi/",
+changed => "2017-04-03",
+);
+
+use Irssi::Irc;
+use Data::Dumper;
+
+Irssi::settings_add_str("misc","quiz_admin","huggie");
+Irssi::settings_add_str("misc","quiz_passwd","stuff");
+Irssi::settings_add_str("misc","quiz_file","/home/huggie/.irssi/questions");
+
+Irssi::settings_add_int("misc","quiz_qlength",60);
+Irssi::settings_add_int("misc","quiz_hints",4);
+Irssi::settings_add_int("misc","quiz_target_score",10);
+Irssi::settings_add_int("misc","quiz_leave_concealed_chars",1);
+
+Irssi::command("set cmd_queue_speed 2010");
+
+{
+my $s;
+
+sub load_questions($$) {
+ my ($game,$force) = @_;
+ my $tag = $game->{'tag'};
+ my $channel = $game->{'channel'};
+
+ my $server = Irssi::server_find_tag($tag);
+
+ if (!defined $server) {
+ Irssi::print("Hrm, couldn't find server for tag ($tag) in load_questions");
+ return;
+ }
+
+ return if $game->{'questions'} and not $force;
+
+ my $file = Irssi::settings_get_str("quiz_file");
+ if (open(QS, '<',$file)) {
+ @{$game->{'questions'}}=<QS>;
+ close(QS);
+ Irssi::print("Loaded questions");
+ return 1;
+ } else {
+ $server->command("msg $channel Can't find quiz questions, sorry.");
+ return;
+ }
+}
+
+sub start_game($) {
+ my $game = shift;
+ my $tag = $game->{'tag'};
+ my $channel = $game->{'channel'};
+ my $server = Irssi::server_find_tag($tag);
+
+ if (!defined $server) {
+ Irssi::print("Hrm, couldn't find server for tag ($tag) in start_game");
+ return;
+ }
+
+ Irssi::timeout_remove($game->{'timeouttag'});
+ undef $game->{'timeouttag'};
+
+ if (!keys %{$game->{'teams'}}) {
+ $server->command("msg $channel Sorry no one joined!");
+ $game->{'state'} = "over";
+ game_over($game);
+ return;
+ }
+ $game->{'state'} = "game";
+
+ $server->command("msg $channel Game starts now. Questions last ".
+ Irssi::settings_get_int("quiz_qlength").
+ " seconds and there are ".
+ (Irssi::settings_get_int("quiz_hints")-1).
+ " hints. First to reach ".
+ Irssi::settings_get_int("quiz_target_score")." wins.");
+ next_question($game);
+}
+
+sub show_scores($) {
+ my $game = shift;
+ my $tag = $game->{'tag'};
+ my $channel = $game->{'channel'};
+ my $server = Irssi::server_find_tag($tag);
+
+ if (!defined $server) {
+ Irssi::print("Hrm, couldn't find server for tag ($tag) in show_scores");
+ return;
+ }
+
+ my (@redscorers,@bluescorers);
+
+ foreach my $score (sort keys %{$game->{'scores'}}) {
+ if ($score =~ /^blue/) {
+ $score =~ s/^blue//;
+ push @bluescorers, "$score(".
+ $game->{'scores'}->{"blue".$score}.")";
+ } else {
+ $score =~ s/^red//;
+ push @redscorers, "$score(".
+ $game->{'scores'}->{"red".$score}.")";
+ }
+ }
+
+ $server->command("msg $channel 12Blue: ".$game->{'bluescore'}
+ ." ".join(",",@bluescorers));
+ $server->command("msg $channel 4Red : ".$game->{'redscore'}
+ ." ".join(",",@redscorers));
+
+ my $ts = Irssi::settings_get_int("quiz_target_score");
+ if ($game->{'bluescore'} == $ts or $game->{'redscore'} == $ts) {
+ if ($game->{'bluescore'} == $ts) {
+ $server->command("msg $channel 12Blue team wins ".
+ $game->{'bluescore'}." to ".
+ $game->{'redscore'});
+ } else {
+ $server->command("msg $channel 4Red team wins ".
+ $game->{'redscore'}." to ".
+ $game->{'bluescore'});
+ }
+ $game->{'state'}="over";
+ } elsif ($game->{'state'} ne "over") {
+ $game->{'state'}="pause";
+ $server->command("msg $channel Next question in 20 seconds.");
+ if ($game->{'timeouttag'}) {
+ Irssi::timeout_remove($game->{'timeouttag'});
+ }
+ $game->{'timeouttag'} = Irssi::timeout_add(20000,
+ "next_question",$game);
+ $game->{'timeout'} = time() + 20;
+ }
+ game_over($game);
+}
+
+sub hint($) {
+ my $game = shift;
+ my $tag = $game->{'tag'};
+ my $channel = $game->{'channel'};
+ my $server = Irssi::server_find_tag($tag);
+
+ if (!defined $server) {
+ Irssi::print("Hrm, couldn't find server for tag ($tag) in hint");
+ return;
+ }
+
+ return if game_over($game);
+ if ($game->{'end'} <= time()) {
+ $server->command("msg $channel Time's up. The answer is: ".$game->{'answer'});
+ show_scores($game);
+ } else {
+ $game->{'hint'}++;
+ my $num = $game->{'current_answer'} =~ s/\*/*/g;
+ if ($num <= Irssi::settings_get_int("quiz_leave_concealed_chars")) {
+ return;
+ }
+ my $pos = index($game->{'current_answer'},"*");
+ if ($pos >= 0) {
+ $game->{'current_answer'} =~ s/\*/substr($game->{'answer'},$pos,1)/e;
+ }
+ my $hinttime = $game->{'hint'}*$game->{'hintlen'};
+ if ($hinttime != int($hinttime)) {
+ $hinttime = sprintf("%.2f", $hinttime);
+ }
+ $server->command("msg $channel $hinttime second hint: ".
+ $game->{'current_answer'});
+ }
+}
+
+sub game_over($) {
+ my $game = shift;
+ my $tag = $game->{'tag'};
+ my $channel = $game->{'channel'};
+ my $server = Irssi::server_find_tag($tag);
+
+ if (!defined $server) {
+ Irssi::print("Hrm, couldn't find server for tag ($tag) in game_over");
+ return;
+ }
+
+ if ($game->{'state'} eq "over") {
+ Irssi::timeout_remove($game->{'timeouttag'});
+ undef $game->{'timeouttag'};
+ undef $game->{'state'};
+ undef $game->{'teams'};
+ undef $game->{'scores'};
+ $server->command("msg $channel Trivia is disabled. Use !trivon to restart.");
+ return 1;
+ }
+ return;
+}
+
+sub next_question($) {
+ my $game = shift;
+ my $tag = $game->{'tag'};
+ my $channel = $game->{'channel'};
+ my $server = Irssi::server_find_tag($tag);
+
+ if (!defined $server) {
+ Irssi::print("Hrm, couldn't find server for tag ($tag) in next_question");
+ return;
+ }
+
+ my $len = Irssi::settings_get_int("quiz_qlength")/
+ Irssi::settings_get_int("quiz_hints");
+ if ($game->{'timeouttag'}) {
+ Irssi::timeout_remove($game->{'timeouttag'});
+ }
+ $game->{'timeouttag'} = Irssi::timeout_add($len*1000, "hint",$game);
+ my $t = time();
+ $game->{'timeout'} = $t + $len;
+ $game->{'end'} = Irssi::settings_get_int("quiz_qlength")+$t;
+ $game->{'hint'}=0;
+ $game->{'hintlen'} = $len;
+ if (!@{$game->{'questions'}}) {
+ load_questions($game,1);
+ if (!$game->{'questions'}) {
+ $server->command("msg $channel Hmmm, no questions found sorry");
+ $game->{'state'}="over";
+ }
+ Irssi::print("Questions looped");
+ }
+ return if game_over($game);
+ my $q = splice(@{$game->{'questions'}},rand(@{$game->{'questions'}}),1);
+ chomp $q;
+ $q =~ s/ //;
+ ($game->{'answer'} = $q) =~ s/^(.*)\|//;
+ $server->command("msg $channel Question: $1");
+ ($game->{'current_answer'} = $game->{'answer'}) =~ s/[a-zA-Z0-9]/*/g;
+ $q = s/^(.*)\|.*?$/$1/;
+ $server->command("msg $channel Answer: ".$game->{'current_answer'});
+ $game->{'state'}="question";
+}
+
+sub invite_join($$) {
+ my ($server,$channel) = @_;
+ my $game = $s->{$server->{'tag'}}->{$channel};
+
+ $server->command("msg $channel Team Trivia thingummie v($VERSION) starts in 1 minute. Type 4!join red or 12!join blue");
+ $game->{'timeouttag'} = Irssi::timeout_add(60000,"start_game",$game);
+ $game->{'timeout'} = time()+60;
+}
+
+sub secstonormal($) {
+ my $seconds = shift;
+ my ($m,$s);
+
+ $s = $seconds % 60;
+ $m = ($seconds - $s)/60;
+ return sprintf("%02d:%02d",$m,$s);
+}
+
+sub do_pubcommand($$$$) {
+ my ($command,$channel,$server,$nick) = @_;
+ my $game = $s->{$server->{'tag'}}->{$channel};
+
+ $command = lc $command;
+ $command =~ s/\s*$//;
+
+ if ($command =~ /^!bang$/) {
+ $server->command("msg $channel Dumping...");
+ foreach (split /\n/,Dumper($s)) {
+ Irssi::print("$_");
+ }
+ } elsif ($command =~ /^!trivon$/) {
+ if ($s->{$server->{'tag'}}->{$channel}) {
+ if ($s->{$server->{'tag'}}->{$channel}->{'state'}) {
+ $server->command("msg $nick Trivia is already on. Use !trivoff to remove it.");
+ return;
+ }
+ #undef $s->{$server->{'tag'}}->{$channel};
+ } else {
+ # create structure magically
+ $game = $s->{$server->{'tag'}}->{$channel} = {};
+ $game->{'tag'} = $server->{'tag'};
+ $game->{'channel'} = $channel;
+ }
+ $game->{'teams'}={};
+ $game->{'redscore'} = 0;
+ $game->{'bluescore'} = 0;
+ load_questions($game,0);
+ $game->{'state'} = "join";
+ invite_join($server,$channel);
+ } elsif ($command =~ /^!trivoff$/) {
+ return if !$game->{'state'};
+ $game->{'state'}="over";
+ game_over($game);
+ } elsif ($command =~ /^!join/) {
+ if ($command =~ /^!join (red|blue)$/) {
+ return if !$game->{'state'};
+ $game->{'teams'}->{$nick}=$1;
+ if ($1 eq "blue") {
+ $server->command("msg $nick You have joined the 12Blue team");
+ } else {
+ $server->command("msg $nick You have joined the 4Red team");
+ }
+ }
+ } elsif ($command =~ /^!teams/) {
+ return if !$game->{'state'};
+ my @blue=();
+ my @red=();
+ foreach (sort keys %{$game->{'teams'}}) {
+ push @blue, $_ if $game->{'teams'}->{$_} eq "blue";
+ push @red, $_ if $game->{'teams'}->{$_} eq "red";
+ }
+ $server->command("msg $channel 12Blue: ".join(",",@blue));
+ $server->command("msg $channel 4Red : ".join(",",@red));
+ } elsif ($command =~ /^!timeleft$/) {
+ if ($game->{'state'} eq "join" and $game->{'timeout'}) {
+ my $diff = $game->{'timeout'} - time();
+ if ($diff > 0) {
+ $server->command("msg $channel Time left: ".secstonormal($diff));
+ } else {
+ Irssi::print("Timeleft: $diff ??");
+ }
+ }
+ }
+}
+
+sub do_command($$$) {
+ my ($command,$nick,$server) = @_;
+
+ $command = lc $command;
+ $command =~ s/\s*$//;
+
+ if ($command =~ /^!bang$/) {
+ $server->command("msg $nick BOOM!");
+ } elsif ($command =~ /^admin/) {
+ if ($command !~ /^admin (.*)$/) {
+ $server->command("msg $nick admin needs a nick to change the admin user to!");
+ } else {
+ Irssi::settings_remove("quiz_admin");
+ Irssi::settings_add_str("misc","quiz_admin",$1);
+ $server->command("msg $nick admin user is now $1");
+ }
+ } else {
+ $server->command("msg $nick Unknown command '$command'");
+ }
+}
+
+sub check_answer($$$$) {
+ my ($server,$channel,$nick,$text) = @_;
+ my $game = $s->{$server->{'tag'}}->{$channel};
+
+ return if not exists $game->{'teams'}->{$nick};
+
+ $text =~ s/\s*$//;
+
+ if (lc $text eq lc $game->{'answer'}) {
+ $server->command("msg $channel Correct answer by ".
+ ($game->{'teams'}->{$nick} eq "blue"?"12":"4").
+ $nick.": ".$game->{'answer'});
+ $game->{'state'}="won";
+ $game->{$game->{'teams'}->{$nick}."score"}++;
+ $game->{'scores'}->{$game->{'teams'}->{$nick}.$nick}++;
+ show_scores($game);
+ return;
+ }
+
+ my $show=0;
+ my @chars = split //,$text;
+
+ for (my $i=0; $i<length($game->{'answer'}); $i++) {
+ if (lc $chars[$i] eq lc substr($game->{'answer'},$i,1)) {
+ $show = 1 if substr($game->{'current_answer'},$i,1)
+ eq "*";
+ substr($game->{'current_answer'},$i,1) =
+ substr($game->{'answer'},$i,1);
+ }
+ }
+ $server->command("msg $channel Answer: ".$game->{'current_answer'})
+ if $show;
+}
+
+sub event_privmsg {
+ my ($server,$data,$nick,$address) = @_;
+ my ($target, $text) = split / :/,$data,2;
+ my ($command);
+
+ if ($target =~ /^#/) {
+ my $game = $s->{$server->{'tag'}}->{$target};
+ if ($text =~ /^!/) {
+ do_pubcommand($text,$target,$server,$nick);
+ } elsif ($game->{'state'} eq "question") {
+ check_answer($server,$target,$nick,$text);
+ }
+ } else {
+ if ($nick ne Irssi::settings_get_str("quiz_admin")) {
+ my ($passwd);
+ ($passwd, $command) = split /\s/,$text,2;
+ if ($passwd ne Irssi::settings_get_str("quiz_passwd")) {
+ Irssi::print("$nick tried to do $command but got the password wrong.");
+ }
+ } else {
+ $command = $text;
+ }
+ do_command($command,$nick,$server);
+ }
+}
+
+sub event_changed_nick {
+ my ($channel,$nick,$oldnick) = @_;
+ my $server = $channel->{'server'};
+ my $game = $s->{$server->{'tag'}}->{$channel->{'name'}};
+
+ return if !$game->{'state'};
+
+ my $nicktxt = $nick->{'nick'};
+ if ($game->{'teams'}->{$oldnick}) {
+ $game->{'teams'}->{$nicktxt} = $game->{'teams'}->{$oldnick};
+ delete $game->{'teams'}->{$oldnick};
+ }
+}
+
+}
+
+Irssi::signal_add_last("event privmsg", "event_privmsg");
+Irssi::signal_add("nicklist changed", "event_changed_nick");
diff --git a/scripts/quizgr.pl b/scripts/quizgr.pl
new file mode 100644
index 0000000..a2d36df
--- /dev/null
+++ b/scripts/quizgr.pl
@@ -0,0 +1,655 @@
+#!/usr/bin/perl -T
+# Quizgr script for irssi with "KAOS" questions enabled, modified for greek too
+# copyright Athanasius Emilius Arvanitis
+# arvan@kronos.eng.auth.gr
+# based on quiz.pl version 0.7
+# Quiz script for irssi
+# (C) Simon Huggins 2001
+# huggie@earth.li
+
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the Free
+# Software Foundation; either version 2 of the License, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+# for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc., 59
+# Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# DONE:
+# - support for many answers (not alternate though) per question
+# - support for hellenic (aka greek)
+# - remembers the questions that were answered (stores them in
+# ./wr/used_questions)
+# - if nobody says anything for a period of time, game ends
+# - added !repeat to repeat the question
+# - it wont crash if you smile!
+# TODO:
+# - known bug: sometimes it ignores some people (they cant join etc).
+# if you join #CHANNEL and the bot is on #channel forget it...
+# - fix kaos hints
+# - if we have kaos, there should be more time to answer
+# - CLEAN up the code
+# - Do something when people quit (remove from team, readd when rejoin?)
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi 20020217.1542 (); # Version 0.8.1 or perhaps get the most up to date irssi version
+$VERSION = "0.7GR03";
+%IRSSI = (
+authors => "Athanasius Emilius Arvanitis based on Simon Huggins quiz 0.7",
+contact => "arvan",
+name => "Quizgr",
+description => "Turns irssi into a quiz bot. Has greek language and many answers support",
+license => "GPLv2",
+url => "http://kronos.eng.auth.gr/~arvan/irssi/",
+changed => "Tue Nov 26 13:37:59 EET 2002",
+);
+
+use Irssi::Irc;
+use Data::Dumper;
+
+Irssi::settings_add_str("misc","quiz_admin","jbg");
+Irssi::settings_add_str("misc","quiz_passwd","stuff");
+Irssi::settings_add_str("misc","quiz_file","$ENV{HOME}/.irssi/scripts/autorun/gr_quiz_questions");
+Irssi::settings_add_str("misc","used_file","$ENV{HOME}/.irssi/scripts/autorun/wr/used_questions");
+
+Irssi::settings_add_int("misc","quiz_qlength",70);
+Irssi::settings_add_int("misc","quiz_hints",7);
+Irssi::settings_add_int("misc","quiz_target_score",50);
+Irssi::settings_add_int("misc","quiz_leave_concealed_chars",1);
+
+Irssi::command("set cmd_queue_speed 2010");
+
+{
+# when warnings used $s complains
+my $s;
+my $answerBAKforCHAOS;
+
+sub load_questions($$) {
+ my ($game,$force) = @_;
+ my $tag = $game->{'tag'};
+ my $channel = $game->{'channel'};
+
+ $game->{'used_questions'}=[];
+
+ my $server = Irssi::server_find_tag($tag);
+
+ if (!defined $server) {
+ Irssi::print("Hrm, couldn't find server for tag ($tag) in load_questions");
+ return;
+ }
+
+ return if $game->{'questions'} and not $force;
+
+ #the next must be checked
+
+ my $file = Irssi::settings_get_str("quiz_file");
+ if (open(QS, "<", $file)) { #open for QS
+ @{$game->{'questions'}}=sort <QS>;
+ close(QS);
+ Irssi::print("Loaded questions");
+
+ my $file2 = Irssi::settings_get_str("used_file");
+ if (open(QS2, "<", $file2)) { #open for QS2
+ @{$game->{'used_questions'}}=sort <QS2>;
+ close(QS2);
+
+ #from perlfaq copy paste
+ @{$game->{'intersection'}} = @{$game->{'difference'}} = ();
+ %{$game->{'count'}} = ();
+
+ my $element;
+ foreach $element (@{$game->{'questions'}}, @{$game->{'used_questions'}}) { ${$game->{'count'}}{$element}++ };
+
+ foreach $element (keys %{$game->{'count'}}) { #open foreach
+ push @{ ${$game->{'count'}}{$element} > 1 ? \@{$game->{'intersection'}} : \@{$game->{'difference'}} }, $element;
+ } #close foreach
+
+ my $ts = Irssi::settings_get_int("quiz_target_score");
+ my $qCounter=@{$game->{'questions'}};
+ ${$game->{'usedCounter'}}=@{$game->{'used_questions'}};
+
+ my $qGOT=($qCounter - ${$game->{'usedCounter'}});
+ my $qNEEDED=(2*($ts)+12);
+ Irssi::print("${$game->{'usedCounter'}} used out of $qCounter total questions");
+
+ if ( $qGOT >= $qNEEDED ) {
+ @{$game->{'questions'}}=@{$game->{'difference'}};
+ Irssi::print("Loaded not used questions");
+ return 1;#used
+ }
+
+ if ( $qGOT < $qNEEDED ) {
+ @{$game->{'used_questions'}}=();
+ Irssi::print("Clearing used questions");
+ return 1;#used
+ }
+ } #close QS2
+
+ return 1;#questions
+ } #close QS
+
+ else {
+ $server->command("msg $channel Can't find quiz questions, sorry.");
+ return;
+ }
+
+
+
+}
+
+sub start_game($) {
+ my $game = shift;
+ my $tag = $game->{'tag'};
+ my $channel = $game->{'channel'};
+ my $server = Irssi::server_find_tag($tag);
+
+ if (!defined $server) {
+ Irssi::print("Hrm, couldn't find server for tag ($tag) in start_game");
+ return;
+ }
+
+ Irssi::timeout_remove($game->{'timeouttag'});
+ undef $game->{'timeouttag'};
+
+ if (!keys %{$game->{'teams'}}) {
+ $server->command("msg $channel Sorry no one joined!");
+ $game->{'state'} = "over";
+ game_over($game);
+ return;
+ }
+
+ $game->{'state'} = "game";
+
+ $server->command("msg $channel Game starts now. Questions last ".
+ Irssi::settings_get_int("quiz_qlength").
+ " seconds and there are ".
+ (Irssi::settings_get_int("quiz_hints")-1).
+ " hints. First to reach ".
+ Irssi::settings_get_int("quiz_target_score")." wins.");
+ next_question($game);
+}
+
+sub show_scores($) {
+ my $game = shift;
+ my $tag = $game->{'tag'};
+ my $channel = $game->{'channel'};
+ my $server = Irssi::server_find_tag($tag);
+
+ if (!defined $server) {
+ Irssi::print("Hrm, couldn't find server for tag ($tag) in show_scores");
+ return;
+ }
+
+ my (@redscorers,@bluescorers);
+
+ foreach my $score (sort keys %{$game->{'scores'}}) {
+ if ($score =~ /^blue/) {
+ $score =~ s/^blue//;
+ push @bluescorers, "$score(".
+ $game->{'scores'}->{"blue".$score}.")";
+ } else {
+ $score =~ s/^red//;
+ push @redscorers, "$score(".
+ $game->{'scores'}->{"red".$score}.")";
+ }
+ }
+
+ $server->command("msg $channel 12Blue: ".$game->{'bluescore'}
+ ." ".join(",",@bluescorers));
+ $server->command("msg $channel 4Red: ".$game->{'redscore'}
+ ." ".join(",",@redscorers));
+
+ my $ts = Irssi::settings_get_int("quiz_target_score");
+
+ if ($game->{'bluescore'} >= $ts or $game->{'redscore'} >= $ts) {
+ if ($game->{'bluescore'} > $game->{'redscore'}) {
+ $server->command("msg $channel 12Blue team wins ".
+ $game->{'bluescore'}." to ".
+ $game->{'redscore'});
+ } else {
+ $server->command("msg $channel 4Red team wins ".
+ $game->{'redscore'}." to ".
+ $game->{'bluescore'});
+ }
+ $game->{'state'}="over";
+ } elsif ($game->{'state'} ne "over") {
+ $game->{'state'}="pause";
+ $server->command("msg $channel Next question in 6 20 seconds.");
+ if ($game->{'timeouttag'}) {
+ Irssi::timeout_remove($game->{'timeouttag'});
+ }
+ $game->{'timeouttag'} = Irssi::timeout_add(20000,
+ "next_question",$game);
+ $game->{'timeout'} = time() + 20;
+ }
+ game_over($game);
+}
+
+sub hint($) {
+ my $game = shift;
+ my $tag = $game->{'tag'};
+ my $channel = $game->{'channel'};
+ my $server = Irssi::server_find_tag($tag);
+
+ if (!defined $server) {
+ Irssi::print("Hrm, couldn't find server for tag ($tag) in hint");
+ return;
+ }
+
+ return if game_over($game);
+ if ($game->{'end'} <= time()) {
+ $server->command("msg $channel Time's up. The answer is: 2 ".$game->{'answer'});
+ show_scores($game);
+ } else {
+ $game->{'hint'}++;
+ my $num = $game->{'current_answer'} =~ s/\*/*/g;
+ if ($num <= Irssi::settings_get_int("quiz_leave_concealed_chars")) {
+ return;
+ }
+
+ my $pos = index($game->{'current_answer'},"*");
+ if ($pos >= 0) {
+ #$game->{'current_answer'} =~ s/\*/substr($game->{'answer'},$pos,1)/e;
+ $game->{'current_answer'} =~ s/\*/substr($answerBAKforCHAOS,$pos,1)/e;
+ }
+
+ my $hinttime = $game->{'hint'}*$game->{'hintlen'};
+ if ($hinttime != int($hinttime)) {
+ $hinttime = sprintf("%.2f", $hinttime);
+ }
+ $server->command("msg $channel 2 $hinttime second hint: 6 ".
+ $game->{'current_answer'});
+ } #else end
+}
+
+sub game_over($) {
+ my $game = shift;
+ my $tag = $game->{'tag'};
+ my $channel = $game->{'channel'};
+ my $server = Irssi::server_find_tag($tag);
+
+ if (!defined $server) {
+ Irssi::print("Hrm, couldn't find server for tag ($tag) in game_over");
+ return;
+ }
+
+ if ($game->{'state'} eq "over") {
+ Irssi::timeout_remove($game->{'timeouttag'});
+ undef $game->{'timeouttag'};
+ undef $game->{'state'};
+ undef $game->{'teams'};
+ undef $game->{'scores'};
+
+ #save used questions
+ my $file2 = Irssi::settings_get_str("used_file");
+ if (open(QS2, ">", $file2)) {
+ my $line;
+ @{$game->{'used_questions'}}=sort @{$game->{'used_questions'}};
+ foreach $line (@{$game->{'used_questions'}}){
+ print QS2 $line ;
+ }
+ close(QS2);
+ Irssi::print("Saved used questions");
+ }
+
+
+ $server->command("msg $channel Trivia is disabled. Use !start or !trivon to restart.");
+ return 1;
+ }
+ return;
+}
+
+sub next_question($) {
+ my $game = shift;
+ my $tag = $game->{'tag'};
+ my $channel = $game->{'channel'};
+ my $server = Irssi::server_find_tag($tag);
+
+ if (!defined $server) {
+ Irssi::print("Hrm, couldn't find server for tag ($tag) in next_question");
+ return;
+ }
+
+ #check previous text time and
+ #if noone says anything for 180 seconds end game
+ if (defined $game->{'time_last_text'}) {
+ my $diff2=time() - $game->{'time_last_text'};
+ if ( $diff2 > 180) {
+ $game->{'state'}="over";
+ }
+ }
+
+
+ my $len = Irssi::settings_get_int("quiz_qlength")/
+ Irssi::settings_get_int("quiz_hints");
+ if ($game->{'timeouttag'}) {
+ Irssi::timeout_remove($game->{'timeouttag'});
+ }
+ $game->{'timeouttag'} = Irssi::timeout_add($len*1000, "hint",$game);
+ my $t = time();
+ $game->{'timeout'} = $t + $len;
+ $game->{'end'} = Irssi::settings_get_int("quiz_qlength")+$t;
+ $game->{'hint'}=0;
+ $game->{'hintlen'} = $len;
+ if (!@{$game->{'questions'}}) {
+ load_questions($game,1);
+ if (!$game->{'questions'}) {
+ $server->command("msg $channel Hmmm, no questions found sorry");
+ $game->{'state'}="over";
+ }
+ Irssi::print("Questions looped");
+ }
+ return if game_over($game);
+
+ #random question
+ ${$game->{'randIDX'}}= @{$game->{'questions'}};
+ ${$game->{'randIDX'}}=rand(${$game->{'randIDX'}});
+ my $q = ${$game->{'questions'}}[${$game->{'randIDX'}}];
+ ${$game->{'the_question'}} = $q;
+
+ #removing it from the questions
+ splice (@{$game->{'questions'}}, ${$game->{'randIDX'}}, 1);
+
+ #see faq for splice/random may be bad
+ #my $q = splice(@{$game->{'questions'}},rand(@{$game->{'questions'}}),1);
+ chomp $q;
+ $q =~ s///;
+ #($game->{'answer'} = $q) =~ s/^(.*)\|//;
+
+ ($game->{'question'}, $game->{'answer'}) = split(/\|/, $q,2);
+ $answerBAKforCHAOS = $game->{'answer'};
+ if ( $game->{'answer'} =~ /\|/ )
+ { $server->command("msg $channel KAOS CHAOS ×ÁÏÓ!!!");
+ $game->{'answer'} = $game->{'answer'}."|";
+
+ }
+ $server->command("msg $channel 13Question: 10 $game->{'question'} ");
+ #added Á-Ùá-ù so it can hide greek too
+ ($game->{'current_answer'} = $game->{'answer'}) =~ s/[a-zA-Z0-9Á-Ùá-ù]/*/g;
+ #$q = s/^(.*)\|.*?$/$1/;
+ $server->command("msg $channel Answer: ".$game->{'current_answer'});
+ $game->{'state'}="question";
+}
+
+sub invite_join($$) {
+ my ($server,$channel) = @_;
+ my $game = $s->{$server->{'tag'}}->{$channel};
+
+ $server->command("msg $channel Team Trivia thingummie v($VERSION) starts in 1 minute. Type 4!join red or 12!join blue");
+ $game->{'timeouttag'} = Irssi::timeout_add(60000,"start_game",$game);
+ $game->{'timeout'} = time()+60;
+}
+
+sub secstonormal($) {
+ my $seconds = shift;
+ my ($m,$s);
+
+ $s = $seconds % 60;
+ $m = ($seconds - $s)/60;
+ return sprintf("%02d:%02d",$m,$s);
+}
+
+sub do_pubcommand($$$$) {
+ my ($command,$channel,$server,$nick) = @_;
+ my $game = $s->{$server->{'tag'}}->{$channel};
+
+ $command = lc $command;
+ $command =~ s/\s*$//;
+
+ if ($command =~ /^!bang$/) {
+ $server->command("msg $channel Dumping...");
+ foreach (split /\n/,Dumper($s)) {
+ Irssi::print("$_");
+ }
+ } elsif ($command =~ /^!trivon$|^!start$|!ðÜìå$/) {
+ if ($s->{$server->{'tag'}}->{$channel}) {
+ if ($s->{$server->{'tag'}}->{$channel}->{'state'}) {
+ $server->command("msg $nick Trivia is already on. Use !trivoff or !stop to remove it.");
+ return;
+ }
+ #undef $s->{$server->{'tag'}}->{$channel};
+ } else {
+ # create structure magically
+ $game = $s->{$server->{'tag'}}->{$channel} = {};
+ $game->{'tag'} = $server->{'tag'};
+ $game->{'channel'} = $channel;
+ }
+ $game->{'teams'}={};
+ $game->{'redscore'} = 0;
+ $game->{'bluescore'} = 0;
+ load_questions($game,0);
+ $game->{'state'} = "join";
+ invite_join($server,$channel);
+ } elsif ($command =~ /^!trivoff$|^!stop$|!öôÜíåé$/) {
+ return if !$game->{'state'};
+ $game->{'state'}="over";
+ game_over($game);
+ } elsif ($command =~ /^!join/) {
+ if ($command =~ /^!join (red|blue)$/) {
+ return if !$game->{'state'};
+ $game->{'teams'}->{$nick}=$1;
+ if ($1 eq "blue") {
+ $server->command("notice $nick You have joined the 12Blue team");
+ } else {
+ $server->command("notice $nick You have joined the 4Red team");
+ }
+ }
+ } elsif ($command =~ /^!teams/) {
+ return if !$game->{'state'};
+ my @blue=();
+ my @red=();
+ foreach (sort keys %{$game->{'teams'}}) {
+ push @blue, $_ if $game->{'teams'}->{$_} eq "blue";
+ push @red, $_ if $game->{'teams'}->{$_} eq "red";
+ }
+ $server->command("msg $channel 12Blue: ".join(",",@blue));
+ $server->command("msg $channel 4Red : ".join(",",@red));
+ } elsif ($command =~ /^!repeat$/) {
+ return if !$game->{'state'};
+ $server->command("msg $channel Question is $game->{'question'}");
+ } elsif ($command =~ /^!timeleft$/) {
+ if ($game->{'state'} eq "join" and $game->{'timeout'}) {
+ my $diff = $game->{'timeout'} - time();
+ if ($diff > 0) {
+ $server->command("msg $channel Time left: ".secstonormal($diff));
+ } else {
+ Irssi::print("Timeleft: $diff ??");
+ }
+ }
+ }
+}
+
+sub do_command($$$) {
+ my ($command,$nick,$server) = @_;
+
+ $command = lc $command;
+ $command =~ s/\s*$//;
+
+ if ($command =~ /^!bang$/) {
+ $server->command("msg $nick BOOM!");
+ } elsif ($command =~ /^admin/) {
+ if ($command !~ /^admin (.*)$/) {
+ $server->command("msg $nick admin needs a nick to change the admin user to!");
+ } else {
+ Irssi::settings_remove("quiz_admin");
+ Irssi::settings_add_str("misc","quiz_admin",$1);
+ $server->command("msg $nick admin user is now $1");
+ }
+ } else {
+ #$server->command("msg $nick Unknown command '$command'");
+ }
+}
+
+#check check_answer for bad { }
+
+sub check_answer($$$$) {
+ my ($server,$channel,$nick,$text) = @_;
+ my $game = $s->{$server->{'tag'}}->{$channel};
+
+ return if not exists $game->{'teams'}->{$nick};
+
+ #if $text exist check time and remembers it for end-game
+ if (defined $text) {
+ $game->{'time_last_text'} = time();
+ }
+
+
+ $text =~ s/\s*$//;
+ $text =~ s/^ //;
+ $text =~ s/ $//;
+
+ #from cgi input-purify / try without it and it will crash with :(
+ #dont know if it needs em all, may check it in future
+
+ if ($text =~ s/([\&;\`'\\\|"*?~<>^\(\)\[\]\{\}\$\n\r])/\\$1/g)
+ { $text="abcdef";
+ }
+ # is the above the reason it didnt join?
+
+ #if greek supports troubles you comment the next
+ $text =~ y/ÜÝÞßúÀüýûàþ¢¶¸¹ºÚ¼¾Û¿ÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÓÔÕÖ×ØÙ/áåçéééïõõõù¶áåçééïõõùáâãäåæçèéêëìíîïðñóôõö÷øù/;
+
+ my $answerNOtonos = lc $game->{'answer'};
+ #if greek supports troubles you comment the next
+ $answerNOtonos =~ y/ÜÝÞßúÀüýûàþ¢¶¸¹ºÚ¼¾Û¿ÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÓÔÕÖ×ØÙ/áåçéééïõõõù¶áåçééïõõùáâãäåæçèéêëìíîïðñóôõö÷øù/;
+
+ if ( $answerNOtonos =~ /\|/) {
+
+ if ( ($answerNOtonos =~ /\|$text\|/)||($answerNOtonos =~ /^$text\|/) )
+ {
+ $answerNOtonos =~ s/$text\|//;
+
+ $game->{'answer'}=$answerNOtonos;
+
+
+ $server->command("msg $channel 2Correct answer by ".
+ ($game->{'teams'}->{$nick} eq "blue"?"12":"4").
+ $nick.": ".$text);
+
+ $game->{$game->{'teams'}->{$nick}."score"}++;
+ $game->{'scores'}->{$game->{'teams'}->{$nick}.$nick}++;
+
+ if ($answerNOtonos eq "") {
+
+ #putting it in used
+ if (@{$game->{'used_questions'}}){
+ ${$game->{'usedCounter'}} = @{$game->{'used_questions'}};
+ } else {${$game->{'usedCounter'}}=0;}
+
+ ${$game->{'used_questions'}}[${$game->{'usedCounter'}}]=${$game->{'the_question'}};
+
+ $game->{'state'}="won";
+
+ $server->command("msg $channel 2 $answerBAKforCHAOS") ;
+ show_scores($game);
+ return;
+ }
+
+ #show_scores($game);
+ }
+ }
+
+
+ elsif (( $answerNOtonos !~ /\|/) && (lc $text eq $answerNOtonos)) {
+
+ $server->command("msg $channel 2Correct answer by ".
+ ($game->{'teams'}->{$nick} eq "blue"?"12":"4").
+ $nick.": ".$game->{'answer'});
+ $game->{'state'}="won";
+
+ #putting it in used
+ if (@{$game->{'used_questions'}}){
+ ${$game->{'usedCounter'}} = @{$game->{'used_questions'}};
+ } else {${$game->{'usedCounter'}} =0;}
+
+ ${$game->{'used_questions'}}[${$game->{'usedCounter'}}]=${$game->{'the_question'}};
+
+ $game->{$game->{'teams'}->{$nick}."score"}++;
+ $game->{'scores'}->{$game->{'teams'}->{$nick}.$nick}++;
+ show_scores($game);
+ return;
+ }
+
+
+
+ my $show=0;
+ my @chars = split //,$text;
+
+ for (my $i=0; $i<length($game->{'answer'}); $i++) {
+ if (lc $chars[$i] eq lc substr($game->{'answer'},$i,1)) {
+ $show = 1 if substr($game->{'current_answer'},$i,1)
+ eq "*";
+ substr($game->{'current_answer'},$i,1) =
+ substr($game->{'answer'},$i,1);
+ }
+ }
+
+ $server->command("msg $channel Answer: ".$game->{'current_answer'})
+ if $show;
+}
+
+
+
+sub event_privmsg {
+ my ($server,$data,$nick,$address) = @_;
+ my ($target, $text) = split / :/,$data,2;
+ my ($command);
+
+ if ($target =~ /^#/) {
+ my $game = $s->{$server->{'tag'}}->{$target};
+ if ($text =~ /^!/) {
+ do_pubcommand($text,$target,$server,$nick);
+ } elsif ($game->{'state'} eq "question") {
+ check_answer($server,$target,$nick,$text);
+ }
+ } else {
+ if ($nick ne Irssi::settings_get_str("quiz_admin")) {
+ my ($passwd);
+ ($passwd, $command) = split /\s/,$text,2;
+ if ($passwd ne Irssi::settings_get_str("quiz_passwd")) {
+ #Irssi::print("$nick tried to do $command but got the password wrong.");
+ Irssi::print("$nick got the password wrong.");
+ }
+ } else {
+ $command = $text;
+ }
+ do_command($command,$nick,$server);
+ }
+}
+
+sub event_changed_nick {
+ my ($channel,$nick,$oldnick) = @_;
+ my $server = $channel->{'server'};
+ my $game = $s->{$server->{'tag'}}->{$channel->{'name'}};
+
+ return if !$game->{'state'};
+
+ my $nicktxt = $nick->{'nick'};
+ if ($game->{'teams'}->{$oldnick}) {
+ $game->{'teams'}->{$nicktxt} = $game->{'teams'}->{$oldnick};
+ delete $game->{'teams'}->{$oldnick};
+ }
+
+}
+
+
+}
+
+Irssi::signal_add_last("event privmsg", "event_privmsg");
+# Irssi::signal_add_last("massjoin", "sig_massjoin");
+#Irssi::signal_add_last("message nick", "on_nick"); #when /nick
+#Irssi::signal_add_last("message part", "on_part");
+#Irssi::signal_add_last("message join", "on_join");
+#Irssi::signal_add_last("message quit", "on_quit");
+
+# Channel::nicks(channel) Return a list of all nicks in channel.
+
+Irssi::signal_add("nicklist changed", "event_changed_nick");
diff --git a/scripts/quizmaster.pl b/scripts/quizmaster.pl
new file mode 100644
index 0000000..e226075
--- /dev/null
+++ b/scripts/quizmaster.pl
@@ -0,0 +1,354 @@
+# Quizmaster.pl by Stefan "tommie" Tomanek (stefan@pico.ruhr.de)
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '20170403';
+%IRSSI = (
+ authors => 'Stefan \'tommie\' Tomanek',
+ contact => 'stefan@pico.ruhr.de',
+ name => 'quizmaster',
+ description => 'a trivia script for Irssi',
+ license => 'GPLv2',
+ url => 'http://irssi.org/scripts/',
+ changed => $VERSION,
+ modules => 'Data::Dumper',
+ commands => "quizmaster"
+);
+
+use Irssi;
+use Data::Dumper;
+
+use vars qw(%sessions %questions);
+
+sub show_help() {
+ my $help = "quizmaster $VERSION
+/quizmaster
+ List the running sessions
+/quizmaster import <name> <filename>
+ Import a database (moxxquiz format)
+/quizmaster save
+ Save all imported questions
+/quizmaster start <db1> <db2>...
+ Start a new game in the current channel using the named databases
+ if all databases are omitted, all available are used
+/quizmaster score
+ Display the scoretable of the current game
+/quizmaster hint <number>
+ Give a number of hints
+";
+ my $text='';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP &draw_box("Quizmaster", $text, "quizmaster help", 1);
+}
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub save_quizfile {
+ local *F;
+ my $filename = Irssi::settings_get_str("quizmaster_questions_file");
+ open(F, ">",$filename);
+ my $dumper = Data::Dumper->new([\%questions], ['quest']);
+ $dumper->Purity(1)->Deepcopy(1);
+ my $data = $dumper->Dump;
+ print (F $data);
+ close(F);
+ print CLIENTCRAP '%R>>%n Quizmaster questions saved to '.$filename;
+}
+
+sub load_quizfile ($) {
+ my ($file) = @_;
+ no strict 'vars';
+ return unless -e $file;
+ my $text;
+ local *F;
+ open F,'<', $file;
+ $text .= $_ foreach (<F>);
+ close F;
+ return unless "$text";
+ %questions = %{ eval "$text" };
+}
+
+sub import_quizfile ($$) {
+ my ($name, $file) = @_;
+ local *F;
+ open(F,'<', $file);
+ my @data = <F>;
+ my @questions;
+ my $quest = {};
+ foreach (@data) {
+ if (/^(.*?): (.*?)$/) {
+ my $item = $1;
+ my $desc = $2;
+ if ($item eq 'Question') {
+ $quest->{question} = $desc;
+ } elsif ($item eq 'Category') {
+ $quest->{category} = $desc;
+ } elsif ($item eq 'Answer') {
+ my $answer = $desc;
+ if ($answer =~ /(.*?)#(.*?)#(.*?)$/) {
+ $answer = '';
+ $answer .= '('.$1.')?' if ($1);
+ $answer .= $2;
+ $answer .= '('.$3.')?' if ($3);
+ }
+ push @{$quest->{answers}}, $answer;
+ } elsif ($item eq 'Regexp') {
+ push @{$quest->{answers}}, $desc;
+ }
+ } elsif (/^$/) {
+ if (defined $quest->{question} && defined $quest->{answers}) {
+ push @questions, $quest;
+ $quest = {};
+ }
+ }
+ }
+ $questions{$name} = \@questions;
+ print CLIENTCRAP "%R>>>%n ".scalar(@questions)." questions have been imported from ".$file;
+}
+
+sub add_questions ($$) {
+ my ($target, $name) = @_;
+ push @{$sessions{$target}{questions}}, $name;
+}
+
+sub ask_question ($) {
+ my ($target) = @_;
+ my ($database, $current) = @{$sessions{$target}{current}};
+ my $question = $questions{$database}->[$current]{question};
+ my $category = '';
+ $category = '['.$questions{$database}->[$current]{category}.']' if defined $questions{$database}->[$current]{category};
+ line2target($target, '>>> '.$category.' '.$question);
+}
+
+sub start_quiz ($) {
+ my ($channel) = @_;
+ line2target($channel, '>>>> A new Quiz has been started <<<<');
+ new_question($channel);
+}
+
+sub stop_quiz ($) {
+ my ($target) = @_;
+ show_scores($target);
+ line2target($target, '>>>> The Quiz has been stopped <<<<');
+ delete $sessions{$target};
+}
+
+sub event_public_message ($$$$) {
+ my ($server, $text, $nick, $address, $target) = @_;
+ check_answer($nick, $text, $target) if defined $sessions{$target} and $sessions{$target}{asking};
+}
+
+sub event_message_own_public ($$$) {
+ my ($server, $msg, $target, $otarget) = @_;
+ check_answer($server->{nick}, $msg, $target) if defined $sessions{$target} and $sessions{$target}{asking};
+}
+
+sub check_answer ($$$) {
+ my ($nick, $text, $target) = @_;
+ my ($database, $answer) = @{$sessions{$target}{current}};
+ my @answers = @{$questions{$database}->[$answer]{answers}};
+ foreach (@answers) {
+ my $regexp = $_;
+ if ($text =~ /$regexp/i) {
+ $sessions{$target}{asking} = 0;
+ solved_question($nick, $target);
+ last;
+ }
+ }
+}
+
+sub solved_question ($$) {
+ my ($nick, $target) = @_;
+ line2target($target, '<<< '.$nick.' solved this question');
+ my $witem = Irssi::window_item_find($target);
+ $sessions{$target}{score}{$nick}++;
+ my $max_points = Irssi::settings_get_int('quizmaster_points_to_win');
+ if ($sessions{$target}{score}{$nick} >= $max_points) {
+ line2target($target, '>>> '.$nick.' has '.$sessions{$target}{score}{$nick}.' points and is the winner.');
+ stop_quiz($target);
+ } else {
+ $sessions{$target}{solved} = 1;
+ $sessions{$target}{next} = time();
+ }
+}
+
+sub new_question ($) {
+ my ($target) = @_;
+ $sessions{$target}{solved} = 0;
+ my $d_num = int( (scalar(@{$sessions{$target}{questions}})-1)*rand() );
+ my $database = $sessions{$target}{questions}->[$d_num];
+ my $new_question = int(scalar(@{$questions{$database}})*rand());
+ $sessions{$target}{current} = [$database, $new_question];
+ $sessions{$target}{timestamp} = time();
+ ask_question($target);
+ $sessions{$target}{asking} = 1;
+}
+
+sub expire_questions {
+ foreach my $target (keys %sessions) {
+ my $expire = Irssi::settings_get_int('quizmaster_timeout');
+ my $pause = Irssi::settings_get_int('quizmaster_pause');
+ if ($sessions{$target}{timestamp}+$expire <= time()) {
+ line2target($target, '>>> No correct answer within '.$expire.' seconds.');
+ new_question($target);
+ } else {
+ my $left = ($sessions{$target}{timestamp}+$expire)-time();
+ #line2target($target, ' >>>> '.$left.' seconds left');
+ }
+ if ($sessions{$target}{solved} && $sessions{$target}{next}+$pause <= time()) {
+ new_question($target);
+ }
+ }
+}
+
+sub give_hint ($$) {
+ my ($target, $level) = @_;
+ my $database = $sessions{$target}{current}->[0];
+ my $current = $sessions{$target}{current}->[1];
+ my $answer = $questions{$database}->[$current]{answers}->[0];
+ my $tip;
+ # remove RegExp stuff
+ $answer =~ s/\(//g;
+ $answer =~ s/\)//g;
+ $answer =~ s/\?//g;
+ foreach (0..length($answer)-1) {
+ if (substr($answer, $_, 1) eq ' ') {
+ $tip .= ' ';
+ } else {
+ $tip .= '_';
+ }
+ }
+ foreach (0..$level) {
+ my $pos = int( rand()*(length($answer)-1) );
+ my $char = substr($answer, $pos, 1);
+ my $pre = substr($tip, 0, $pos);
+ my $post = substr($tip, $pos+1);
+ $tip = $pre.$char.$post;
+ }
+ return $tip;
+}
+
+sub line2target ($$) {
+ my ($target, $line) = @_;
+ my $witem = Irssi::window_item_find($target);
+ $witem->{server}->command('MSG '.$target.' '.$line);
+ #$witem->print('MSG '.$target.' '.$line);
+}
+
+sub show_scores ($) {
+ my ($target) = @_;
+ my $table;
+ foreach (sort {$sessions{$target}{score}{$b} <=> $sessions{$target}{score}{$a}} keys(%{$sessions{$target}{score}})) {
+ $table .= "$_ now has ".$sessions{$target}{score}{$_}." points.\n";
+ }
+ my $box = draw_box('Quizmaster for Irssi', $table, 'score', 0);
+ line2target($target, $_) foreach (split(/\n/, $box));
+}
+
+sub list_databases {
+ my $msg;
+ my $sum = 0;
+ foreach (sort keys %questions) {
+ $msg .= '%U'.$_.'%U '."\n";
+ $msg .= ' '.scalar(@{$questions{$_}}).' questions available'."\n";
+ $sum += scalar(@{$questions{$_}});
+ }
+ $msg .= '|'."\n";
+ $msg .= '`===> '.$sum.' questions total'."\n";
+ print CLIENTCRAP &draw_box("Quizmaster", $msg, "databases", 1);
+}
+
+sub list_sessions {
+ my $msg;
+ foreach (sort keys %sessions) {
+ $msg .= '`->%U'.$_.'%U '."\n";
+ $msg .= ' '.scalar(keys %{$sessions{$_}{score}}).' users scored.'."\n";
+ }
+ print CLIENTCRAP &draw_box("Quizmaster", $msg, "sessions", 1);
+}
+
+sub event_nicklist_changed ($$$) {
+ my ($channel, $nick, $oldnick) = @_;
+ my $target = $channel->{name};
+ return unless (defined $sessions{$target} && $sessions{$target}{score}{$oldnick});
+ my $points = $sessions{$target}{score}{$oldnick};
+ $sessions{$target}{score}{$nick->{nick}} = $points;
+ delete $sessions{$target}{score}{$oldnick};
+}
+
+sub init {
+ my $filename = Irssi::settings_get_str('quizmaster_questions_file');
+ load_quizfile($filename);
+}
+
+sub cmd_quizmaster ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @arg = split(/ /, $args);
+ if (scalar(@arg) == 0) {
+ list_sessions();
+ } elsif ($arg[0] eq 'import') {
+ import_quizfile($arg[1], $arg[2]);
+ } elsif ($arg[0] eq 'save') {
+ save_quizfile();
+ } elsif ($arg[0] eq 'load') {
+ init();
+ } elsif ($arg[0] eq 'start') {
+ shift(@arg);
+ if (scalar @arg == 0) {
+ add_questions($witem->{name}, $_) foreach (keys %questions);
+ } else {
+ foreach (@arg) {
+ add_questions($witem->{name}, $_) if defined $questions{$_};
+ }
+ }
+ start_quiz($witem->{name});
+ } elsif ($arg[0] eq 'stop') {
+ stop_quiz($witem->{name});
+ } elsif ($arg[0] eq 'score') {
+ show_scores($witem->{name}) if defined $sessions{$witem->{name}};
+ } elsif ($arg[0] eq 'next') {
+ new_question($witem->{name}) if defined $sessions{$witem->{name}};
+ } elsif ($arg[0] eq 'hint') {
+ line2target($witem->{name}, give_hint($witem->{name}, $arg[1]));
+ } elsif ($arg[0] eq 'list') {
+ list_databases;
+ } elsif ($arg[0] eq 'help') {
+ show_help();
+ }
+}
+
+Irssi::command_bind($IRSSI{'name'}, \&cmd_quizmaster);
+foreach my $cmd ('import', 'load', 'save', 'list', 'help', 'next', 'hint', 'score', 'stop', 'start') {
+Irssi::command_bind('quizmaster '.$cmd => sub {
+ cmd_quizmaster("$cmd ".$_[0], $_[1], $_[2]); });
+}
+
+
+Irssi::settings_add_int($IRSSI{'name'}, 'quizmaster_points_to_win', 20);
+Irssi::settings_add_int($IRSSI{'name'}, 'quizmaster_timeout', 60);
+Irssi::settings_add_int($IRSSI{'name'}, 'quizmaster_pause', 10);
+Irssi::settings_add_str($IRSSI{'name'}, 'quizmaster_questions_file', "$ENV{HOME}/.irssi/quizmaster_questions");
+
+Irssi::signal_add('message public', 'event_public_message');
+Irssi::signal_add('message own_public', 'event_message_own_public');
+Irssi::signal_add('nicklist changed', 'event_nicklist_changed');
+
+
+Irssi::timeout_add(5000, 'expire_questions', undef);
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /quizmaster help for help';
+
+init();
diff --git a/scripts/rainbow.pl b/scripts/rainbow.pl
new file mode 100644
index 0000000..df6501d
--- /dev/null
+++ b/scripts/rainbow.pl
@@ -0,0 +1,173 @@
+#!/usr/bin/perl -w
+
+# USAGE:
+#
+# /RSAY <text>
+# - same as /say, but outputs a coloured text
+#
+# /RME <text>
+# - same as /me, but outputs a coloured text
+#
+# /RTOPIC <text>
+# - same as /topic, but outputs a coloured text :)
+#
+# /RKICK <nick> [reason]
+# - kicks nick from the current channel with coloured reason
+#
+# /RKNOCKOUT [time] <nicks> [reason]
+# - knockouts nicks from the current channel with coloured reason for time
+
+# Written by Jakub Jankowski <shasta@atn.pl>
+# for Irssi 0.7.98.4 and newer
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.6";
+%IRSSI = (
+ authors => 'Jakub Jankowski',
+ contact => 'shasta@atn.pl',
+ name => 'rainbow',
+ description => 'Prints colored text. Rather simple than sophisticated.',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.atn.pl/',
+);
+
+use Irssi;
+use Irssi::Irc;
+use Encode;
+
+# colors list
+# 0 == white
+# 4 == light red
+# 8 == yellow
+# 9 == light green
+# 11 == light cyan
+# 12 == light blue
+# 13 == light magenta
+my @colors = ('0', '4', '8', '9', '11', '12', '13');
+
+# str make_colors($string)
+# returns random-coloured string
+sub make_colors {
+ my ($string) = @_;
+ Encode::_utf8_on($string);
+ my $newstr = "";
+ my $last = 255;
+ my $color = 0;
+
+ for (my $c = 0; $c < length($string); $c++) {
+ my $char = substr($string, $c, 1);
+ if ($char eq ' ') {
+ $newstr .= $char;
+ next;
+ }
+ while (($color = int(rand(scalar(@colors)))) == $last) {};
+ $last = $color;
+ $newstr .= "\003";
+ $newstr .= sprintf("%02d", $colors[$color]);
+ $newstr .= $char;
+ }
+
+ return $newstr;
+}
+
+# void rsay($text, $server, $destination)
+# handles /rsay
+sub rsay {
+ my ($text, $server, $dest) = @_;
+
+ if (!$server || !$server->{connected}) {
+ Irssi::print("Not connected to server");
+ return;
+ }
+
+ return unless $dest;
+
+ if ($dest->{type} eq "CHANNEL" || $dest->{type} eq "QUERY") {
+ $dest->command("/msg " . $dest->{name} . " " . make_colors($text));
+ }
+}
+
+# void rme($text, $server, $destination)
+# handles /rme
+sub rme {
+ my ($text, $server, $dest) = @_;
+
+ if (!$server || !$server->{connected}) {
+ Irssi::print("Not connected to server");
+ return;
+ }
+
+ if ($dest && ($dest->{type} eq "CHANNEL" || $dest->{type} eq "QUERY")) {
+ $dest->command("/me " . make_colors($text));
+ }
+}
+
+# void rtopic($text, $server, $destination)
+# handles /rtopic
+sub rtopic {
+ my ($text, $server, $dest) = @_;
+
+ if (!$server || !$server->{connected}) {
+ Irssi::print("Not connected to server");
+ return;
+ }
+
+ if ($dest && $dest->{type} eq "CHANNEL") {
+ $dest->command("/topic " . make_colors($text));
+ }
+}
+
+# void rkick($text, $server, $destination)
+# handles /rkick
+sub rkick {
+ my ($text, $server, $dest) = @_;
+
+ if (!$server || !$server->{connected}) {
+ Irssi::print("Not connected to server");
+ return;
+ }
+
+ if ($dest && $dest->{type} eq "CHANNEL") {
+ my ($nick, $reason) = split(/ +/, $text, 2);
+ return unless $nick;
+ $reason = "Irssi power!" if ($reason =~ /^[\ ]*$/);
+ $dest->command("/kick " . $nick . " " . make_colors($reason));
+ }
+}
+
+# void rknockout($text, $server, $destination)
+# handles /rknockout
+sub rknockout {
+ my ($text, $server, $dest) = @_;
+
+ if (!$server || !$server->{connected}) {
+ Irssi::print("Not connected to server");
+ return;
+ }
+
+ if ($dest && $dest->{type} eq "CHANNEL") {
+ my ($time, $nick, $reason) = split(/ +/, $text, 3);
+ ($time, $nick, $reason) = (300, $time, $nick . " " . $reason) if ($time !~ m/^\d+$/);
+ return unless $nick;
+ $reason = "See you in " . $time . " seconds!" if ($reason =~ /^[\ ]*$/);
+ $dest->command("/knockout " . $time . " " . $nick . " " . make_colors($reason));
+ }
+}
+
+Irssi::command_bind("rsay", "rsay");
+Irssi::command_bind("rtopic", "rtopic");
+Irssi::command_bind("rme", "rme");
+Irssi::command_bind("rkick", "rkick");
+Irssi::command_bind("rknockout", "rknockout");
+
+# changes:
+#
+# 25.01.2002: Initial release (v1.0)
+# 26.01.2002: /rtopic added (v1.1)
+# 29.01.2002: /rsay works with dcc chats now (v1.2)
+# 02.02.2002: make_colors() doesn't assign any color to spaces (v1.3)
+# 23.02.2002: /rkick added
+# 26.11.2014: utf-8 support
+# 01.12.2014: /rknockout added (v1.6)
diff --git a/scripts/randaway.pl b/scripts/randaway.pl
new file mode 100644
index 0000000..91c8d38
--- /dev/null
+++ b/scripts/randaway.pl
@@ -0,0 +1,119 @@
+#!/usr/bin/perl -w
+# $Id: randaway.pl,v 1.12 2003/01/10 10:47:04 lkarsten Exp lkarsten $
+# Irssi script for random away-messages.
+#
+# adds /raway, /awayadd, /awayreasons and /awayreread.
+#
+# Based on simular script written by c0ffee.
+# original version made public in march 2002.
+#
+# changelog:
+# sep/02 - kuba wszolek (hipis@linux.balta.pl) reported problems with multiple
+# servers in v1.8 .. proposed fix is imported.
+# jan/03 - Wouter Coekaerts (wouter@coekaerts.be) provided fix using
+# get_irssi_dir() instead of $ENV[]. imported.
+#
+
+use strict;
+use Irssi 20011116;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.14';
+%IRSSI = (
+ authors => "Lasse Karstensen",
+ contact => "lkarsten\@stud.ntnu.no",
+ name => "randaway.pl",
+ description => "Random away-messages",
+ license => "Public Domain",
+ url => "http://www.stud.ntnu.no/~lkarsten/irssi/",
+);
+
+# file to read random reasons from. It should contain one
+# reason at each line, empty lines and lines starting with # is
+# skipped.
+my $reasonfile = Irssi::get_irssi_dir() . "/awayreasons";
+
+my @awayreasons;
+
+sub readreasons {
+ undef @awayreasons;
+ if (-f $reasonfile) {
+ Irssi::print("=> Trying to read awayreasons from $reasonfile");
+ open F, "<", $reasonfile;
+
+ # this actually makes the while() work like a while and not
+ # like a read() .. ie, stopping at each \n.
+ local $/ = "\n";
+ while (<F>) {
+ my $reason = $_;
+
+ # remove any naughty linefeeds.
+ chomp($reason);
+
+ # skips reason if it's an empty line or line starts with #
+ if ($reason =~ /^$/ ) { next; }
+ if ($reason =~ /^#/ ) { next; }
+
+ Irssi::print("\"$reason\"");
+
+ # adds to array.
+ push(@awayreasons, $reason);
+ }
+ close F;
+ Irssi::print("=> Read " . scalar(@awayreasons) . " reasons.");
+ } else {
+ # some default away-reasons.
+ Irssi::print("Unable to find $reasonfile, no reasons loaded.");
+ push(@awayreasons, "i\'m pretty lame!");
+ push(@awayreasons, "i think i forgot something!");
+ };
+}
+
+sub cmd_away {
+ # only do our magic if we're not away already.
+
+ if (Irssi::active_server()->{usermode_away} == 0) {
+ my ($reason) = @_;
+ # using supplied reason if .. eh, supplied, else find a random one if not.
+ if (!$reason) { $reason = $awayreasons[rand @awayreasons]; }
+ Irssi::print("awayreason used: $reason");
+ my $server = Irssi::servers();
+ $server->command('AWAY '.$reason);
+ } else {
+ Irssi::print("you're already away");
+ }
+}
+
+sub add_reason {
+ my ($reason) = @_;
+ if (!$reason) {
+ Irssi::print("Refusing to add empty reason.");
+ } else {
+ chomp($reason);
+ # adding to current environment.
+ push(@awayreasons, $reason);
+ # and also saving it for later.
+ open(F, ">>", $reasonfile);
+ print F $reason,"\n";
+ close F;
+ Irssi::print("Added: $reason");
+ }
+}
+
+sub reasons {
+ Irssi::print("Listing current awayreasons");
+ foreach my $var (@awayreasons) {
+ Irssi::print("=> \"$var\"");
+ }
+}
+
+# -- main program --
+
+readreasons();
+Irssi::command_bind('raway', 'cmd_away');
+Irssi::command_bind('awayreread', 'readreasons');
+Irssi::command_bind('awayadd', 'add_reason');
+Irssi::command_bind('awayreasons', 'reasons');
+
+# -- end of script --
diff --git a/scripts/randname.pl b/scripts/randname.pl
new file mode 100644
index 0000000..df5ae36
--- /dev/null
+++ b/scripts/randname.pl
@@ -0,0 +1,46 @@
+# RandName 1.1
+#
+# set a random real name taken from a file
+#
+# derived from quitmsg.pl by Timo Sirainen
+
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.1';
+%IRSSI = (
+ authors => 'legion',
+ contact => 'a.lepore(at)email.it',
+ name => 'RandName',
+ description => 'Random "/set real_name" taken from a file.',
+ license => 'Public Domain',
+ changed => 'Sat Dec 6 12:28:04 CET 2003',
+);
+
+sub randname {
+
+ my $namefile = (glob Irssi::settings_get_str('random_realname_file'))[0];
+
+ open (FILE, "<", $namefile) || return;
+ my $lines = 0; while(<FILE>) { $lines++; };
+ my $line = int(rand($lines))+1;
+
+ my $realname;
+ seek(FILE, 0, 0); $. = 0;
+ while(<FILE>) {
+ next if ($. != $line);
+ chomp;
+ $realname = $_;
+ last;
+ }
+ close(FILE);
+
+ Irssi::print("%9RandName.pl%_:", MSGLEVEL_CRAP);
+ Irssi::command("set real_name $realname");
+
+} ##
+
+Irssi::signal_add('gui exit', 'randname');
+Irssi::command_bind('randname', 'randname');
+Irssi::settings_add_str('misc', 'random_realname_file', '~/.irssi/irssi.realnames');
diff --git a/scripts/relm.pl b/scripts/relm.pl
new file mode 100644
index 0000000..460423e
--- /dev/null
+++ b/scripts/relm.pl
@@ -0,0 +1,93 @@
+## Usage: /RELM [-l || index] [target]
+## to list last 15 messages:
+## /RELM -l
+## to redirect msg #4, 7, 8, 9, 10, 13 to current channel/query:
+## /RELM 4,7-10,13
+## to redirect last message to current channel/query:
+## /RELM
+
+use strict;
+use Irssi;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.1";
+%IRSSI = (
+ authors => "Maciek \'fahren\' Freudenheim",
+ contact => "fahren\@bochnia.pl",
+ name => "REdirect Last Message",
+ description => "Keeps last 15 messages in cache",
+ license => "GNU GPLv2 or later",
+ changed => "2019-02-25"
+);
+
+my %relm=();
+
+sub cmd_relm {
+ my ($args, $server, $winit) = @_;
+ my $ircnet = lc($server->{tag});
+ my ($which, $where) = split(/ +/, $args, 2);
+
+ $where = $which unless $which =~ /[0-9]/;
+
+ unless ($relm{$ircnet}) {
+ Irssi::print("%R>>%n Nothing in relm buffer on $ircnet.", MSGLEVEL_CRAP);
+ return;
+ }
+
+ $which = scalar(@{$relm{lc($ircnet)}}) unless ($which);
+
+ if ($where eq "-l") {
+ my $numspace;
+ Irssi::print(">> ---- Context ------------------------", MSGLEVEL_CRAP);
+ for (my $i = 0; $i < scalar(@{$relm{$ircnet}}); $i++) {
+ $numspace = sprintf("%.2d", $i+1);
+ Irssi::print("[%W$numspace%n] $relm{$ircnet}[$i]", MSGLEVEL_CRAP);
+ }
+ return;
+ }
+
+ unless ($where) {
+ unless ($winit && ($winit->{type} eq "CHANNEL" || $winit->{type} eq "QUERY")) {
+ Irssi::print("%R>>%n You have to join channel first", MSGLEVEL_CRAP);
+ return;
+ }
+ $where = $winit->{name};
+ }
+
+ $which =~ s/,/ /g;
+ my @nums;
+ for my $num (split(/ /, $which)) {
+ if ($num =~ /-/) {
+ my ($start, $end) = $num =~ /([0-9]+)-([0-9]*)/;
+ for (;$start <= $end; $start++) {
+ push(@nums, $start - 1);
+ }
+ } else {
+ push(@nums, $num - 1);
+ }
+ }
+
+ for my $num (@nums) {
+ unless ($relm{$ircnet}[$num]) {
+ Irssi::print("%R>>%n No such message in relm buffer /" . ($num + 1). "/", MSGLEVEL_CRAP);
+ } else {
+ Irssi::active_server()->command("msg $where $relm{$ircnet}[$num]");
+ }
+ }
+}
+
+sub event_privmsg {
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $text) = split(/ :/, $data, 2);
+ my $ircnet = lc($server->{tag});
+
+ return if ($server->{nick} ne $target);
+ my $relm = "\00312[ \00310$nick!$address \00312]\003 $text";
+ if ( exists $relm{$ircnet} ) {
+ shift(@{$relm{$ircnet}}) if scalar(@{$relm{$ircnet}}) > 14;
+ }
+ push(@{$relm{$ircnet}}, $relm);
+}
+
+Irssi::command_bind("relm", "cmd_relm");
+Irssi::signal_add("event privmsg", "event_privmsg");
diff --git a/scripts/remote.pl b/scripts/remote.pl
new file mode 100644
index 0000000..6accead
--- /dev/null
+++ b/scripts/remote.pl
@@ -0,0 +1,91 @@
+#!/usr/bin/perl -w
+use strict;
+use Irssi 20010120.0250 ();
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.1";
+%IRSSI = (
+ authors => 'David Leadbeater',
+ contact => 'dgl@dgl.cx',
+ name => 'remote',
+ description => 'Lets you run commands remotely via /msg and a password',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.dgl.cx/',
+);
+
+
+# Usage:
+# as your user /remote on (uncomment the $remote = 1 line below if you want it
+# on by default)
+# /msg user remote login password
+# then /msg user remote command
+# it will execute the command on the same server...
+# so you can do mode #channel +o whoever
+# but it will allow any command, yes it's dangerous if someone knows the
+# password they can access just about anything your user account can....
+# set password with /remote passwd <password>
+my $password = "pp00000000";
+my($login,$remote);
+# $remote = 1;
+
+sub event{
+ my($server,$text,$nick,$hostmask)=@_;
+# if you're really paranoid change this....
+ if($text =~ s/^remote\s+//i){
+ my $ok;
+ $ok = 1 if $login eq $nick."!".$hostmask;
+ $ok = 0 if !defined $remote;
+ my($command,$options) = split(/ /,$text,2);
+ if($command eq "login"){
+ if(crypt($options,substr($password,0,2)) eq $password){
+ $login = $nick."!".$hostmask;
+ }else{
+ Irssi::print("Invaild login attempt from $nick ($hostmask): $text");
+ }
+ }elsif(!$ok){
+ Irssi::print("Invaild remote use from $nick ($hostmask): $text");
+ }elsif($ok){
+ Irssi::command("/".$text);
+ }
+ }
+}
+
+sub remote{
+ my($args) = shift;
+ if($args eq "enable" or $args eq "on"){
+ $remote = 1;
+ } elsif (index($args, 'password') != -1) {
+ cmd_passwd($args);
+ }else{
+ $remote = undef;
+ }
+}
+
+sub cmd_passwd {
+ my ($args)= @_;
+ my @arg= split(/\s+/, $args);
+ my @chars= map {chr($_)} (0x41 .. 0x5a, 0x61 .. 0x7a, 0x30 .. 0x39, 0x2e);
+ my $len= scalar(@chars);
+ my $salt= '';
+ foreach (1..2) {
+ $salt .= $chars[int(rand($len))];
+ }
+ Irssi::settings_set_str($IRSSI{name}.'_password', crypt($arg[1],$salt));
+}
+
+sub sig_setup_changed {
+ $password = Irssi::settings_get_str($IRSSI{name}.'_password');
+ if (length($password) != 13) {
+ $password = "pp00000000";
+ }
+}
+
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_password','pp00000000');
+
+Irssi::signal_add('setup changed','sig_setup_changed');
+Irssi::signal_add_last("message private", "event");
+Irssi::command_bind("remote", "remote");
+Irssi::command_bind("remote password", "remote");
+
+sig_setup_changed();
+
+# vim:set sw=3 ts=4:
diff --git a/scripts/repeat.pl b/scripts/repeat.pl
new file mode 100644
index 0000000..0d70b72
--- /dev/null
+++ b/scripts/repeat.pl
@@ -0,0 +1,144 @@
+use Irssi;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION="0.2.0";
+%IRSSI = (
+ authors=> 'BC-bd',
+ contact=> 'bd@bc-bd.org',
+ name=> 'repeat',
+ description=> 'Hide duplicate lines',
+ license=> 'GPL v2',
+ url=> 'http://bc-bd.org/blog/irssi/',
+);
+
+# repeal.pl: ignore repeated messages
+#
+# for irssi 0.8.5 by bd@bc-bd.org
+#
+#########
+# USAGE
+###
+#
+# This script hides repeated lines from:
+#
+# dude> Plz Help me!!!
+# dude> Plz Help me!!!
+# dude> Plz Help me!!!
+# guy> foo
+#
+# Becomes:
+#
+# dude> Plz Help me!!!
+# guy> foo
+#
+# Or with 'repeat_show' set to ON:
+#
+# dude> Plz Help me!!!
+# Irssi: Message repeated 3 times
+# guy> foo
+#
+#########
+# OPTIONS
+#########
+#
+# /set repeat_show <ON|OFF>
+# * ON : show info line: 'Message repeated N times'
+# * OFF : don't show it.
+#
+# /set repeat_count <N>
+# N : Display a message N times, then ignore it.
+#
+###
+################
+###
+# Changelog
+#
+# Version 0.2.0
+# - addes support for /me
+#
+# Version master
+# - updated url
+#
+# Version 0.1.3
+# - fix: also check before own message (by Wouter Coekaerts)
+#
+# Version 0.1.2
+# - removed stray debug message (duh!)
+#
+# Version 0.1.1
+# - off by one fixed
+# - fixed missing '$'
+#
+# Version 0.1.0
+# - initial release
+#
+my %said;
+my %count;
+
+sub sig_public {
+ my ($server, $msg, $nick, $address, $target) = @_;
+
+ my $maxcount = Irssi::settings_get_int('repeat_count');
+
+ my $window = $server->window_find_item($target);
+ my $refnum = $window->{refnum};
+
+ my $this = $refnum.$nick.$msg;
+
+ my $last = $said{$refnum};
+ my $i = $count{$refnum};
+
+ if ($last eq $this and not $nick eq $server->{nick}) {
+ $count{$refnum} = $i +1;
+
+ if ($i >= $maxcount) {
+ Irssi::signal_stop();
+ }
+ } else {
+ if ($i > $maxcount && Irssi::settings_get_bool('repeat_show')) {
+ $window->print("Message repeated ".($i-1)." times");
+ }
+
+ $count{$refnum} = 1;
+ $said{$refnum} = $this;
+ }
+}
+
+sub sig_own_public {
+ my ($server, $msg, $target) = @_;
+ sig_public ($server, $msg, $server->{nick}, "", $target);
+}
+
+sub remove_window {
+ my ($num) = @_;
+
+ delete($count{$num});
+ delete($said{$num});
+}
+
+sub sig_refnum {
+ my ($window,$old) = @_;
+ my $refnum = $window->{refnum};
+
+ $count{$refnum} = $count{old};
+ $said{$refnum} = $count{old};
+
+ remove_window($old);
+}
+
+sub sig_destroyed {
+ my ($window) = @_;
+ remove_window($window->{refnum});
+}
+
+Irssi::signal_add('message public', 'sig_public');
+Irssi::signal_add('message own_public', 'sig_own_public');
+Irssi::signal_add('message irc action', 'sig_public');
+Irssi::signal_add_last('window refnum changed', 'sig_refnum');
+Irssi::signal_add_last('window destroyed', 'sig_destroyed');
+
+Irssi::settings_add_int('misc', 'repeat_count', 1);
+Irssi::settings_add_bool('misc', 'repeat_show', 1);
+
diff --git a/scripts/resize_split.pl b/scripts/resize_split.pl
new file mode 100644
index 0000000..1744419
--- /dev/null
+++ b/scripts/resize_split.pl
@@ -0,0 +1,62 @@
+use Irssi;
+use strict;
+use vars qw/$VERSION %IRSSI/;
+$VERSION = 1.0;
+%IRSSI = (
+ authors => 'David Leadbeater',
+ contact => 'dgl@dgl.cx',
+ name => 'resize_split',
+ description => 'Resizes a split window when it is made active (see comments in script for details)',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.dgl.cx/',
+);
+
+# This script is for if you have a split window for status (or anything else)
+# it makes it bigger when it's active.
+# (The way I have Irssi setup is with a split status window along the top,
+# created with /window show 1 in a channel window).
+
+# For example you do a command that outputs a large amount of text into
+# the status window such as /help or /motd (depending on what you put in
+# your status window). Then simply hit alt+up and the status window resizes
+# to give you more room to read the output, when you go back to another window
+# the status window will automatically go back to its previous size.
+
+# BUGS (mostly due to lack of Irssi API for split windows).
+# As far as I can see there is no easy way to find out where in a split a
+# window is displayed, so if more than one window is sticky inside a split
+# and you set that window in the setting below this script will have problems.
+# Also if you have more than 2 split windows things won't work as expected.
+
+# Setting: resize_windows
+# A space seperated list of windows that you want to be resized when you
+# change to them.
+# If it contains something that's not a (permanently displayed) split window
+# then windows will probably end up with incorrect sizes.
+Irssi::settings_add_str("misc", "resize_windows", "1");
+
+Irssi::signal_add("window changed", \&winchg);
+
+sub winchg {
+ my($newwin, $oldwin) = @_;
+ if(is_resized($oldwin->{refnum})) {
+ my $height = $oldwin->{height} - $newwin->{height};
+ return if $height < 0; # Work around bug in Irssi, minus numbers here
+ # do weird things (i.e. grow without error
+ # checking)
+ $oldwin->command("window shrink $height");
+ }
+
+ if(is_resized($newwin->{refnum})) {
+ my $height = $oldwin->{height} - $newwin->{height};
+ return if $height < 0; # same problem as above..
+ $newwin->command("window grow $height");
+ }
+}
+
+sub is_resized {
+ for my $refnum(split ' ', Irssi::settings_get_str("resize_windows")) {
+ return 1 if $refnum == $_[0];
+ }
+}
+
diff --git a/scripts/revolve.pl b/scripts/revolve.pl
new file mode 100644
index 0000000..1ccfaa9
--- /dev/null
+++ b/scripts/revolve.pl
@@ -0,0 +1,388 @@
+use strict;
+use warnings;
+use Irssi;
+use Irssi::TextUI;
+use POSIX 'strftime';
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.0.6"; # 29d237f4fda2f0d
+%IRSSI = (
+ authors => 'Ryan Freebern',
+ contact => 'ryan@freebern.org',
+ name => 'revolve',
+ description => 'Summarizes multiple sequential joins/parts/quits.',
+ license => 'GPL v2 or later',
+ url => 'http://github.com/rfreebern/irssi-revolving-door',
+);
+
+# Based on compact.pl by Wouter Coekaerts <wouter@coekaerts.be>
+# http://wouter.coekaerts.be/irssi/scripts/compact.pl.html
+
+# Usage
+# =====
+# Once loaded, the script will summarise and remove any
+# JOINS/PARTS/QUITS/NICKS
+
+# Options
+# =======
+# /set revolve_show_nickchain <ON|OFF>
+# * whether more than two nick names should be shown when people
+# change nicks
+#
+# /set revolve_modes <ON|OFF>
+# * whether MODES should also be summarised
+#
+# /set revolve_show_rejoins <ON|OFF>
+# * whether rejoins should be displayed instead of clearing them out
+# from QUITS/PARTS silently
+#
+# /set revolve_show_time <ON|OFF>
+# * whether timestamp should be displayed before and after the summary
+# line
+#
+
+# To change the look and feel, edit the script source code below:
+
+# -----8<------ do not change this part ----->8-----
+use constant {
+ JOINS => +MSGLEVEL_JOINS,
+ PARTS => +MSGLEVEL_PARTS,
+ QUITS => +MSGLEVEL_QUITS,
+ NICKS => +MSGLEVEL_NICKS,
+ REJOINS => (+MSGLEVEL_JOINS|+MSGLEVEL_PARTS),
+ MODES => +MSGLEVEL_MODES,
+};
+
+
+my %msg_level_text;
+
+# ====================== CONFIGURABLE SECTION START ======================
+#
+# IMPORTANT: all texts and all separators must be distinguishable and
+# one must not be a substring of another!
+#
+#
+# here are the heading texts to be shown on the summary line:
+#
+@msg_level_text{(JOINS, PARTS, QUITS, NICKS, REJOINS, MODES)}=qw/Joins Parts Quits Nicks Cycles Status/;
+#
+# here after the => are the colour styles to be used for the above heading texts:
+#
+my %msg_level_style = (
+ # style before heading text
+ JOINS() => '%C%I',
+ PARTS() => '%c%I',
+ QUITS() => '%c%I',
+ NICKS() => '%K%I',
+ REJOINS() => '%C%I',
+ MODES() => '%K%I',
+ # style after heading text separator
+ 0 => '%I%w',
+ # line colour
+ -1 => '%w',
+ );
+#
+# here is the time format / style to use if time display is enabled:
+# %%H:%%M are passed to strftime
+#
+my $time_format = '%X5N' . '%%H:%%M' . '%w';
+#
+# here are the separators used on the summary line:
+my $level_separator = ' ── ';
+my $nick_separator = ', ';
+my $type_separator = ': ';
+my $new_nick_separator = ' → ';
+my $time_separator = ' | ';
+#
+# here is the line indentation (10 spaces):
+#
+my $indentation = ' 'x10;
+#
+# ======================= CONFIGURABLE SECTION END =======================
+#
+#
+#
+
+my %summary_lines;
+my %msg_level_constant = reverse %msg_level_text;
+my %prefix_tbl;
+
+sub lrtrim {
+ for (@_) {
+ s/^\s+//; s/\s+$//;
+ }
+}
+
+sub dotime {
+ my $time = time;
+ my $format = $time_format;
+ $format =~ y/%/\01/;
+ $format =~ s/\01\01/%/g;
+ $format = strftime($format, localtime $time);
+ $format =~ y/\01/%/;
+ $format
+}
+
+sub summarize {
+ my ($window, $tag, $channel, $nick, $arg, $type) = @_;
+
+ return unless $window;
+ my $view = $window->view;
+ my $check = $tag . ':' . $channel;
+
+ my $tb = $view->get_bookmark('trackbar');
+ $view->set_bookmark_bottom('bottom');
+ my $last = $view->get_bookmark('bottom');
+ if ($tb && $last->{_irssi} == $tb->{_irssi}) {
+ $last = $last->prev;
+ }
+ my $secondlast = $last ? $last->prev : undef;
+ if ($tb && $secondlast && $secondlast->{_irssi} == $tb->{_irssi}) {
+ $secondlast = $secondlast->prev;
+ }
+
+ # Remove the last line, which should have the join/part/quit message.
+ return unless $last->{info}{level} & $type;
+ $view->remove_line($last);
+
+ my $pt = $prefix_tbl{$tag} || [];
+ my $ptrim = $pt->[0] ? qr/^([\Q$pt->[0]\E]*)/ : qr/^()/;
+
+ # If the second-to-last line is a summary line, parse it.
+ my %door = (JOINS() => [], PARTS() => [], QUITS() => [], NICKS() => [], REJOINS() => [], MODES() => []);
+ my @summarized = ();
+ my $old_time = dotime();
+ my $new_time = $old_time;
+ if ($secondlast and $summary_lines{$check} and $secondlast->{_irssi} == $summary_lines{$check}) {
+ my $csummary = $secondlast->get_text(1);
+ my ($time, @x) = split /\Q$time_separator/, $csummary, 3;
+ my $summary = $secondlast->get_text(0);
+ $summary = (split /\Q$time_separator/, $summary, 3)[1] if @x;
+ lrtrim $summary;
+ $time = '' unless @x;
+ lrtrim $time;
+ @summarized = split(/\Q$level_separator/, $summary);
+ lrtrim @summarized;
+ foreach my $part (@summarized) {
+ my ($type, $nicks) = split(/\Q$type_separator/, $part, 2);
+ lrtrim $nicks;
+ my $ctype = $msg_level_constant{$type};
+ $door{$ctype} = [ split(/\Q$nick_separator/, $nicks) ];
+ if ($ctype == JOINS || $ctype == REJOINS) {
+ for (@{$door{$ctype}}) {
+ s/$ptrim//;
+ $_ = [ $1, $_ ]
+ }
+ } elsif ($ctype == MODES) {
+ for (@{$door{$ctype}}) {
+ s/^([\Q$pt->[0]\E:]*)//;
+ $_ = [ $1, $_ ];
+ }
+ }
+ }
+ $view->remove_line($secondlast);
+ $old_time = $time;
+ }
+
+ my $rejoins = Irssi::settings_get_bool('revolve_show_rejoins');
+ my $nickchain = Irssi::settings_get_bool('revolve_show_nickchain');
+ if ($type == JOINS) { # Join
+ if (grep { $_ eq $nick } @{$door{+PARTS}}, @{$door{+QUITS}}) {
+ for (PARTS, QUITS) {
+ @{$door{+$_}} = grep { $_ ne $nick } @{$door{+$_}};
+ }
+ push(@{$door{+REJOINS}}, [ '', $nick ])
+ if $rejoins;
+ } else {
+ push(@{$door{+$type}}, [ '', $nick ]);
+ }
+ } elsif ($type == QUITS || $type == PARTS) { # Quit / Part
+ for (MODES) {
+ @{$door{+$_}} = grep { $_->[1] ne $nick } @{$door{+$_}};
+ }
+ if (grep { $_->[1] eq $nick } @{$door{+JOINS}}, @{$door{+REJOINS}}) {
+ for (JOINS, REJOINS) {
+ @{$door{+$_}} = grep { $_->[1] ne $nick } @{$door{+$_}};
+ }
+ push @{$door{+$type}}, $nick
+ if $rejoins;
+ } else {
+ push @{$door{+$type}}, $nick;
+ }
+ } elsif ($type == NICKS) {
+ my $new_nick = $arg;
+ my $nick_found = 0;
+ foreach my $known_nick (@{$door{+NICKS}}) {
+ my @alt_nicks = split(/\Q$new_nick_separator/, $known_nick);
+ my $orig_nick = $alt_nicks[0];
+ my $current_nick = $alt_nicks[-1];
+ if ($current_nick eq $nick) {
+ if ($new_nick eq $orig_nick) {
+ if ($nickchain) {
+ $known_nick = $new_nick;
+ } else {
+ @{$door{+NICKS}} = grep { $_ ne $known_nick } @{$door{+NICKS}};
+ }
+ } else {
+ if ($nickchain) {
+ @alt_nicks = grep { $_ ne $orig_nick && $_ ne $new_nick } @alt_nicks;
+ $known_nick = join $new_nick_separator, $orig_nick, @alt_nicks, $new_nick;
+ } else {
+ $known_nick = "$orig_nick$new_nick_separator$new_nick";
+ }
+ }
+ $nick_found = 1;
+ last;
+ }
+ }
+ if (!$nick_found) {
+ push(@{$door{+NICKS}}, "$nick$new_nick_separator$new_nick");
+ }
+ # Update nicks in join lists.
+ foreach my $part (JOINS, REJOINS, MODES) {
+ foreach (@{$door{$part}}) {
+ $_->[1] = $new_nick if $_->[1] eq $nick;
+ }
+ }
+ } elsif ($type == MODES) {
+ my $mode = $arg;
+ my ($spec, @args) = split ' ', $mode;
+ my $type = '+';
+ my $i = 0;
+ for my $c (split //, $spec) {
+ if ($c eq '+' || $c eq '-') {
+ $type = $c;
+ } else {
+ my @ent = grep { $_->[1] eq $args[$i] } @{$door{+JOINS}}, @{$door{+REJOINS}};
+ my $p = substr $pt->[0], (index $pt->[1], $c), 1;
+ if (@ent) {
+ if ($type eq '+') {
+ $ent[0][0] = $p . $ent[0][0];
+ } else {
+ $ent[0][0] =~ s/\Q$p\E//;
+ }
+ } elsif (my ($e) = grep { $_->[1] eq $args[$i]} @{$door{+MODES}}) {
+ my $pos = $e->[0];
+ my $neg = '';
+ if ($pos =~ s/^(.*)://) {
+ $neg = $1;
+ }
+ if ($type eq '+') {
+ $pos = $p . $pos;
+ $neg =~ s/\Q$p\E//;
+ } else {
+ $neg = $p . $neg;
+ $pos =~ s/\Q$p\E//;
+ }
+ $e->[0] = length $neg ? "$neg:$pos" : $pos;
+ } else {
+ push @{$door{+MODES}}, [ $type eq '+' ? $p : "$p:", $args[$i] ];
+ }
+ }
+ }
+ }
+
+ foreach my $part (JOINS, REJOINS, MODES) {
+ foreach (@{$door{$part}}) {
+ $_ = $_->[0].$_->[1];
+ }
+ }
+
+ @summarized = ();
+ my $level = MSGLEVEL_NEVER;
+ foreach my $part (JOINS, PARTS, QUITS, REJOINS, NICKS, MODES) {
+ if (@{$door{$part}}) {
+ push @summarized, $msg_level_style{$part} . $msg_level_text{$part} . $type_separator . $msg_level_style{0}
+ . join($nick_separator, @{$door{$part}});
+ $level |= $part;
+ }
+ }
+
+ my $summary = join($msg_level_style{-1}.$level_separator, @summarized);
+ if (Irssi::settings_get_bool('revolve_show_time')) {
+ $summary = $old_time.$msg_level_style{-1}.$time_separator.$summary;
+ $summary .= $msg_level_style{-1}.$time_separator.$new_time
+ if $old_time ne $new_time;
+ }
+ if (@summarized) {
+ $window->print($indentation. '%|'. $msg_level_style{-1}.$summary, $level);
+ # Get the line we just printed so we can log its ID.
+ $view->set_bookmark_bottom('bottom');
+ $last = $view->get_bookmark('bottom');
+ $summary_lines{$check} = $last->{_irssi};
+ } else {
+ delete $summary_lines{$check};
+ }
+
+ $view->redraw();
+}
+
+sub delete_and_summarize {
+ return unless our @summary;
+ my ($tag, $channel, $nick, $arg, $type) = @summary;
+ # "delete_and_summarize: $type";
+ my ($dest) = @_;
+ return unless $dest->{server} && $dest->{server}{tag} eq $tag;
+ return if defined $channel && $dest->{target} ne $channel;
+ &Irssi::signal_continue;
+ summarize($dest->{window}, $tag, $dest->{target}, $nick, $arg, $type);
+}
+
+sub summarize_join {
+ my ($server, $channel, $nick, $address, $reason) = @_;
+ local our @summary = ($server->{tag}, $channel, $nick, undef, JOINS);
+ &Irssi::signal_continue;
+}
+
+sub summarize_quit {
+ my ($server, $nick, $address, $reason) = @_;
+ local our @summary = ($server->{tag}, undef, $nick, undef, QUITS);
+ &Irssi::signal_continue;
+}
+
+sub summarize_part {
+ my ($server, $channel, $nick, $address, $reason) = @_;
+ local our @summary = ($server->{tag}, $channel, $nick, undef, PARTS);
+ &Irssi::signal_continue;
+}
+
+sub summarize_nick {
+ my ($server, $new_nick, $old_nick, $address) = @_;
+ local our @summary = ($server->{tag}, undef, $old_nick, $new_nick, NICKS);
+ &Irssi::signal_continue;
+}
+
+sub update_prefixes {
+ my ($server) = @_;
+ my $prefix = $server->can('isupport') && $server->isupport('prefix') || '(ohv)@%+';
+ $prefix =~ s/^\((.*?)\)//;
+ my $modes = $1;
+ $prefix_tbl{$server->{tag}} = [ $prefix, $modes ];
+}
+
+sub summarize_irc_mode {
+ my ($server, $channel, $nick, $address, $mode) = @_;
+ return unless Irssi::settings_get_bool('revolve_modes');
+ my ($spec, @args) = split ' ', $mode;
+ return unless @args;
+ update_prefixes($server) unless $prefix_tbl{$server->{tag}};
+ my $modes = $prefix_tbl{$server->{tag}}[1];
+ return unless $spec =~ /^([-+][\Q$modes\E]+)+$/;
+ local our @summary = ($server->{tag}, $channel, $nick, $mode, MODES);
+ &Irssi::signal_continue;
+ my $dest = $server->format_create_dest($channel, MSGLEVEL_MODES, $server->window_find_closest($channel, MSGLEVEL_MODES));
+ Irssi::signal_emit('print starting', $dest);
+}
+
+Irssi::signal_register({'print starting'=>[qw[Irssi::UI::TextDest]]});
+Irssi::settings_add_bool('revolve', 'revolve_show_nickchain', 0);
+Irssi::settings_add_bool('revolve', 'revolve_modes', 0);
+Irssi::settings_add_bool('revolve', 'revolve_show_rejoins', 0);
+Irssi::settings_add_bool('revolve', 'revolve_show_time', 0);
+Irssi::signal_add('message join', 'summarize_join');
+Irssi::signal_add('message part', 'summarize_part');
+Irssi::signal_add('message quit', 'summarize_quit');
+Irssi::signal_add('message nick', 'summarize_nick');
+Irssi::signal_add('message irc mode', 'summarize_irc_mode');
+Irssi::signal_add('print text', 'delete_and_summarize');
+Irssi::signal_add_last('event 376', 'update_prefixes');
diff --git a/scripts/rk.pl b/scripts/rk.pl
new file mode 100644
index 0000000..204ad61
--- /dev/null
+++ b/scripts/rk.pl
@@ -0,0 +1,53 @@
+# rk.pl/Irssi/fahren@bochnia.pl
+
+use Irssi 20020300;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.9";
+%IRSSI = (
+ authors => "Maciek \'fahren\' Freudenheim",
+ contact => "fahren\@bochnia.pl",
+ name => "Random kicker",
+ description => "/RK [-o | -l | -a] - kicks random nick from ops | lusers | all on channel",
+ license => "GNU GPLv2 or later",
+ changed => "Fri Mar 15 15:09:42 CET 2002"
+);
+
+sub cmd_rk {
+ my ($args, $server, $chan) = @_;
+
+ unless ($chan && $chan->{type} eq "CHANNEL" && $chan->{chanop}) {
+ Irssi::print("%R>>%n You aren't opped / You don't have active channel :/");
+ return;
+ }
+
+ my @data = split(/ /, $args);
+ my ($rk, @nicks);
+ $rk = 0;
+
+ while ($_ = shift(@data)) {
+ /^-a$/ and $rk = 2, next;
+ /^-o$/ and $rk = 1, next;
+ /^-l$/ and $rk = 0, next;
+ }
+
+ my $channel = $chan->{name};
+
+ for my $hash ($chan->nicks()) {
+ unless ($rk) {
+ next if $hash->{op};
+ } elsif ($rk eq 1 && !$hash->{op}) {next};
+
+ next if ($hash->{nick} eq $server->{nick});
+
+ push @nicks, $hash;
+ }
+
+ my $nnum = scalar(@nicks);
+ my $victim = $nicks[rand($nnum)]->{nick};
+
+ $server->send_raw("KICK $channel $victim :\002Random Kick\002");
+}
+
+Irssi::command_bind('rk', 'cmd_rk');
diff --git a/scripts/romaji.pl b/scripts/romaji.pl
new file mode 100644
index 0000000..7529ddd
--- /dev/null
+++ b/scripts/romaji.pl
@@ -0,0 +1,273 @@
+#!/usr/bin/perl -w
+#
+# Copyright (c) 2002 Victor Ivanov <v0rbiz@yahoo.com>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.0b3';
+%IRSSI = (
+ authors => 'Victor Ivanov',
+ contact => 'v0rbiz@yahoo.com',
+ name => 'romaji',
+ description => 'translates romaji to hiragana or katakana in text enclosed in ^R',
+ license => 'BSD 2-clause',
+ url => 'http://irssi.org/scripts/'
+);
+
+
+my(%hira) = (
+ "a" => "ã‚", "i" => "ã„", "u" => "ã†", "e" => "ãˆ", "o" => "ãŠ",
+ "ka" => "ã‹", "ki" => "ã", "ku" => "ã", "ke" => "ã‘", "ko" => "ã“",
+ "sa" => "ã•", "shi" => "ã—", "su" => "ã™", "se" => "ã›", "so" => "ã",
+ "ta" => "ãŸ", "chi" => "ã¡", "tsu" => "ã¤", "te" => "ã¦", "to" => "ã¨",
+ "na" => "ãª", "ni" => "ã«", "nu" => "ã¬", "ne" => "ã­", "no" => "ã®",
+ "ha" => "ã¯", "hi" => "ã²", "hu" => "ãµ", "he" => "ã¸", "ho" => "ã»", "fu" => "ãµ",
+ "ma" => "ã¾", "mi" => "ã¿", "mu" => "ã‚€", "me" => "ã‚", "mo" => "ã‚‚",
+ "ya" => "や", "yu" => "ゆ", "yo" => "よ",
+ "ra" => "ら", "ri" => "ã‚Š", "ru" => "ã‚‹", "re" => "ã‚Œ", "ro" => "ã‚",
+ "wa" => "ã‚", "wi" => "ã‚", "we" => "ã‚‘", "wo" => "ã‚’",
+ "n" => "ã‚“",
+ "m" => "ã‚“",
+
+ "ga" => "ãŒ", "gi" => "ãŽ", "gu" => "ã", "ge" => "ã’", "go" => "ã”",
+ "za" => "ã–", "ji" => "ã˜", "zu" => "ãš", "ze" => "ãœ", "zo" => "ãž",
+ "da" => "ã ", "dzi" => "ã¢", "dzu" => "ã¥", "de" => "ã§", "do" => "ã©",
+ "ba" => "ã°", "bi" => "ã³", "bu" => "ã¶", "be" => "ã¹", "bo" => "ã¼",
+ "pa" => "ã±", "pi" => "ã´", "pu" => "ã·", "pe" => "ãº", "po" => "ã½",
+
+ "fa" => "ãµã", "fi" => "ãµãƒ", "fe" => "ãµã‡", "fo" => "ãµã‰",
+ "di" => "ã§ãƒ",
+
+ "kya" => "ãゃ", "kyu" => "ãã‚…", "kyo" => "ãょ",
+ "sha" => "ã—ゃ", "shu" => "ã—ã‚…", "sho" => "ã—ょ",
+ "cha" => "ã¡ã‚ƒ", "chu" => "ã¡ã‚…", "cho" => "ã¡ã‚‡",
+ "nya" => "ã«ã‚ƒ", "nyu" => "ã«ã‚…", "nyo" => "ã«ã‚‡",
+ "hya" => "ã²ã‚ƒ", "hyu" => "ã²ã‚…", "hyo" => "ã²ã‚‡",
+ "mya" => "ã¿ã‚ƒ", "myu" => "ã¿ã‚…", "myo" => "ã¿ã‚‡",
+ "rya" => "りゃ", "ryu" => "りゅ", "ryo" => "りょ",
+ "gya" => "ãŽã‚ƒ", "gyu" => "ãŽã‚…", "gyo" => "ãŽã‚‡",
+ "ja" => "ã˜ã‚ƒ", "ju" => "ã˜ã‚…", "jo" => "ã˜ã‚‡",
+ "jya" => "ã˜ã‚ƒ", "jyu" => "ã˜ã‚…", "jyo" => "ã˜ã‚‡",
+ "dza" => "ã¢ã‚ƒ", "dju" => "ã¢ã‚…", "dzo" => "ã¢ã‚‡",
+ "dja" => "ã¢ã‚ƒ", "djo" => "ã¢ã‚‡",
+ "bya" => "ã³ã‚ƒ", "byu" => "ã³ã‚…", "byo" => "ã³ã‚‡",
+ "pya" => "ã´ã‚ƒ", "pyu" => "ã´ã‚…", "pyo" => "ã´ã‚‡",
+
+ "TSU" => "ã£"
+);
+
+my(%kata) = (
+ "a" => "ア", "i" => "イ", "u" => "ウ", "e" => "エ", "o" => "オ",
+ "ka" => "カ", "ki" => "キ", "ku" => "ク", "ke" => "ケ", "ko" => "コ",
+ "sa" => "サ", "shi" => "シ", "su" => "ス", "se" => "セ", "so" => "ソ",
+ "ta" => "ã‚¿", "chi" => "ãƒ", "tsu" => "ツ", "te" => "テ", "to" => "ト",
+ "na" => "ナ", "ni" => "ニ", "nu" => "ヌ", "ne" => "ãƒ", "no" => "ノ",
+ "ha" => "ãƒ", "hi" => "ヒ", "hu" => "フ", "he" => "ヘ", "ho" => "ホ", "fu" => "フ",
+ "ma" => "マ", "mi" => "ミ", "mu" => "ム", "me" => "メ", "mo" => "モ",
+ "ya" => "ヤ", "yu" => "ユ", "yo" => "ヨ", "ye" => "エ",
+ "ra" => "ラ", "ri" => "リ", "ru" => "ル", "re" => "レ", "ro" => "ロ",
+ "wa" => "ワ", "wi" => "ヰ", "we" => "ヱ", "wo" => "ヲ",
+ "n" => "ン",
+ "m" => "ン",
+
+ "ga" => "ガ", "gi" => "ギ", "gu" => "グ", "ge" => "ゲ", "go" => "ゴ",
+ "za" => "ザ", "ji" => "ジ", "zu" => "ズ", "ze" => "ゼ", "zo" => "ゾ",
+ "da" => "ダ", "dzi" => "ヂ", "dzu" => "ヅ", "de" => "デ", "do" => "ド",
+ "ba" => "ãƒ", "bi" => "ビ", "bu" => "ブ", "be" => "ベ", "bo" => "ボ",
+ "pa" => "パ", "pi" => "ピ", "pu" => "プ", "pe" => "ペ", "po" => "ãƒ",
+
+ "va" => "ヴァ", "vi" => "ヴィ", "vu" => "ヴ", "ve" => "ヴェ", "vo" => "ヴォ",
+ "fa" => "ファ", "fi" => "フィ", "fe" => "フェ", "fo" => "フォ",
+ "di" => "ディ",
+
+ "dje" => "ヂェ", "dze" => "ヂェ",
+
+ "kya" => "キャ", "kyu" => "キュ", "kyo" => "キョ",
+ "sha" => "シャ", "shu" => "シュ", "sho" => "ショ",
+ "cha" => "ãƒãƒ£", "chu" => "ãƒãƒ¥", "cho" => "ãƒãƒ§",
+ "nya" => "ニャ", "nyu" => "ニュ", "nyo" => "ニョ",
+ "hya" => "ヒャ", "hyu" => "ヒュ", "hyo" => "ヒョ",
+ "mya" => "ミャ", "myu" => "ミュ", "myo" => "ミョ",
+ "rya" => "リャ", "ryu" => "リュ", "ryo" => "リョ",
+ "gya" => "ギャ", "gyu" => "ギュ", "gyo" => "ギョ",
+ "ja" => "ジャ", "ju" => "ジュ", "jo" => "ジョ",
+ "jya" => "ジャ", "jyu" => "ジュ", "jyo" => "ジョ",
+ "dza" => "ヂャ", "dju" => "ヂュ", "dzo" => "ヂョ",
+ "dja" => "ヂャ", "djo" => "ヂョ",
+ "bya" => "ビャ", "byu" => "ビュ", "byo" => "ビョ",
+ "pya" => "ピャ", "pyu" => "ピュ", "pyo" => "ピョ",
+
+ "TSU" => "ッ"
+);
+
+my(%comn) = (
+ "-" => "ー",
+ "." => "。",
+ "," => "ã€",
+ "!" => "ï¼",
+ "?" => "?",
+ "~" => "〜",
+ " " => " ",
+ "[" => "〔", "]" => "〕",
+ "{" => "ã€", "}" => "】",
+ "(" => "(", ")" => ")",
+ "0" => "ï¼", "1" => "1", "2" => "ï¼’", "3" => "3", "4" => "ï¼”",
+ "5" => "5", "6" => "6", "7" => "7", "8" => "8", "9" => "9",
+ "*" => "★", # ☆ is uglier :P
+ # where to put ♪ ?
+);
+
+my(@squot) = ( "「", "ã€" );
+my($squoti) = 0;
+my(@dquot) = ( "『", "ã€" );
+my($dquoti) = 0;
+
+sub r2hk ($$) {
+ my($str) = "";
+ my($pos) = 0;
+ my($inlen) = length($_[0]);
+ my($last) = "";
+ my($href) = $_[1];
+ my($inp) = lc($_[0]);
+
+ while ($pos < $inlen) {
+ my($len);
+ my($p) = substr($inp, $pos, 3);
+ my($h) = ${$href}{$p};
+
+ # this could be done with another cycle, but this way's faster i guess
+ if ($h) {
+ $len = 3;
+ } else {
+ $p = substr($inp, $pos, 2);
+ $h = ${$href}{$p};
+ if ($h) {
+ $len = 2;
+ } else {
+ $p = substr($inp, $pos, 1);
+ $h = ${$href}{$p};
+ if (!$h) {
+ if ($p eq "'") {
+ $h = $squot[$squoti];
+ $squoti = 1 - $squoti;
+ } elsif ($p eq "\"") {
+ $h = $dquot[$dquoti];
+ $dquoti = 1 - $dquoti;
+ } else {
+ $h = $p;
+ }
+ }
+ $len = 1;
+ }
+ }
+
+ if ($h ne $p) {
+ if ($last) {
+ if ($last eq substr($p, 0, 1)) {
+ $str .= ${$href}{"TSU"};
+ } else {
+ $str .= $last;
+ }
+ $last = "";
+ }
+ } else {
+ $str .= $last;
+ $last = $p;
+ $h = "";
+ }
+
+ $str .= $h;
+
+ $pos += $len;
+ }
+
+ $str .= $last;
+
+ return $str;
+}
+
+my($lock_ev) = 0;
+
+sub event1 {
+ my ($line, $server, $witem) = @_;
+
+ return unless ref $witem;
+ if ($lock_ev) { return };
+ $squoti = 0;
+ $dquoti = 0;
+
+ my ($str) = "";
+ my (@p) = split(//, $line);
+ my ($i);
+ my ($inside) = 0;
+ my ($empty) = 0;
+
+ for ($i = 0; $i <= $#p; $i++) {
+ if ($inside) {
+ if (!$p[$i]) {
+ $empty++;
+ } else {
+ if ($empty == 0) {
+ $str .= r2hk($p[$i], \%hira);
+ } else {
+ $str .= r2hk($p[$i], \%kata);
+ }
+ $empty = 0;
+ $inside = 0;
+ }
+ } else {
+ $str .= $p[$i];
+ $inside = 1;
+ }
+ }
+
+ $lock_ev = 1;
+ Irssi::signal_emit('send command', $str, $server, $witem);
+ Irssi::signal_stop();
+ $lock_ev = 0;
+}
+
+sub cmd_romaji {
+ Irssi::print('%BRomaji (with ã²ã‚‰ãŒãª and カタカナ support) version '.$VERSION);
+ Irssi::print('(this is amateur product and comes with %Wno warranty%n, see the source)');
+ Irssi::print('Text enclosed in Ctrl-Rs (like this) will be converted to hiragana.');
+ Irssi::print('If the opening ^R is doubled, it will be converted to katakana.');
+ Irssi::print('Example: genki -> ã’ã‚“ã and genki -> ゲンキ');
+}
+
+Irssi::signal_add('send command', "event1");
+Irssi::command_bind('romaji', \&cmd_romaji);
+
+Irssi::print('%B'.$IRSSI{name}.' '.$VERSION.'%n loaded; type /romaji for more info');
+
+# Add the common hash to hiragana and kitakana hashes
+my($k, $v);
+
+while (($k, $v) = each %comn) {
+ $hira{$k} = $v;
+ $kata{$k} = $v;
+}
diff --git a/scripts/romajibind.pl b/scripts/romajibind.pl
new file mode 100644
index 0000000..87aafd7
--- /dev/null
+++ b/scripts/romajibind.pl
@@ -0,0 +1,301 @@
+#!/usr/bin/perl -w
+#
+# Copyright (c) 2002 Victor Ivanov <v0rbiz@yahoo.com>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.0b";
+%IRSSI = (
+ authors => 'Victor Ivanov',
+ contact => 'v0rbiz@yahoo.com',
+ name => 'romajibind',
+ description => 'Dynamic romaji binds',
+ sbitems => 'ro1_sb',
+ license => 'BSD 2-clause',
+ url => 'http://irssi.org/scripts/'
+);
+
+# Some help...
+# First, this is UTF-8 script.
+# Press ctrl-R to switch between Hiragana, Katakana and English input
+#
+# When the script is loading, it will install the huge amount of
+# second-level binds. This takes some time.
+#
+# When you press ctrl-R it will install some binds, but not the whole
+# bunch. Still, it takes noticeable amount of time. If you want
+# something faster, try the simple romaji.pl :)
+#
+# The system is mostly Hepburn, but it could have some kunrei mappings also.
+#
+# Because of the irssi bind limits, the small tsu is not automatic as in
+# the romaji.pl. You need to type it explicitly, using 'tt'.
+# Same goes for ん and ン, which are typed with nn or mm.
+#
+# There is a statusbar item which shows a glyph for the current mapping.
+# [英]語 -> [å¹³]ä»®å -> [片]ä»®å
+#
+# If you want it, type
+# /statusbar window add ro1_sb
+# (just once, it will remember it)
+
+use Irssi;
+use Irssi::TextUI;
+
+# Meow
+# These are almost the same as in romaji.pl
+
+my(%hira) = (
+ "a" => "ã‚", "i" => "ã„", "u" => "ã†", "e" => "ãˆ", "o" => "ãŠ",
+ "ka" => "ã‹", "ki" => "ã", "ku" => "ã", "ke" => "ã‘", "ko" => "ã“",
+ "sa" => "ã•", "shi" => "ã—", "su" => "ã™", "se" => "ã›", "so" => "ã",
+ "ta" => "ãŸ", "chi" => "ã¡", "tsu" => "ã¤", "te" => "ã¦", "to" => "ã¨",
+ "na" => "ãª", "ni" => "ã«", "nu" => "ã¬", "ne" => "ã­", "no" => "ã®",
+ "ha" => "ã¯", "hi" => "ã²", "hu" => "ãµ", "he" => "ã¸", "ho" => "ã»", "fu" => "ãµ",
+ "ma" => "ã¾", "mi" => "ã¿", "mu" => "ã‚€", "me" => "ã‚", "mo" => "ã‚‚",
+ "ya" => "や", "yu" => "ゆ", "yo" => "よ",
+ "ra" => "ら", "ri" => "ã‚Š", "ru" => "ã‚‹", "re" => "ã‚Œ", "ro" => "ã‚",
+ "wa" => "ã‚", "wi" => "ã‚", "we" => "ã‚‘", "wo" => "ã‚’",
+ "nn" => "ã‚“",
+ "mm" => "ã‚“",
+
+ "ga" => "ãŒ", "gi" => "ãŽ", "gu" => "ã", "ge" => "ã’", "go" => "ã”",
+ "za" => "ã–", "ji" => "ã˜", "zu" => "ãš", "ze" => "ãœ", "zo" => "ãž",
+ "da" => "ã ", "dzi" => "ã¢", "dzu" => "ã¥", "de" => "ã§", "do" => "ã©",
+ "ba" => "ã°", "bi" => "ã³", "bu" => "ã¶", "be" => "ã¹", "bo" => "ã¼",
+ "pa" => "ã±", "pi" => "ã´", "pu" => "ã·", "pe" => "ãº", "po" => "ã½",
+
+ "fa" => "ãµã", "fi" => "ãµãƒ", "fe" => "ãµã‡", "fo" => "ãµã‰",
+ "di" => "ã§ãƒ",
+
+ "kya" => "ãゃ", "kyu" => "ãã‚…", "kyo" => "ãょ",
+ "sha" => "ã—ゃ", "shu" => "ã—ã‚…", "sho" => "ã—ょ",
+ "cha" => "ã¡ã‚ƒ", "chu" => "ã¡ã‚…", "cho" => "ã¡ã‚‡",
+ "nya" => "ã«ã‚ƒ", "nyu" => "ã«ã‚…", "nyo" => "ã«ã‚‡",
+ "hya" => "ã²ã‚ƒ", "hyu" => "ã²ã‚…", "hyo" => "ã²ã‚‡",
+ "mya" => "ã¿ã‚ƒ", "myu" => "ã¿ã‚…", "myo" => "ã¿ã‚‡",
+ "rya" => "りゃ", "ryu" => "りゅ", "ryo" => "りょ",
+ "gya" => "ãŽã‚ƒ", "gyu" => "ãŽã‚…", "gyo" => "ãŽã‚‡",
+ "ja" => "ã˜ã‚ƒ", "ju" => "ã˜ã‚…", "jo" => "ã˜ã‚‡",
+ "jya" => "ã˜ã‚ƒ", "jyu" => "ã˜ã‚…", "jyo" => "ã˜ã‚‡",
+ "dza" => "ã¢ã‚ƒ", "dju" => "ã¢ã‚…", "dzo" => "ã¢ã‚‡",
+ "dja" => "ã¢ã‚ƒ", "djo" => "ã¢ã‚‡",
+ "bya" => "ã³ã‚ƒ", "byu" => "ã³ã‚…", "byo" => "ã³ã‚‡",
+ "pya" => "ã´ã‚ƒ", "pyu" => "ã´ã‚…", "pyo" => "ã´ã‚‡",
+
+ "tt" => "ã£"
+);
+
+my(%kata) = (
+ "a" => "ア", "i" => "イ", "u" => "ウ", "e" => "エ", "o" => "オ",
+ "ka" => "カ", "ki" => "キ", "ku" => "ク", "ke" => "ケ", "ko" => "コ",
+ "sa" => "サ", "shi" => "シ", "su" => "ス", "se" => "セ", "so" => "ソ",
+ "ta" => "ã‚¿", "chi" => "ãƒ", "tsu" => "ツ", "te" => "テ", "to" => "ト",
+ "na" => "ナ", "ni" => "ニ", "nu" => "ヌ", "ne" => "ãƒ", "no" => "ノ",
+ "ha" => "ãƒ", "hi" => "ヒ", "hu" => "フ", "he" => "ヘ", "ho" => "ホ", "fu" => "フ",
+ "ma" => "マ", "mi" => "ミ", "mu" => "ム", "me" => "メ", "mo" => "モ",
+ "ya" => "ヤ", "yu" => "ユ", "yo" => "ヨ", "ye" => "エ",
+ "ra" => "ラ", "ri" => "リ", "ru" => "ル", "re" => "レ", "ro" => "ロ",
+ "wa" => "ワ", "wi" => "ヰ", "we" => "ヱ", "wo" => "ヲ",
+ "nn" => "ン",
+ "mm" => "ン",
+
+ "ga" => "ガ", "gi" => "ギ", "gu" => "グ", "ge" => "ゲ", "go" => "ゴ",
+ "za" => "ザ", "ji" => "ジ", "zu" => "ズ", "ze" => "ゼ", "zo" => "ゾ",
+ "da" => "ダ", "dzi" => "ヂ", "dzu" => "ヅ", "de" => "デ", "do" => "ド",
+ "ba" => "ãƒ", "bi" => "ビ", "bu" => "ブ", "be" => "ベ", "bo" => "ボ",
+ "pa" => "パ", "pi" => "ピ", "pu" => "プ", "pe" => "ペ", "po" => "ãƒ",
+
+ "va" => "ヴァ", "vi" => "ヴィ", "vu" => "ヴ", "ve" => "ヴェ", "vo" => "ヴォ",
+ "fa" => "ファ", "fi" => "フィ", "fe" => "フェ", "fo" => "フォ",
+ "di" => "ディ",
+
+ "dje" => "ヂェ", "dze" => "ヂェ",
+
+ "kya" => "キャ", "kyu" => "キュ", "kyo" => "キョ",
+ "sha" => "シャ", "shu" => "シュ", "sho" => "ショ",
+ "cha" => "ãƒãƒ£", "chu" => "ãƒãƒ¥", "cho" => "ãƒãƒ§",
+ "nya" => "ニャ", "nyu" => "ニュ", "nyo" => "ニョ",
+ "hya" => "ヒャ", "hyu" => "ヒュ", "hyo" => "ヒョ",
+ "mya" => "ミャ", "myu" => "ミュ", "myo" => "ミョ",
+ "rya" => "リャ", "ryu" => "リュ", "ryo" => "リョ",
+ "gya" => "ギャ", "gyu" => "ギュ", "gyo" => "ギョ",
+ "ja" => "ジャ", "ju" => "ジュ", "jo" => "ジョ",
+ "jya" => "ジャ", "jyu" => "ジュ", "jyo" => "ジョ",
+ "dza" => "ヂャ", "dju" => "ヂュ", "dzo" => "ヂョ",
+ "dja" => "ヂャ", "djo" => "ヂョ",
+ "bya" => "ビャ", "byu" => "ビュ", "byo" => "ビョ",
+ "pya" => "ピャ", "pyu" => "ピュ", "pyo" => "ピョ",
+
+ "tt" => "ッ"
+);
+
+my(%comm) = (
+ "-" => "ー",
+ "." => "。",
+ "," => "ã€",
+ "!" => "ï¼",
+ "?" => "?",
+ "~" => "〜",
+ "[" => "〔", "]" => "〕",
+ "{" => "ã€", "}" => "】",
+ "(" => "(", ")" => ")",
+ "0" => "ï¼", "1" => "1", "2" => "ï¼’", "3" => "3", "4" => "ï¼”",
+ "5" => "5", "6" => "6", "7" => "7", "8" => "8", "9" => "9",
+ "*" => "★", # ☆ is uglier :P
+ # where to put ♪ ?
+);
+
+my(@squot) = ( "「", "ã€" );
+my($squoti) = 0;
+my(@dquot) = ( "『", "ã€" );
+my($dquoti) = 0;
+
+my(%hirab); # Contains DIRECT insert_texts and first-level metas for Hiragana
+my(%katab); # Contains DIRECT insert_texts and first-level metas for Katakana
+my(%commb); # Common binds
+my(%persb); # Persistent binds (don't collide and are all second-level or more)
+
+my($currs) = "英"; # Current state eigo -> hiragana -> katakana
+
+# Builds irssi binds from a hash containing romaji -> utf-8 pairs
+# Arguments: sh, dh, pr
+# sh: Source Hash (%hira, %kata, %comm)
+# dh: Destination Hash (%hirab or %katab)
+# pr: Prefix for meta keys (hira or kata)
+# The function uses %persb for all non-direct binds
+sub build_binds ($$$) {
+ my($sh) = $_[0]; # Source hash, %hira or %kata
+ my($dh) = $_[1]; # Destination hash, %hirab or %katab
+ my($pr) = $_[2]; # The prefix
+ my($k, $v); # for each from the source hash
+
+ while (($k, $v) = each %{$sh}) {
+ my($ll) = length($k); # get the length of the KEY
+ my($tk, $tv); # used to take apart the KEY into chars
+
+ if ($ll == 1) { # one-char KEYs are easy
+ ${$dh}{$k} = "insert_text $v";
+ } elsif ($ll >= 2) {
+ # take the first and the second chars
+ $tk = substr($k, 0, 1);
+ $tv = substr($k, 1, 1);
+ # if the meta-key is not defined yet, define it now
+ if (!${$dh}{$tk}) {
+ ${$dh}{$tk} = "key $pr$tk";
+ }
+ # if the KEY is 2-char, define it now
+ if ($ll == 2) {
+ $persb{"$pr$tk-$tv"} = "insert_text $v";
+ } else {
+ # otherwise register a new meta key, if not yet registered
+ if (!$persb{"$pr$tk-$tv"}) {
+ $persb{"$pr$tk-$tv"} = "key $pr$tk$tv";
+ }
+ # and now register the key...
+ $tk .= $tv;
+ $tv = substr($k, 2, 1);
+ $persb{"$pr$tk-$tv"} = "insert_text $v";
+ }
+ }
+ }
+}
+
+# Applies all binds in a given hash
+sub do_binds ($) {
+ my($h) = $_[0];
+ my($k, $v);
+
+ while (($k, $v) = each %{$h}) {
+ Irssi::command("^bind $k $v");
+ }
+}
+
+# Deletes all binds existing in the given hash
+sub del_binds ($) {
+ my($h) = $_[0];
+ my($k, $v);
+
+ while (($k, $v) = each %{$h}) {
+ Irssi::command("^bind -delete $k");
+ }
+}
+
+# Bindings for hiragana, next Ctrl-R will bind Katakana
+sub cmd_rohira {
+ Irssi::command("^bind ^R /rokata");
+ do_binds \%hirab;
+ do_binds \%commb;
+ $currs = "å¹³";
+ Irssi::statusbar_items_redraw('ro1_sb');
+}
+
+# Bindings for Katakana, next Ctrl-R will restore
+sub cmd_rokata {
+ Irssi::command("^bind ^R /rorest");
+ del_binds \%hirab;
+ do_binds \%katab;
+ # no need to rebind commons from %commb
+ $currs = "片";
+ Irssi::statusbar_items_redraw('ro1_sb');
+}
+
+# Delete bindings (first-level), next Ctrl-R will bind Hiragana
+sub cmd_rorest {
+ Irssi::command("^bind ^R /rohira");
+ del_binds \%katab;
+ del_binds \%commb;
+ $currs = "英";
+ Irssi::statusbar_items_redraw('ro1_sb');
+}
+
+# Display the statusbar item
+sub ro1_sb_show ($$) {
+ my ($item, $get_size_only) = @_;
+
+ $item->{min_size} = $item->{max_size} = 2;
+ $item->default_handler($get_size_only, "{sb " . $currs . "}", 0, 1);
+}
+
+# Register the /commands
+Irssi::command_bind('rohira', 'cmd_rohira');
+Irssi::command_bind('rokata', 'cmd_rokata');
+Irssi::command_bind('rorest', 'cmd_rorest');
+
+# Register the statusbar item
+Irssi::statusbar_item_register('ro1_sb', 0, "ro1_sb_show");
+Irssi::statusbar_items_redraw('ro1_sb');
+
+# Bind Ctrl-R to Hiragana (initial position)
+Irssi::command("^bind ^R /rohira");
+
+# Build the bind hashes
+build_binds \%hira, \%hirab, "hira";
+build_binds \%kata, \%katab, "kata";
+build_binds \%comm, \%commb, "comm";
+
+# Register persistent binds... SLOWwwwwww :(((
+do_binds \%persb;
diff --git a/scripts/rot13.pl b/scripts/rot13.pl
new file mode 100644
index 0000000..2b74fd7
--- /dev/null
+++ b/scripts/rot13.pl
@@ -0,0 +1,77 @@
+# rot13.pl
+# Mariusz "Craig" Cie¶la <craig at fish.mac.edu.pl>
+# ROT13-encodes and decodes messages on the channel :)
+
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "2003121202";
+
+%IRSSI = (
+ authors => "Mariusz 'Craig' Ciesla",
+ contact => "craig\@fish.mac.edu.pl",
+ name => "rot13",
+ description => "ROT13 encoding and reverse :)",
+ license => "GPLv2",
+ changed => "$VERSION",
+ commands => "rot13 unrot13"
+);
+
+use Irssi 20020324;
+
+sub text2rot ($)
+{
+ my ($text) = @_;
+
+ $text =~ y/N-ZA-Mn-za-m/A-Za-z/;
+
+ return $text."  ";
+}
+
+sub rot2text ($)
+{
+ my ($text) = @_;
+
+ $text =~ y/A-Za-z/N-ZA-Mn-za-m/;
+
+ return $text;
+}
+
+sub rot13_decode ($$$)
+{
+ my ($server, $target, $text) = @_;
+
+ return unless ($text =~ /(^|.*?)  /g);
+ my $witem = $server->window_item_find($target);
+
+ return unless ($witem);
+ $witem->print("%B[ROT13]>>%n ".rot2text($1), MSGLEVEL_CLIENTCRAP);
+}
+
+sub cmd_rot13 ($$$)
+{
+ my ($arg, $server, $witem) = @_;
+
+ if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY'))
+ {
+ $witem->command('MSG '.$witem->{name}.' '.text2rot($arg));
+ } else {
+ print CLIENTCRAP "%B>>%n ".text2rot($arg);
+ }
+}
+
+sub cmd_unrot13 ($$$)
+{
+ my ($arg, $server, $witem) = @_;
+
+ print CLIENTCRAP "%B>>%n ".rot2text($arg);
+}
+
+Irssi::command_bind('rot13',\&cmd_rot13);
+Irssi::command_bind('unrot13',\&cmd_unrot13);
+
+Irssi::signal_add('message public',sub {rot13_decode($_[0], $_[4], $_[1]);} );
+Irssi::signal_add('message own_public',sub {rot13_decode($_[0], $_[2], $_[1]);});
+
+print "%B>>%n ".$IRSSI{name}." ".$VERSION." loaded";
diff --git a/scripts/rotator.pl b/scripts/rotator.pl
new file mode 100644
index 0000000..905293c
--- /dev/null
+++ b/scripts/rotator.pl
@@ -0,0 +1,138 @@
+use Irssi;
+use Irssi::TextUI;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION="0.2.1";
+%IRSSI = (
+ authors=> 'BC-bd',
+ contact=> 'bd@bc-bd.org',
+ name=> 'rotator',
+ description=> 'Displaye a small, changeing statusbar item to show irssi is still running',
+ sbitems=> 'rotator',
+ license=> 'GPL v2',
+ url=> 'https://bc-bd.org/svn/repos/irssi/trunk/',
+);
+
+# rotator Displaye a small, changeing statusbar item to show irssi is still running
+# for irssi 0.8.4 by bd@bc-bd.org
+#
+#########
+# USAGE
+###
+#
+# To use this script type f.e.:
+#
+# /statusbar window add -after more -alignment right rotator
+#
+# For more info on statusbars read the docs for /statusbar
+#
+#########
+# OPTIONS
+#########
+#
+# /set rotator_seperator <char>
+# The character that is used to split the string in elements.
+#
+# /set rotator_chars <string>
+# The string to display. Examples are:
+#
+# /set rotator_chars . o 0 O
+# /set rotator_chars _ ­ ¯
+# /set rotator_chars %r­ %Y- %g-
+#
+# /set rotator_speed <int>
+# The number of milliseconds to display every char.
+# 1 second = 1000 milliseconds.
+#
+# /set rotator_bounce <ON|OFF>
+# * ON : reverse direction at the end of rotator_chars
+# * OFF : start from the beginning
+#
+###
+################
+###
+# Changelog
+#
+# Version 0.2.1
+# - checking rotator_speed to be > 10
+#
+# Version 0.2
+# - added rotator_bounce
+# - added rotator_seperator
+# - added support for elements longer than one char
+# - fixed displaying of special chars (thx to peder for pointing this one out)
+#
+# Version 0.1
+# - initial release
+#
+###
+################
+
+my ($pos,$char,$timeout,$boundary,$direction);
+
+$char = '';
+
+sub rotatorTimeout {
+ my @rot = split(Irssi::settings_get_str('rotator_seperator'), Irssi::settings_get_str('rotator_chars'));
+ my $len = scalar @rot;
+
+ $char = quotemeta($rot[$pos]);
+
+ if ($pos == $boundary) {
+ if (Irssi::settings_get_bool('rotator_bounce')) {
+ if ($direction < 0) {
+ $boundary = $len -1;
+ } else {
+ $boundary = 0;
+ }
+ $direction *= -1;
+ } else {
+ $pos = -1;
+ }
+ }
+
+ $pos += $direction;
+
+ Irssi::statusbar_items_redraw('rotator');
+}
+
+sub rotatorStatusbar() {
+ my ($item, $get_size_only) = @_;
+
+ $item->default_handler($get_size_only, "{sb ".$char."}", undef, 1);
+}
+
+sub rotatorSetup() {
+ my $time = Irssi::settings_get_int('rotator_speed');
+
+ Irssi::timeout_remove($timeout);
+
+ $boundary = scalar split(Irssi::settings_get_str('rotator_seperator'), Irssi::settings_get_str('rotator_chars')) -1;
+ $direction = +1;
+ $pos = 0;
+
+ if ($time < 10) {
+ Irssi::print("rotator: rotator_speed must be > 10");
+ } else {
+ $timeout = Irssi::timeout_add($time, 'rotatorTimeout' , undef);
+ }
+}
+
+Irssi::signal_add('setup changed', 'rotatorSetup');
+
+Irssi::statusbar_item_register('rotator', '$0', 'rotatorStatusbar');
+
+Irssi::settings_add_str('misc', 'rotator_chars', '. o 0 O 0 o');
+Irssi::settings_add_str('misc', 'rotator_seperator', ' ');
+Irssi::settings_add_int('misc', 'rotator_speed', 2000);
+Irssi::settings_add_bool('misc', 'rotator_bounce', 1);
+
+if (Irssi::settings_get_int('rotator_speed') < 10) {
+ Irssi::print("rotator: rotator_speed must be > 10");
+} else {
+ $timeout = Irssi::timeout_add(Irssi::settings_get_int('rotator_speed'), 'rotatorTimeout' , undef);
+}
+
+rotatorSetup();
diff --git a/scripts/sana.pl b/scripts/sana.pl
new file mode 100644
index 0000000..27737bf
--- /dev/null
+++ b/scripts/sana.pl
@@ -0,0 +1,66 @@
+# CopyLeft Riku Voipio 2001
+# Mofile Bot
+use Irssi;
+use Irssi::Irc;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.0";
+%IRSSI = (
+ authors => "Riku Voipio",
+ contact => "riku.voipio\@iki.fi",
+ name => "sana",
+ description => "responds to \"!sana test\" command on channels/publics with a finnish/english translatioin given as parameter",
+ license => "GPLv2",
+ url => "http://nchip.ukkosenjyly.mine.nu/irssiscripts/",
+ );
+
+
+
+sub cmd_sana_priv {
+ my ($server, $data, $nick, $mask ) =@_;
+ return cmd_sana($server, $data, "", $mask, $nick);
+}
+sub cmd_sana {
+ my ($server, $data, $nick, $mask, $target) =@_;
+ if ($data=~/^!sana/){
+ @foo=split(/\s+/,$data);
+ $len=@foo;
+ if ($len==1){
+ $foo[1]="aloittelija";
+ }
+ # Haxxor protection
+ $word=$foo[1];
+ $_=$word;
+ $word=~s/[^a-zA-ZäöÄÖ]//g;
+ open(DAT, "lynx --dump http://212.213.217.194/cgi-bin/mofind.exe/dr1?word=".$word."|");
+ $count=0;
+ $sucks=0;
+ $result="";
+ foreach $line (<DAT>)
+ {
+ if ($line=~/\(.*\)/)
+ {
+ $_=$line;
+ $line=~s/\s+/ /g;
+ $_=$line;
+ $line=~s/( $|^ )//g;
+ $result.=$line.",";
+ }
+ }
+ if (length($result)<2)
+ {
+ $result="Ei löydy..";
+ }
+
+ chop($result);
+ $server->command("/notice ".$target." ".$result);
+ close(DAT);
+ }
+}
+
+Irssi::signal_add_last('message public', 'cmd_sana');
+Irssi::signal_add_last('message private', 'cmd_sana_priv');
+Irssi::print("Sanakirja info bot by nchip loaded.");
+
+
diff --git a/scripts/sana_cmd.pl b/scripts/sana_cmd.pl
new file mode 100644
index 0000000..5278871
--- /dev/null
+++ b/scripts/sana_cmd.pl
@@ -0,0 +1,57 @@
+# /sana command, translates english-finnish-english.
+
+# BUGS: Doesn't handle UTF-8.
+
+use warnings;
+use strict;
+use HTML::Entities ();
+use Irssi ();
+use LWP::Simple ();
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.1";
+%IRSSI = (
+ authors => 'Johan "Ion" Kiviniemi, idea taken from Riku Voipio\'s sana.pl',
+ contact => 'ion at hassers.org',
+ name => 'sana-cmd',
+ description => '/sana command, translates english-finnish-english.',
+ license => 'Public Domain',
+ url => 'http://ion.amigafin.org/irssi/',
+ changed => 'Sat Mar 16 06:20 EET 2002',
+);
+
+Irssi::command_bind(
+ 'sana' => sub {
+ my @params = split /\s+/, shift;
+ unless (@params) {
+ Irssi::print("Sana: Usage: "
+ . (substr(Irssi::settings_get_str('cmdchars'), 0, 1) || "/")
+ . "sana word");
+ return;
+ }
+
+ my $word = $params[0];
+ $word =~ s/ /+/g;
+ $word =~ s/(\W)/'%' . unpack "H*", $1/eg;
+
+ if (my $content =
+ LWP::Simple::get(
+ 'http://www.tracetech.net:8081/?word=' . $word))
+ {
+ $content = HTML::Entities::decode($content);
+ $content =~ s/\015?\012/ /g;
+ $content =~ s/<[^>]+>/ /g; # Ugly, but it does the trick here.
+
+ my @words = $content =~ /(\S+)\s+(\(\S+?\))/g;
+
+ if (@words) {
+ Irssi::print("Sana: $word: @words");
+ } else {
+ Irssi::print("Sana: $word: No translations.");
+ }
+ } else {
+ Irssi::print("Sana failed.");
+ }
+ }
+);
diff --git a/scripts/schwaebisch.pl b/scripts/schwaebisch.pl
new file mode 100644
index 0000000..4cae233
--- /dev/null
+++ b/scripts/schwaebisch.pl
@@ -0,0 +1,191 @@
+#!/usr/bin/perl
+#
+# Schwaebisch (irssi) 1.0.1
+#
+# (c) 2000-2003 by Robert Scheck <irssi@robert-scheck.de>
+#
+# Schwaebisch (irssi) is adapted from "schwob", a swabian translator
+# by Jens Schweikhardt <schweikh@noc.dfn.de>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc.,
+# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+
+
+use strict;
+use utf8;
+use Encode;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.0.1";
+%IRSSI = (
+ authors => "Robert Scheck",
+ contact => "irssi\@robert-scheck.de",
+ name => "Schwaebisch",
+ description => "/schwäbisch - translates your messages from german to swabian",
+ license => "GNU GPL v2",
+ url => "http://ftp.robert-scheck.de/linux/irssi/scripts/",
+ modules => "",
+ changed => "$VERSION",
+ commands => "schwäbisch"
+);
+
+use Irssi 20020324;
+
+my $term_charset;
+
+sub schwaebisch ($)
+{
+ my ($text) = @_;
+
+ # Komplette Wortersetzungen:
+ $text =~ s/\b([Dd])a\b([^ß])/$1o$2/g;
+ $text =~ s/\bdann\b/no/g;
+ $text =~ s/\bEs\b/S/g;
+ $text =~ s/\bes\b/s/g;
+ $text =~ s/\beine([sm])\b/oi$1/g;
+ $text =~ s/\bEine([sm])\b/Oi$1/g;
+ $text =~ s/\b([DdMmSs])eine?\b/$1ei/g;
+ $text =~ s/\b([DdMmSs])eins\b/$1eis/g;
+ $text =~ s/\b([DdMmSs])einer\b/$1einr/g;
+ $text =~ s/\beine\b/a/g;
+ $text =~ s/\bEine\b/A/g;
+ $text =~ s/\beiner\b/oinr/g;
+ $text =~ s/\bEiner\b/Oinr/g;
+ $text =~ s/\b([Ee])inen\b/$1n/g; # einen -> en
+ $text =~ s/\b([Dd])as/$1es/g; # das -> des
+ $text =~ s/\b[Ii]ch\b/I/g; # ich -> i
+ $text =~ s/\b([Nn])icht\b/$1ed/g; # nicht -> ned
+ $text =~ s/\b([Ss])ie\b/$1e/g; # sie -> se
+ $text =~ s/\bwir\b/mir/g;
+ $text =~ s/\bWir\b/Mir/g;
+ $text =~ s/\b(he)?([Rr])unter/$2a/g;
+ $text =~ s/\b([Hh])at\b/$1ott/g;
+ $text =~ s/\b([Hh])aben\b/$1enn/g;
+ $text =~ s/\b([Hh])abe\b/$1ann/g;
+ $text =~ s/\b([Gg])ehen\b/$1anga/g;
+ $text =~ s/\b([Kk])ann\b/$1a/g;
+ $text =~ s/\b([Kk])önnen\b/$1enna/g;
+ $text =~ s/\b([Ww])ollen\b/$1ella/g;
+ $text =~ s/\b([Ss])ollten\b/$1oddad/g;
+ $text =~ s/\b([Ss])ollt?e?\b/$1odd/g;
+ $text =~ s/\bdiese?r?\b/sell/g;
+ $text =~ s/\bDiese?r?\b/Sell/g;
+ $text =~ s/\b([Aa])uch\b/$1o/g; # auch -> ao
+ $text =~ s/\b([Nn])och\b/$1o/g; # noch -> no
+ $text =~ s/\b([Ss])ind\b/$1end/g; # sind -> send
+ $text =~ s/\b([Ss])chon\b/$1cho/g; # schon -> scho
+ $text =~ s/\b([Mm])an\b/$1r/g; # man -> mr
+ $text =~ s/\b([Dd])ie\b/$1/g; # die -> d
+ $text =~ s/\b([Dd])a?rauf\b/$1ruff/g; # darauf -> druff
+ $text =~ s/\bviele?s?\b/en Haufa/g;
+ $text =~ s/\bViele?s?\b/En Haufa/g;
+ $text =~ s/\bAuto|Daimler\b/Heilix Blechle/g;
+ $text =~ s/Marmelade|Konfitüre/Xälz/g;
+ $text =~ s/\b2\b/zwoi/g;
+ $text =~ s/\b5\b/fempf/g;
+ $text =~ s/\b15\b/fuffzehn/g;
+ $text =~ s/\b50\b/fuffzig/g;
+
+ # Am Wortanfang und Großgeschriebenes:
+ $text =~ s/\bAuf/Uff/g;
+ $text =~ s/\bauf/uff/g;
+ $text =~ s/\bEin/Oi/g;
+ $text =~ s/\bein/oi/g;
+ $text =~ s/\bMal/Mol/g;
+ $text =~ s/\bUm/Om/g;
+ $text =~ s/\bunge/og/g;
+ $text =~ s/\bUnge/Og/g;
+ $text =~ s/\bunver/ovr/g;
+ $text =~ s/\bUnver/Ovr/g;
+ $text =~ s/\bUn/On/g;
+ $text =~ s/\bun/on/g;
+ $text =~ s/\bUnd/Ond/g;
+ $text =~ s/\bin(s?)/en$1/g; # in -> en, ins -> ens
+ $text =~ s/\bIn(s?)/En$1/g; # In -> En, Ins -> Ens
+ $text =~ s/\bim/em/g;
+ $text =~ s/\bIm/Em/g;
+ $text =~ s/\b([Kk])ein/$1oin/g;
+ $text =~ s/\b([Nn])ein/$1oi/g;
+ $text =~ s/\b([Zz])usa/$1a/g; # zusammen -> zamma
+
+ # Am Wortende:
+ $text =~ s/\Ben\b/a/g; # latschen -> latscha
+ $text =~ s/\Bel\b/l/g; # Sessel -> Sessl
+ $text =~ s/([^h])er\b/$1r/g; # der -> dr
+ $text =~ s/([h])es\b/$1s/g; # manches -> manchs
+ $text =~ s/\Bau\b/ao/g; # lau -> lao
+ $text =~ s/([lt])ein\b/$1oi/g; # Stein -> Stoi
+
+ # Beliebige Position:
+ $text =~ s/([Ff])rag/$1rog/g;
+ $text =~ s/teil/doil/g;
+ $text =~ s/Teil/Doil/g;
+ $text =~ s/([Hh])eim/$1oim/g;
+ $text =~ s/steht/stoht/g;
+ $text =~ s/um/om/g;
+ $text =~ s/imm/emm/g; # schlimm -> schlemm
+ $text =~ s/mal/mol/g;
+ $text =~ s/zwei/zwoi/g;
+ $text =~ s/ck/gg/g;
+ $text =~ s/([Ee])u/$1i/g;
+ $text =~ s/([Vv])er/$1r/g;
+ $text =~ s/([Gg])e([aflmnrs])/$1$2/g; # angenommen -> angnommen
+ $text =~ s/([Ss])t/$1chd/g; # st -> schd
+ $text =~ s/([Ss])p/$1chb/g; # sp -> schb
+ $text =~ s/tio/zio/g; # Information -> Informazion
+ $text =~ s/\?/, ha?/g;
+ $text =~ s/!!/, Sagg Zemend!/g;
+ $text =~ s/!/, haidanai!/g;
+
+ # Spezielles:
+ $text =~ tr/TtPpÖöÜü/DdBbEeIi/; # Globale Transformationen zum Schluss
+
+ # Was nach 'tr' stehen muss:
+ $text =~ s/ung/ong/g;
+ $text =~ s/und/ond/g;
+ $text =~ s/ind/end/g;
+
+ return $text;
+}
+
+sub cmd_schwaebisch ($$$)
+{
+ my ($arg, $server, $witem) = @_;
+ utf8::decode($arg);
+ if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) {
+ if ($term_charset eq 'UTF-8') {
+ $witem->command('MSG '.$witem->{name}.' '.schwaebisch($arg));
+ } else {
+ $witem->command('MSG '.$witem->{name}.' '.encode($term_charset,schwaebisch($arg)));
+ }
+ } else {
+ if ($term_charset eq 'UTF-8') {
+ Irssi::print("%B>>%n ".schwaebisch($arg), MSGLEVEL_CLIENTCRAP);
+ } else {
+ Irssi::print("%B>>%n ".encode($term_charset,schwaebisch($arg)), MSGLEVEL_CLIENTCRAP);
+ }
+ }
+}
+
+$term_charset=Irssi::settings_get_str("term_charset");
+
+if ($term_charset eq 'UTF-8') {
+ Irssi::command_bind('schwäbisch', \&cmd_schwaebisch);
+} else {
+ Irssi::command_bind(encode($term_charset,'schwäbisch'), \&cmd_schwaebisch);
+}
+
+# vim:set ts=2 sw=2 expandtab:
diff --git a/scripts/screen_away.pl b/scripts/screen_away.pl
new file mode 100644
index 0000000..199fc1a
--- /dev/null
+++ b/scripts/screen_away.pl
@@ -0,0 +1,248 @@
+use Irssi;
+use strict;
+use FileHandle;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.9.8.2";
+%IRSSI = (
+ authors => 'Andreas \'ads\' Scherbaum <ads@wars-nicht.de>',
+ name => 'screen_away',
+ description => 'set (un)away, if screen is attached/detached',
+ license => 'GPL v2',
+ url => 'none',
+);
+
+# screen_away irssi module
+#
+# written by Andreas 'ads' Scherbaum <ads@ufp.de>
+#
+# changes:
+# 20.12.2014 fix the bug when screenname is changed during the session
+# 07.02.2004 fix error with away mode
+# thanks to Michael Schiansky for reporting and fixing this one
+# 07.08.2004 new function for changing nick on away
+# 24.08.2004 fixing bug where the away nick was not storedcorrectly
+# thanks for Harald Wurpts for help debugging this one
+# 17.09.2004 rewrote init part to use $ENV{'STY'}
+# 05.12.2004 add patch for remember away state
+# thanks to Jilles Tjoelker <jilles@stack.nl>
+# change "chatnet" to "tag"
+# 18.05.2007 fix '-one' for SILC networks
+#
+#
+# usage:
+#
+# put this script into your autorun directory and/or load it with
+# /SCRIPT LOAD <name>
+#
+# there are 5 settings available:
+#
+# /set screen_away_active ON/OFF/TOGGLE
+# /set screen_away_repeat <integer>
+# /set screen_away_message <string>
+# /set screen_away_window <string>
+# /set screen_away_nick <string>
+#
+# active means, that you will be only set away/unaway, if this
+# flag is set, default is ON
+# repeat is the number of seconds, after the script will check the
+# screen status again, default is 5 seconds
+# message is the away message sent to the server, default: not here ...
+# window is a window number or name, if set, the script will switch
+# to this window, if it sets you away, default is '1'
+# nick is the new nick, if the script goes away
+# will only be used it not empty
+#
+# normal you should be able to rename the script to something other
+# than 'screen_away' (as example, if you dont like the name) by simple
+# changing the 'name' parameter in the %IRSSI hash at the top of this script
+
+
+# variables
+my $timer_name = undef;
+my $away_status = 0;
+my %old_nicks = ();
+my %away = ();
+
+# Register formats
+Irssi::theme_register(
+[
+ 'screen_away_crap',
+ '{line_start}{hilight ' . $IRSSI{'name'} . ':} $0'
+]);
+
+# if we are running
+my $screen_away_used = 0;
+
+# try to find out, if we are running in a screen
+# (see, if $ENV{STY} is set
+if (!defined($ENV{STY})) {
+ # just return, we will never be called again
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'screen_away_crap',
+ "could not open status file for parent process (pid: " . getppid() . "): $!");
+ return;
+}
+
+my ($socket_pid, $socket_name, $socket_path);
+
+# search for socket
+# normal we could search the socket file, ... if we know the path
+# but so we have to call one time the screen executable
+# disable locale
+# the quotes around C force perl 5.005_03 to use the shell
+# thanks to Jilles Tjoelker <jilles@stack.nl> for pointing this out
+my $socket = `LC_ALL="C" screen -ls`;
+
+
+
+my $running_in_screen = 0;
+# locale doesnt seems to be an problem (yet)
+if ($socket !~ /^No Sockets found/s) {
+ # ok, should have only one socket
+ # $STY won't change if sessionname is changed during session
+ # therefore first find the pid and use that to find the actual sessionname
+ $socket_pid = substr($ENV{'STY'}, 0, index($ENV{'STY'}, '.'));
+ $socket_path = $socket;
+ $socket_path =~ s/^.*\d+ Sockets? in ([^\n]+)\..*$/$1/s;
+ $socket_name = $socket;
+ $socket_name =~ s/^.+?($socket_pid\.\S+).+$/$1/s;
+ if (length($socket_path) != length($socket)) {
+ # only activate, if string length is different
+ # (to make sure, we really got a dir name)
+ $screen_away_used = 1;
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'screen_away_crap',
+ "error reading screen informations from:");
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'screen_away_crap',
+ "$socket");
+ return;
+ }
+}
+
+# last check
+if ($screen_away_used == 0) {
+ # we will never be called again
+ return;
+}
+
+# build complete socket name
+$socket = $socket_path . "/" . $socket_name;
+
+# register config variables
+Irssi::settings_add_bool('misc', $IRSSI{'name'} . '_active', 1);
+Irssi::settings_add_int('misc', $IRSSI{'name'} . '_repeat', 5);
+Irssi::settings_add_str('misc', $IRSSI{'name'} . '_message', "not here ...");
+Irssi::settings_add_str('misc', $IRSSI{'name'} . '_window', "1");
+Irssi::settings_add_str('misc', $IRSSI{'name'} . '_nick', "");
+
+# init process
+screen_away();
+
+# screen_away()
+#
+# check, set or reset the away status
+#
+# parameter:
+# none
+# return:
+# 0 (OK)
+sub screen_away {
+ my ($away, @screen, $screen);
+
+ # only run, if activated
+ if (Irssi::settings_get_bool($IRSSI{'name'} . '_active') == 1) {
+ if ($away_status == 0) {
+ # display init message at first time
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'screen_away_crap',
+ "activating $IRSSI{'name'} (interval: " . Irssi::settings_get_int($IRSSI{'name'} . '_repeat') . " seconds)");
+ }
+ # get actual screen status
+ my @screen = stat($socket);
+ # 00100 is the mode for "user has execute permissions", see stat.h
+ if (($screen[2] & 00100) == 0) {
+ # no execute permissions, Detached
+ $away = 1;
+ } else {
+ # execute permissions, Attached
+ $away = 2;
+ }
+
+ # check if status has changed
+ if ($away == 1 and $away_status != 1) {
+ # set away
+ if (length(Irssi::settings_get_str($IRSSI{'name'} . '_window')) > 0) {
+ # if length of window is greater then 0, make this window active
+ Irssi::command('window goto ' . Irssi::settings_get_str($IRSSI{'name'} . '_window'));
+ }
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'screen_away_crap',
+ "Set away");
+ my $message = Irssi::settings_get_str($IRSSI{'name'} . '_message');
+ if (length($message) == 0) {
+ # we have to set a message or we wouldnt go away
+ $message = "not here ...";
+ }
+ my ($server);
+ foreach $server (Irssi::servers()) {
+ if (!$server->{usermode_away}) {
+ # user isnt yet away
+ $away{$server->{'tag'}} = 0;
+ $server->command("AWAY " . (($server->{chat_type} ne 'SILC') ? "-one " : "") . "$message") if (!$server->{usermode_away});
+ if (length(Irssi::settings_get_str($IRSSI{'name'} . '_nick')) > 0) {
+ # only change, if actual nick isnt already the away nick
+ if (Irssi::settings_get_str($IRSSI{'name'} . '_nick') ne $server->{nick}) {
+ # keep old nick
+ $old_nicks{$server->{'tag'}} = $server->{nick};
+ # set new nick
+ $server->command("NICK " . Irssi::settings_get_str($IRSSI{'name'} . '_nick'));
+ }
+ }
+ } else {
+ # user is already away, remember this
+ $away{$server->{'tag'}} = 1;
+ }
+ }
+ $away_status = $away;
+ } elsif ($away == 2 and $away_status != 2) {
+ # unset away
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'screen_away_crap',
+ "Reset away");
+ my ($server);
+ foreach $server (Irssi::servers()) {
+ if ($away{$server->{'tag'}} == 1) {
+ # user was already away, dont reset away
+ $away{$server->{'tag'}} = 0;
+ next;
+ }
+ $server->command("AWAY" . (($server->{chat_type} ne 'SILC') ? " -one" : "")) if ($server->{usermode_away});
+ if (defined($old_nicks{$server->{'tag'}}) and length($old_nicks{$server->{'tag'}}) > 0) {
+ # set old nick
+ $server->command("NICK " . $old_nicks{$server->{'tag'}});
+ $old_nicks{$server->{'tag'}} = "";
+ }
+ }
+ $away_status = $away;
+ }
+ }
+ # but everytimes install a new timer
+ register_screen_away_timer();
+ return 0;
+}
+
+# register_screen_away_timer()
+#
+# remove old timer and install a new one
+#
+# parameter:
+# none
+# return:
+# none
+sub register_screen_away_timer {
+ if (defined($timer_name)) {
+ # remove old timer, if defined
+ Irssi::timeout_remove($timer_name);
+ }
+ # add new timer with new timeout (maybe the timeout has been changed)
+ $timer_name = Irssi::timeout_add(Irssi::settings_get_int($IRSSI{'name'} . '_repeat') * 1000, 'screen_away', '');
+}
+
diff --git a/scripts/scripthelp.pl b/scripts/scripthelp.pl
new file mode 100644
index 0000000..7591e92
--- /dev/null
+++ b/scripts/scripthelp.pl
@@ -0,0 +1,39 @@
+use strict;
+use Irssi;
+
+use vars qw($VERSION %IRSSI %HELP);
+$VERSION = "0.10";
+%IRSSI = (
+ authors => "Maciek \'fahren\' Freudenheim",
+ contact => "fahren\@bochnia.pl",
+ name => "Scripts help",
+ description => "Provides access to script\'s help",
+ license => "GNU GPLv2 or later",
+ changed => "2019-02-27"
+);
+$HELP{scripthelp} = "
+Provides help for irssi's perl scripts.
+
+All what you have to do is to add
+\$HELP{commandname} = \"
+ your help goes here
+\";
+to your script.
+";
+
+sub cmd_help {
+ my ($args, $server, $win) = @_;
+
+ # from scriptinfo.pl
+ for (sort grep s/::$//, keys %Irssi::Script::) {
+ no strict 'refs';
+ my $help = ${ "Irssi::Script::${_}::HELP" }{$args};
+ if ($help) {
+ Irssi::signal_stop();
+ Irssi::print("$help");
+ return;
+ }
+ }
+}
+
+Irssi::command_bind("help", "cmd_help");
diff --git a/scripts/scriptinfo.pl b/scripts/scriptinfo.pl
new file mode 100644
index 0000000..7de21f2
--- /dev/null
+++ b/scripts/scriptinfo.pl
@@ -0,0 +1,118 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+# This script assumes all windows have the same width, which will
+# practically always be true.
+
+use Irssi qw(active_win command_bind);
+$VERSION = '1.20';
+%IRSSI = (
+ authors => 'Juerd',
+ contact => 'juerd@juerd.nl',
+ name => 'Script Information',
+ description => 'Access script information',
+ license => 'Public Domain',
+ url => 'http://juerd.nl/irssi/',
+ changed => 'Tue Mar 19 11:00 CET 2002',
+);
+
+sub iprint {
+ Irssi::print(join('', @_), MSGLEVEL_CRAP);
+}
+
+command_bind 'script info' => sub {
+ my ($data, $server) = @_;
+ if ($data !~ /\S/) {
+ iprint 'Usage: /script info <scriptname>';
+ return;
+ }
+
+ no strict 'refs';
+ iprint "\c_== Script info for $data ==";
+
+ if (not exists $Irssi::Script::{ "${data}::" }) {
+ iprint 'Script is not loaded.';
+ return;
+ }
+
+ my %info = %{ "Irssi::Script::${data}::IRSSI" };
+ $info{version} = ${ "Irssi::Script::${data}::VERSION" };
+
+ if (join('', values %info) eq '') {
+ iprint 'Script has no $VERSION and no %IRSSI. ',
+ 'Please ask the author to read ',
+ 'http://juerd.nl/irssi/proposal.txt';
+
+ return;
+ }
+ my $max = 0;
+ length > $max and $max = length for keys %info;
+ my $width = active_win->{width} - 14 - $max;
+ s/([^\n]{$width})/$1\n/g for values %info;
+ s/(?<=\n)/' ' x ($max + 2)/eg for values %info;
+ for (qw/name version description authors contact/) {
+ if (exists $info{$_}) {
+ iprint"\cC5$_\cC", ' ' x (2 + $max - length $_), $info{$_};
+ delete $info{$_};
+ }
+ }
+ for (sort keys %info) {
+ iprint "\cC5$_\cC", ' ' x (2 + $max - length $_), $info{$_};
+ }
+};
+
+command_bind 'script sv' => sub {
+ my ($data, $server) = @_;
+ if ($data !~ /\S/) {
+ iprint 'Usage: /script sv <scriptname>';
+ return;
+ }
+
+ no strict 'refs';
+ if (not exists $Irssi::Script::{ "${data}::" }) {
+ iprint 'Module is not loaded.';
+ return;
+ }
+
+ my $name = ${ "Irssi::Script::${data}::IRSSI" }{name};
+ my $url = ${ "Irssi::Script::${data}::IRSSI" }{url};
+ my $version = ${ "Irssi::Script::${data}::VERSION" };
+
+ my $text = "$name $version";
+ $text .= " - $url" if $url;
+
+ if ($text !~ /\S/) {
+ iprint 'Script has no information.';
+ return;
+ }
+
+ active_win->command("say $text");
+};
+
+command_bind 'script versions' => sub {
+ # Actually, upgrading them would be quite easy :)
+ # Update: Actually, it's possible now! use scriptadmin.pl :)
+ my ($data, $server) = @_;
+
+ no strict 'refs';
+ my @modules;
+ for (sort grep s/::$//, keys %Irssi::Script::) {
+ my $name = ${ "Irssi::Script::${_}::IRSSI" }{name};
+ my $version = ${ "Irssi::Script::${_}::VERSION" };
+ push @modules, [$_, $name, $version] if $name && $version;
+ }
+ my @max;
+ for (@modules) {
+ my $i = -1;;
+ length > $max[++$i] and $max[$i] = length for @$_;
+ }
+ my $i;
+ my $text = join "\n", map {
+ $i = 0 ||
+ join ' ', map {
+ $_ . ' ' x ($max[$i++] - length)
+ } @$_
+ } @modules;
+ iprint $text;
+};
+
diff --git a/scripts/scroller.pl b/scripts/scroller.pl
new file mode 100644
index 0000000..fbed9c8
--- /dev/null
+++ b/scripts/scroller.pl
@@ -0,0 +1,97 @@
+#DEMONENS SCROLLER SCRIPT!
+#scroller.pl
+
+#This script will create a small 10-character scroller on the irssi status bar.
+#It is pretty much useless.
+#I use it to remind myself about meetings, phonecalls I'm supposed to make etc
+#
+#Enjoy to the extent possible.
+#
+# -Demonen
+#
+#To make it show up in irrsi, do this:
+# 1) put scroller.pl in ~/.irssi/scripts
+# This is where irssi expects to find scripts
+#
+# 2) in irssi, give the command /script load scroller
+# Some stuff will appear in your status window.
+#
+# 3) in irssi, give the command /statusbar window add -after more -alignment right scroller
+# This will enable the scroller element on the status bar.
+#
+# 4) in irssi, give the command /set scrollerText <something>
+# This will scroll the text <something>
+#
+# 5) in irssi, give the command /set scrollerSpeed <something>
+# This is the delay in milliseconds before it cycles to the next character.
+# I use 200 here, but anything above 10 is just fine.
+
+
+use Irssi;
+use Irssi::TextUI;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION="0.02";
+%IRSSI = (
+ authors=> 'Demonen',
+ contact=> 'demmydemon@gmail.com',
+ name=> 'scroller',
+ description=> 'Scrolls specified text on the status bar',
+ sbitems=> 'scroller',
+ license=> 'Public Domain',
+);
+
+
+my ($scalarSize, $subset, $start, $end, $timeout, $count, $time, $scalar);
+
+
+sub scrollerStatusbar() {
+ my ($item, $get_size_only) = @_;
+ $item->default_handler($get_size_only, "{sb ".$subset."}", undef, 1);
+}
+
+
+sub scrollerTimeout() {
+ if ($count > $scalarSize){
+ $count = 0;
+ }else{
+ $count++;
+ }
+ $start = $count;
+ $end = 10;
+ $subset = (substr $scalar, $start, $end);
+ Irssi::statusbar_items_redraw('scroller');
+}
+
+
+sub scrollerUpdate() {
+ $scalar = Irssi::settings_get_str('scrollerText');
+ $scalar = "- - - ->".$scalar."- - - ->";
+ print "Scrolling: \" $scalar \"";
+ $scalarSize = length($scalar) -11;
+ $count = 0;
+ Irssi::timeout_remove($timeout);
+ if (Irssi::settings_get_int('scrollerSpeed') < 10){
+ Irssi::settings_set_int('scrollerSpeed', 10);
+ print "Sorry, minimum delay for timeouts in irssi is 10 ms. Delay set to 10 ms.";
+ }
+ $timeout = Irssi::timeout_add(Irssi::settings_get_int('scrollerSpeed'), 'scrollerTimeout' , undef);
+}
+
+
+sub scrollerStart() {
+ Irssi::settings_add_str('misc', 'scrollerText', 'Scrolling text not defined. Use "/set scrollerText <something>" to define it');
+ Irssi::settings_add_int('misc', 'scrollerSpeed', 200);
+ $timeout = Irssi::timeout_add(Irssi::settings_get_int('scrollerSpeed'), 'scrollerTimeout' , undef);
+ Irssi::statusbar_item_register('scroller', '$0', 'scrollerStatusbar');
+ #Irssi::command_bind scrollthis => \&scrollthis;
+ Irssi::signal_add('setup changed', 'scrollerUpdate');
+ &scrollerUpdate();
+}
+
+
+&scrollerStart();
+print "Use \"/set scrollerText <something>\" to scroll <something>";
+print "Use \"/set scrollerSpeed <int>\" to set the delay in milliseconds";
diff --git a/scripts/seen.pl b/scripts/seen.pl
new file mode 100644
index 0000000..9d811b4
--- /dev/null
+++ b/scripts/seen.pl
@@ -0,0 +1,1198 @@
+use strict;
+use 5.005_62; # for 'our'
+use Irssi 20020428; # for Irssi::signal_continue
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.8";
+%IRSSI = (
+ authors => 'Marcin \'Qrczak\' Kowalczyk',
+ contact => 'qrczak@knm.org.pl',
+ name => 'Seen',
+ description => 'Tell people when other people were online',
+ license => 'GPL',
+ url => 'http://qrnik.knm.org.pl/~qrczak/irssi/seen.pl',
+);
+
+######## User interface ########
+
+# COMMANDS
+# ========
+#
+# /seen <nick>
+# Show last seen info about nick.
+#
+# /say_seen [<to_whom>] <nick>
+# Say last seen info about nick in the current window. If to_whom
+# is present, answer as if that person issued a seen request.
+#
+# /listen on [[<chatnet>] <channel>]
+# Turn on listening for seen requests in the current or given channel.
+#
+# /listen off [[<chatnet>] <channel>]
+# Turn off listening for seen requests in the current or given channel.
+#
+# /listen delay [[<chatnet>] <channel>]
+# Turn on listening for seen requests in the current or given channel.
+# We will reply only if nobody else replies with a message containing
+# the given nick (probably a seen reply from another bot) in seen_delay
+# seconds.
+#
+# /listen private [[<chatnet>] <channel>]
+# Turn on listening for seen requests in the current or given channel.
+# The reply will be sent as a private notice.
+#
+# /listen disable [[<chatnet>] <channel>]
+# Same as "off", used to distinguish channels where we won't listen
+# for sure from channels we didn't specify anything about.
+#
+# /listen list
+# Show which channels we are listening for seen requests on.
+
+# Forms of seen requests from other people:
+# Public message "<our_nick>: seen <nick>".
+# Public message "seen <nick>" on channels where we are listening.
+# Private message "seen <nick>".
+# Any of the above with "!seen" instead of "seen".
+# Any of the above with a question mark at the end.
+# Any of the above with "jest <nick>?", "by³ <nick>?", "by³a <nick>?",
+# "<nick> jest?", "<nick> by³?", "<nick> by³a?", with optional
+# "czy" at the beginning - provided that we know that nick
+# (to avoid treating some other message as a seen request).
+
+# VARIABLES
+# =========
+#
+# seen_expire_after
+# After that number of days we forget about nicks and addresses.
+# Default 30.
+#
+# seen_expire_asked_after
+# After that number of days we forget that that somebody was
+# searched for and don't send a notice. Default 7.
+#
+# seen_delay
+# On channels set to '/listen delay' we reply if after that number
+# of seconds nobody else replies. Default 60.
+
+######## Internal structure of the database in memory ########
+
+# %listen_on = (chatnet => {channel => listening})
+# %address_absent = (chatnet => {address => time})
+# %nicks = (chatnet => {address => [nick]})
+# %last_nicks = (chatnet => {address => nick})
+# %how_quit = (chatnet => {address => how_quit})
+# %spoke = (chatnet => {address => time})
+# %nick_absent = (chatnet => {nick => time})
+# %addresses = (chatnet => {nick => address})
+# %orig_nick = (chatnet => {nick => nick})
+# %channels = (chatnet => {nick => [channel]})
+# %asked = (chatnet => {nick => {nick_asks => time}})
+
+# listening:
+# 'on', undef = 'off', 'delay', 'private', 'disable'
+
+# how_quit:
+# ['disappeared']
+# ['was_left', kanal]
+# ['left', channel, reason]
+# ['quit', channels, reason]
+# ['was_kicked', channel, kicker, reason]
+
+######## Global variables ########
+
+our %listen_on = ();
+our %address_absent = ();
+our %nicks = ();
+our %last_nicks = ();
+our %how_quit = ();
+our %spoke = ();
+our %nick_absent = ();
+our %addresses = ();
+our %orig_nick = ();
+our %channels = ();
+our %asked = ();
+
+Irssi::settings_add_int "seen", "seen_expire_after", 30; # days
+Irssi::settings_add_int "seen", "seen_expire_asked_after", 7; # days
+Irssi::settings_add_int "seen", "seen_delay", 60; # seconds
+
+our $database = Irssi::get_irssi_dir . "/seen.dat";
+our $database_tmp = Irssi::get_irssi_dir . "/seen.tmp";
+our $database_old = Irssi::get_irssi_dir . "/seen.dat~";
+
+######## Utilities ########
+
+our $nick_regexp = qr/
+ [A-Z\[\\\]^_`a-z{|}\200-\377]
+ [\-0-9A-Z\[\\\]^_`a-z{|}\200-\377]*
+ /x;
+our $seen_regexp = qr/^ *!?seen +($nick_regexp) *\?* *$/i;
+our $maybe_seen_regexp1 = qr/
+ ^\ *
+ (?:a\ +)?
+ (?:(?:if|when|here)\ +)?
+ (?:(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e)\ +)*
+ (?:in|by[³l]a?)\ +
+ (?:(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e)\ +)*
+ ($nick_regexp)
+ (?:\ +(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e))*
+ \ *\?+\ *$/ix;
+our $maybe_seen_regexp2 = qr/
+ ^\ *
+ (?:a\ +)?
+ (?:(?:czy|kiedy|gdzie)\ +)?
+ (?:(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e)\ +)*
+ ($nick_regexp)?\ +
+ (?:(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e)\ +)*
+ (?:in|by[³l]a?)
+ (?:\ +(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e))*
+ \ *\?+\ *$/ix;
+our $exclude_regexp = qr/^(?:kto[¶s]?|who?|that?|that|ladna|i|a)$/i;
+
+sub lc_irc($) {
+ my ($str) = @_;
+ $str =~ tr/A-Z[\\]/a-z{|}/;
+ return $str;
+}
+
+sub uc_irc($) {
+ my ($str) = @_;
+ $str =~ tr/a-z{|}/A-Z[\\]/;
+ return $str;
+}
+
+our %lc_regexps = ();
+
+sub lc_irc_regexp($) {
+ my ($str) = @_;
+ $str =~ s/(.)/my $lc = lc_irc $1; my $uc = uc_irc $1; "[\Q$lc$uc\E]"/eg;
+ return $str;
+}
+
+sub canonical($) {
+ my ($address) = @_;
+ $address =~ s/^[\^~+=-]//;
+ return $address;
+}
+
+sub show_list(@) {
+ @_ == 0 and return "";
+ @_ == 1 and return $_[0];
+ return join(", ", @_[0..$#_-1]) . " i " . $_[$#_];
+}
+
+sub show_time_since($) {
+ my ($time) = @_;
+ my $diff = time() - $time;
+ $diff >= 0 or return "nie wiem kiedy (zegarek mi sie popsul)";
+ my $s = $diff % 60; $diff = int(($diff - $s) / 60);
+ my $m = $diff % 60; $diff = int(($diff - $m) / 60);
+ my $h = $diff % 24; $diff = int(($diff - $h) / 24);
+ my $d = $diff;
+ my $s_txt = $s ? "${s}s " : "";
+ my $m_txt = $m ? "${m}m " : "";
+ my $h_txt = $h ? "${h}h " : "";
+ my $d_txt = $d ? "${d}d " : "";
+ return
+ $d ? "$d_txt${h_txt}ago" :
+ $h ? "$h_txt${m_txt}ago" :
+ $m ? "$m_txt${s_txt}ago" :
+ "${s}s ago";
+}
+
+sub all_channels($@) {
+ my ($chatnet, @nicks) = @_;
+ my %chans = ();
+ foreach my $nick (@nicks) {
+ if ($channels{$chatnet}{lc_irc $nick}) {
+ foreach my $channel (@{$channels{$chatnet}{lc_irc $nick}}) {
+ $chans{$channel} = 1;
+ }
+ }
+ }
+ return keys %chans;
+}
+
+sub is_private($) {
+ my ($channel) = @_;
+ return $channel && $channel->{mode} =~ /^[^ ]*[ps]/;
+}
+
+sub mark_private($$) {
+ my ($channel, $name) = @_;
+ return is_private $channel ? "-$name" : $name;
+}
+
+######## Actions on the database in memory ########
+
+sub do_listen($$$) {
+ my ($chatnet, $channel, $state) = @_;
+ if ($state eq 'off') {
+ delete $listen_on{$chatnet}{$channel};
+ } else {
+ $listen_on{$chatnet}{$channel} = $state;
+ }
+}
+
+sub do_join($$$$) {
+ my ($chatnet, $address, $nick, $channel) = @_;
+ my $lc_nick = lc_irc $nick;
+ my $lc_channel = lc_irc $channel;
+ delete $address_absent{$chatnet}{$address};
+ push @{$nicks{$chatnet}{$address}}, $nick
+ unless grep {lc_irc $_ eq $lc_nick} @{$nicks{$chatnet}{$address}};
+ push @{$channels{$chatnet}{$lc_nick}}, $channel
+ unless grep {lc_irc $_ eq $lc_channel} @{$channels{$chatnet}{$lc_nick}};
+ delete $how_quit{$chatnet}{$address};
+ delete $nick_absent{$chatnet}{$lc_nick};
+ $addresses{$chatnet}{$lc_nick} = $address;
+ $orig_nick{$chatnet}{$lc_nick} = $nick;
+}
+
+sub do_quit_all($$$$$) {
+ my ($time, $chatnet, $address, $nick, $reason) = @_;
+ $address_absent{$chatnet}{$address} = $time;
+ delete $nicks{$chatnet}{$address};
+ $last_nicks{$chatnet}{$address} = $nick;
+ $how_quit{$chatnet}{$address} = $reason;
+}
+
+sub do_quit($$$$) {
+ my ($time, $chatnet, $address, $nick) = @_;
+ my $lc_nick = lc_irc $nick;
+ $nicks{$chatnet}{$address} =
+ [grep {lc_irc $_ ne $lc_nick} @{$nicks{$chatnet}{$address}}];
+ delete $channels{$chatnet}{$lc_nick};
+ $nick_absent{$chatnet}{$lc_nick} = $time;
+ $addresses{$chatnet}{$lc_nick} = $address;
+ $orig_nick{$chatnet}{$lc_nick} = $nick;
+}
+
+sub do_part($$$$) {
+ my ($chatnet, $address, $nick, $channel) = @_;
+ my $lc_nick = lc_irc $nick;
+ my $lc_channel = lc_irc $channel;
+ $channels{$chatnet}{$lc_nick} =
+ [grep {lc_irc $_ ne $lc_channel} @{$channels{$chatnet}{$lc_nick}}];
+}
+
+sub do_nick($$$$$) {
+ my ($time, $chatnet, $address, $old_nick, $new_nick) = @_;
+ my $lc_old_nick = lc_irc $old_nick;
+ my $lc_new_nick = lc_irc $new_nick;
+ $nicks{$chatnet}{$address} =
+ [(grep {lc_irc $_ ne $lc_old_nick} @{$nicks{$chatnet}{$address}}), $new_nick];
+ my $chans = $channels{$chatnet}{$lc_old_nick};
+ delete $channels{$chatnet}{$lc_old_nick};
+ $channels{$chatnet}{$lc_new_nick} = $chans;
+ $nick_absent{$chatnet}{$lc_old_nick} = $time;
+ delete $nick_absent{$chatnet}{$lc_new_nick};
+ $addresses{$chatnet}{$lc_new_nick} = $address;
+ $orig_nick{$chatnet}{$lc_new_nick} = $new_nick;
+}
+
+sub do_spoke($$$) {
+ my ($time, $chatnet, $address) = @_;
+ my $old_time = $spoke{$chatnet}{$address};
+ $spoke{$chatnet}{$address} = $time
+ unless defined $old_time && $old_time > $time;
+}
+
+sub do_ask($$$$) {
+ my ($time, $chatnet, $nick, $nick_asks) = @_;
+ my $lc_nick = lc_irc $nick;
+ my $lc_nick_asks = lc_irc $nick_asks;
+ my $old_time = $asked{$chatnet}{$lc_nick}{$lc_nick_asks};
+ $asked{$chatnet}{$lc_nick}{$lc_nick_asks} = $time
+ unless defined $old_time && $old_time > $time;
+}
+
+sub do_forget_ask($$$) {
+ my ($chatnet, $nick, $nick_asks) = @_;
+ my $lc_nick = lc_irc $nick;
+ my $lc_nick_asks = lc_irc $nick_asks;
+ delete $asked{$chatnet}{$lc_nick}{$lc_nick_asks};
+}
+
+######## Actions on the database in memory and in the file ########
+
+sub append_to_database(@) {
+ open DATABASE, ">>$database";
+ print DATABASE map {"$_\n"} @_;
+ close DATABASE;
+}
+
+sub on_listen($$$) {
+ my ($chatnet, $channel, $state) = @_;
+ do_listen $chatnet, $channel, $state;
+ append_to_database "listen $state $chatnet $channel";
+}
+
+sub on_join($$$$) {
+ my ($chatnet, $address, $nick, $channel) = @_;
+ do_join $chatnet, $address, $nick, $channel;
+ append_to_database "join $chatnet $address $nick $channel";
+}
+
+sub on_quit_all($$$$) {
+ my ($chatnet, $address, $nick, $reason) = @_;
+ my $time = time();
+ do_quit_all $time, $chatnet, $address, $nick, $reason;
+ append_to_database "quit_all $time $chatnet $address $nick @$reason";
+}
+
+sub on_quit($$$$) {
+ my ($chatnet, $address, $nick, $reason) = @_;
+ my $time = time();
+ do_quit $time, $chatnet, $address, $nick;
+ append_to_database "quit $time $chatnet $address $nick";
+ on_quit_all $chatnet, $address, $nick, $reason
+ unless @{$nicks{$chatnet}{$address}};
+}
+
+sub on_part($$$$$) {
+ my ($chatnet, $address, $nick, $channel, $reason) = @_;
+ do_part $chatnet, $address, $nick, $channel;
+ append_to_database "part $chatnet $address $nick $channel";
+ on_quit $chatnet, $address, $nick, $reason
+ unless @{$channels{$chatnet}{lc_irc $nick}};
+}
+
+sub on_nick($$$$) {
+ my ($chatnet, $address, $old_nick, $new_nick) = @_;
+ my $time = time();
+ do_nick $time, $chatnet, $address, $old_nick, $new_nick;
+ append_to_database "nick $time $chatnet $address $old_nick $new_nick";
+}
+
+sub on_spoke($$) {
+ my ($chatnet, $address) = @_;
+ my $time = time();
+ return if $spoke{$chatnet}{$address} == $time;
+ do_spoke $time, $chatnet, $address;
+ append_to_database "spoke $time $chatnet $address";
+}
+
+sub on_ask($$$) {
+ my ($chatnet, $nick, $nick_asks) = @_;
+ my $time = time();
+ do_ask $time, $chatnet, $nick, $nick_asks;
+ append_to_database "ask $time $chatnet $nick $nick_asks";
+}
+
+######## Reading the database from file ########
+
+sub syntax_error() {
+ die "Syntax error in $database: $_";
+}
+
+our %parse_how_quit = (
+ disappeared => sub {
+ return ['disappeared'];
+ },
+ was_left => sub {
+ $_[0] =~ /^ ([^ ]*)$/ or syntax_error;
+ return ['was_left', $1];
+ },
+ left => sub {
+ $_[0] =~ /^ ([^ ]*) (.*)$/ or syntax_error;
+ return ['left', $1, $2];
+ },
+ quit => sub {
+ $_[0] =~ /^ ([^ ]*) (.*)$/ or syntax_error;
+ return ['quit', $1, $2];
+ },
+ was_kicked => sub {
+ $_[0] =~ /^ ([^ ]*) ([^ ]*) (.*)$/ or syntax_error;
+ return ['was_kicked', $1, $2, $3];
+ },
+);
+
+sub parse_how_quit($) {
+ my ($how_quit) = @_;
+ $how_quit =~ /^([^ ]*)(| .*)$/ or syntax_error;
+ my $func = $parse_how_quit{$1} or syntax_error;
+ return $func->($2);
+}
+
+our %parse_database = (
+ listen => sub {
+ $_[0] =~ /^ (on|off|delay|private|disable) ([^ ]*) ([^ ]*)$/ or syntax_error;
+ do_listen $2, $3, $1;
+ },
+ join => sub {
+ $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
+ do_join $1, $2, $3, $4;
+ },
+ quit_all => sub {
+ $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*) (.*)$/ or syntax_error;
+ my ($time, $chatnet, $address, $nick, $how_quit) = ($1, $2, $3, $4, $5);
+ do_quit_all $time, $chatnet, $address, $nick, parse_how_quit($how_quit);
+ },
+ quit => sub {
+ $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
+ do_quit $1, $2, $3, $4;
+ },
+ part => sub {
+ $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
+ do_part $1, $2, $3, $4;
+ },
+ nick => sub {
+ $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
+ do_nick $1, $2, $3, $4, $5;
+ },
+ spoke => sub {
+ $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
+ do_spoke $1, $2, $3;
+ },
+ ask => sub {
+ $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
+ do_ask $1, $2, $3, $4;
+ },
+ forget_ask => sub {
+ $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
+ do_forget_ask $1, $2, $3;
+ },
+);
+
+sub read_database() {
+ open DATABASE, $database or return;
+ while (<DATABASE>) {
+ chomp;
+ /^([^ ]*)(| .*)$/ or syntax_error;
+ my $func = $parse_database{$1} or syntax_error;
+ $func->($2);
+ }
+ close DATABASE;
+}
+
+######## Writing the database to file ########
+
+sub write_database {
+ open DATABASE, ">$database_tmp";
+ foreach my $chatnet (keys %listen_on) {
+ foreach my $channel (keys %{$listen_on{$chatnet}}) {
+ my $state = $listen_on{$chatnet}{$channel};
+ print DATABASE "listen $state $chatnet $channel\n";
+ }
+ }
+ foreach my $chatnet (keys %nick_absent) {
+ foreach my $nick (keys %{$nick_absent{$chatnet}}) {
+ my $time = $nick_absent{$chatnet}{$nick};
+ my $address = $addresses{$chatnet}{$nick};
+ my $orig = $orig_nick{$chatnet}{$nick};
+ print DATABASE "quit $time $chatnet $address $orig\n";
+ }
+ }
+ foreach my $chatnet (keys %address_absent) {
+ foreach my $address (keys %{$address_absent{$chatnet}}) {
+ my $time = $address_absent{$chatnet}{$address};
+ my $nick = $last_nicks{$chatnet}{$address};
+ my $reason = $how_quit{$chatnet}{$address};
+ print DATABASE "quit_all $time $chatnet $address $nick @$reason\n";
+ }
+ }
+ foreach my $chatnet (keys %spoke) {
+ foreach my $address (keys %{$spoke{$chatnet}}) {
+ my $time = $spoke{$chatnet}{$address};
+ print DATABASE "spoke $time $chatnet $address\n";
+ }
+ }
+ foreach my $chatnet (keys %nicks) {
+ foreach my $address (keys %{$nicks{$chatnet}}) {
+ foreach my $nick (@{$nicks{$chatnet}{$address}}) {
+ foreach my $channel (@{$channels{$chatnet}{lc_irc $nick}}) {
+ print DATABASE "join $chatnet $address $nick $channel\n";
+ }
+ }
+ }
+ }
+ foreach my $chatnet (keys %asked) {
+ foreach my $nick (keys %{$asked{$chatnet}}) {
+ foreach my $nick_asked (keys %{$asked{$chatnet}{$nick}}) {
+ my $time = $asked{$chatnet}{$nick}{$nick_asked};
+ print DATABASE "ask $time $chatnet $nick $nick_asked\n";
+ }
+ }
+ }
+ close DATABASE;
+ rename $database, $database_old;
+ rename $database_tmp, $database;
+}
+
+######## Update the database to reflect currently joined users ########
+
+sub initialize_database() {
+ my $time = time();
+ foreach my $chatnet (keys %nicks) {
+ my @addresses = keys %{$nicks{$chatnet}};
+ foreach my $address (@addresses) {
+ my @nicks = @{$nicks{$chatnet}{$address}};
+ foreach my $nick (@nicks) {
+ do_quit $time, $chatnet, $address, $nick;
+ }
+ do_quit_all $time, $chatnet, $address, $nicks[0], ['disappeared'];
+ }
+ }
+ foreach my $server (Irssi::servers()) {
+ foreach my $channel ($server->channels()) {
+ foreach my $nick ($channel->nicks()) {
+ do_join lc $server->{chatnet},
+ canonical $nick->{host}, $nick->{nick}, $channel->{name}
+ if $nick->{host} ne "";
+ }
+ }
+ }
+}
+
+######## Expire old entries ########
+
+sub expire_database() {
+ my $days = Irssi::settings_get_int("seen_expire_after");
+ my $time = time() - $days*24*60*60;
+ my %reachable_addresses = ();
+ foreach my $chatnet (keys %addresses) {
+ foreach my $address (values %{$addresses{$chatnet}}) {
+ $reachable_addresses{$chatnet}{$address} = 1;
+ }
+ }
+ foreach my $chatnet (keys %address_absent) {
+ foreach my $address (keys %{$address_absent{$chatnet}}) {
+ if ($address_absent{$chatnet}{$address} <= $time ||
+ !$reachable_addresses{$chatnet}{$address}) {
+ delete $address_absent{$chatnet}{$address};
+ delete $last_nicks{$chatnet}{$address};
+ delete $how_quit{$chatnet}{$address};
+ }
+ }
+ }
+ foreach my $chatnet (keys %spoke) {
+ foreach my $address (keys %{$spoke{$chatnet}}) {
+ if ($spoke{$chatnet}{$address} <= $time ||
+ !$reachable_addresses{$chatnet}{$address}) {
+ delete $spoke{$chatnet}{$address};
+ }
+ }
+ }
+ foreach my $chatnet (keys %nick_absent) {
+ foreach my $nick (keys %{$nick_absent{$chatnet}}) {
+ if ($nick_absent{$chatnet}{$nick} <= $time) {
+ delete $nick_absent{$chatnet}{$nick};
+ delete $addresses{$chatnet}{$nick};
+ delete $orig_nick{$chatnet}{$nick};
+ }
+ }
+ }
+ my $days_asked = Irssi::settings_get_int("seen_expire_asked_after");
+ my $time_asked = time() - $days_asked*24*60*60;
+ foreach my $chatnet (keys %asked) {
+ foreach my $nick (keys %{$asked{$chatnet}}) {
+ foreach my $nick_asks (keys %{$asked{$chatnet}{$nick}}) {
+ if ($asked{$chatnet}{$nick}{$nick_asks} <= $time_asked) {
+ delete $asked{$chatnet}{$nick}{$nick_asks};
+ }
+ }
+ }
+ }
+}
+
+######## Compose a description when did we see that person ########
+
+sub show_reason($) {
+ my ($reason) = @_;
+ return ":" if $reason eq "";
+ $reason =~ s/\cc\d\d?(,\d\d?)?|[\000-\037]//g;
+ return ": $reason";
+}
+
+sub only_public(@$) {
+ my $can_show = pop @_;
+ my @channels = ();
+ foreach my $channel (@_) {
+ if ($channel =~ /^-(.*)$/) {
+ push @channels, $1 if $can_show->($1);
+ } else {
+ push @channels, $channel;
+ }
+ }
+ return wantarray ? @channels : $channels[0];
+}
+
+sub is_here(\@$) {
+ my ($channels, $where_asks) = @_;
+ return if !defined $where_asks;
+ my $lc_where_asks = lc_irc $where_asks;
+ foreach my $i (0..$#{$channels}) {
+ if (lc_irc $channels->[$i] eq $lc_where_asks) {
+ splice @{$channels}, $i, 1;
+ return 1;
+ }
+ }
+ return 0;
+}
+
+sub on_channels(@) {
+ return @_ == 1 ? "on the channel $_[0]" : "on the channels " . show_list(@_);
+}
+
+our %show_how_quit = (
+ disappeared => sub {
+ return "they disappeared. No more information is available.";
+ },
+ was_left => sub {
+ my ($true_channel, $where_asks, $can_show) = @_;
+ my $channel = only_public $true_channel, $can_show;
+ return
+ defined $channel ?
+ lc_irc $channel eq lc_irc $where_asks ?
+ "byla here i wtedy stad wyszedlem." :
+ "byla na kanale $channel, z ktorego wtedy wyszedlem." :
+ "byla na kanale, z ktorego wtedy wyszedlem.";
+ },
+ left => sub {
+ my ($true_channel, $reason, $where_asks, $can_show) = @_;
+ my $channel = only_public $true_channel, $can_show;
+ return
+ (defined $channel ?
+ lc_irc $channel eq lc_irc $where_asks ?
+ "person left" : "they left the channel $channel" :
+ "left because") .
+ show_reason($reason);
+ },
+ quit => sub {
+ my ($true_channels, $reason, $where_asks, $can_show) = @_;
+ my @channels = only_public split(/,/, $true_channels), $can_show;
+ my $is_here = is_here @channels, $where_asks;
+ return
+ (@channels == 0 ?
+ $is_here ? "they left " : "" :
+ ($is_here ? "byla tutaj oraz " : "they were seen quitting ") .
+ on_channels(@channels) .
+ " ") .
+ "with the message" . show_reason($reason);
+ },
+ was_kicked => sub {
+ my ($true_channel, $kicker, $reason, $where_asks, $can_show) = @_;
+ my $channel = only_public $true_channel, $can_show;
+ return
+ "they " .
+ (defined $channel ?
+ lc_irc $channel eq lc_irc $where_asks ?
+ "were kicked" : "were kicked from $channel" :
+ "kicked") .
+ " by $kicker" . show_reason($reason);
+ },
+);
+
+sub show_how_quit($$$) {
+ my ($how_quit, $where_asks, $can_show) = @_;
+ return $show_how_quit{$how_quit->[0]}
+ (@{$how_quit}[1..$#{$how_quit}], $where_asks, $can_show);
+}
+
+sub show_where_is($$$$$$$) {
+ my ($server, $nick, $address, $where_asks, $can_show, $asked_and, $spoke_and) = @_;
+ my $chatnet = lc $server->{chatnet};
+ my $lc_nick = lc_irc $nick;
+ my @nicks = @{$nicks{$chatnet}{$address}};
+ @nicks = sort @nicks;
+ my @channels = all_channels($chatnet, @nicks);
+ @channels =
+ only_public
+ map ({mark_private($server->channel_find($_), $_)} sort @channels),
+ $can_show;
+ my $is_here = is_here @channels, $where_asks;
+ my $this_nick_absent = $nick_absent{$chatnet}{$lc_nick};
+ return
+ (defined $this_nick_absent ?
+ "Osoba, ktora uzywala nicka $nick " .
+ show_time_since($this_nick_absent) .
+ ", $asked_and${spoke_and}teraz jest jako " .
+ show_list(@nicks) .
+ " " :
+ "Queried user $asked_and${spoke_and}$nick is currently " .
+ (@nicks == 1 ? "" : "(rowniez jako " .
+ show_list(grep {lc_irc $_ ne $lc_nick} @nicks) . ") ")) .
+ (@channels == 0 ?
+ $is_here ? "in this channel" : "on IRC" :
+ ($is_here ? "here on " : "") . on_channels(@channels)) .
+ ".";
+}
+
+sub seen($$$$$$) {
+ my ($server, $nick, $who_asks, $where_asks, $can_show, $asked) = @_;
+ my $chatnet = lc $server->{chatnet};
+ my $lc_nick = lc_irc $nick;
+ my $address = $addresses{$chatnet}{$lc_nick};
+ unless (defined $address) {
+ if (defined $asked) {return "You asked- $asked about $nick.", 0, 0}
+ return "Sorry, I don't know of $nick.", 0, 0;
+ }
+ $nick = $orig_nick{$chatnet}{$lc_nick};
+ if ($address eq canonical $server->{userhost}) {
+ return "I am $nick!", 1, 0;
+ }
+ if (defined $who_asks && $address eq $who_asks) {
+ return "You are $nick!", 1, 0;
+ }
+ my $asked_and = defined $asked ? "$asked; " : "";
+ my $spoke = $spoke{$chatnet}{$address};
+ my $spoke_and = defined $spoke ?
+ "last spoke " . show_time_since($spoke) . ". " : "";
+ if (defined $address_absent{$chatnet}{$address}) {
+ my $last_nick = $last_nicks{$chatnet}{$address};
+ my $when_address = show_time_since $address_absent{$chatnet}{$address};
+ if (lc_irc $last_nick eq $lc_nick) {
+ return "The person with the nick $nick $asked_and$spoke_and$when_address " .
+ show_how_quit($how_quit{$chatnet}{$address},
+ $where_asks, $can_show), 1, 1;
+ } else {
+ my $when_nick = show_time_since $nick_absent{$chatnet}{$lc_nick};
+ return "Person, who $when_nick used nick $nick, " .
+ "$asked_and$spoke_and$when_address jako $last_nick " .
+ show_how_quit($how_quit{$chatnet}{$address},
+ $where_asks, $can_show), 1, 1;
+ }
+ } else {
+ return show_where_is($server, $nick, $address,
+ $where_asks, $can_show,
+ $asked_and, $spoke_and), 1, 0;
+ }
+}
+
+######## Initialization ########
+
+read_database;
+expire_database;
+initialize_database;
+write_database;
+
+Irssi::timeout_add 60*60*1000, sub {expire_database; write_database}, undef;
+
+######## Irssi signal handlers ########
+
+sub can_show_this_channel($) {
+ my ($channel) = @_;
+ my $lc_channel = lc_irc $channel;
+ return sub {lc_irc $_[0] eq $lc_channel};
+}
+
+sub can_show_his_channels($$) {
+ my ($chatnet, $nick) = @_;
+ my $lc_nick = lc_irc $nick;
+ my @channels = $channels{$chatnet}{$lc_nick} ?
+ @{$channels{$chatnet}{$lc_nick}} : ();
+ return sub {
+ my $channel = lc_irc $_[0];
+ return grep {lc_irc $_ eq $channel} @channels;
+ };
+}
+
+sub check_asked($$$) {
+ my ($chatnet, $server, $nick) = @_;
+ my $lc_nick = lc_irc $nick;
+ my $who_asked = $asked{$chatnet}{$lc_nick};
+ return unless $who_asked;
+ foreach my $nick_asked (sort {$who_asked->{$a} <=> $who_asked->{$b}}
+ keys %{$who_asked}) {
+ my $when_asked = show_time_since $who_asked->{$nick_asked};
+ my ($reply, $found, $remember_asked) =
+ seen $server, $nick_asked, undef, undef,
+ can_show_his_channels($chatnet, $nick),
+ "szukala Cie $when_asked";
+ $server->command("notice $nick $reply");
+ do_forget_ask $chatnet, $nick, $nick_asked;
+ append_to_database "forget_ask $chatnet $nick $nick_asked";
+ }
+}
+
+Irssi::signal_add "channel wholist", sub {
+ my ($channel) = @_;
+ my $server = $channel->{server};
+ my $chatnet = lc $server->{chatnet};
+ foreach my $nick ($channel->nicks()) {
+ my $lc_nick = lc_irc $nick->{nick};
+ my $lc_channel = lc_irc $channel->{name};
+ on_join $chatnet, canonical $nick->{host}, $nick->{nick}, $channel->{name}
+ unless $nick->{host} eq "" ||
+ $channels{$chatnet}{$lc_nick} &&
+ grep {lc_irc $_ eq $lc_channel} @{$channels{$chatnet}{$lc_nick}};
+ check_asked $chatnet, $server, $nick->{nick};
+ }
+};
+
+Irssi::signal_add_first "channel destroyed", sub {
+ my ($channel) = @_;
+ my $chatnet = lc $channel->{server}{chatnet};
+ foreach my $nick ($channel->nicks()) {
+ on_part $chatnet, canonical $nick->{host}, $nick->{nick}, $channel->{name},
+ ['was_left', mark_private($channel, $channel->{name})]
+ unless $nick->{host} eq "";
+ }
+};
+
+Irssi::signal_add "event join", sub {
+ my ($server, $args, $nick, $address) = @_;
+ $args =~ /^:(.*)$/ or $args =~ /^([^ ]+)$/ or return;
+ my $channel = $1;
+ my $chatnet = lc $server->{chatnet};
+ on_join $chatnet, canonical $address, $nick, $channel;
+ check_asked $chatnet, $server, $nick;
+};
+
+Irssi::signal_add "event part", sub {
+ my ($server, $args, $nick, $address) = @_;
+ $args =~ /^([^ ]+) +:(.*)$/ or $args =~ /^([^ ]+) +([^ ]+)$/ or $args =~ /^([^ ]+)()$/ or return;
+ my ($channel, $reason) = ($1, $2);
+ my $chatnet = lc $server->{chatnet};
+ return if defined $nick_absent{$chatnet}{lc_irc $nick};
+ $reason = "" if $reason eq $nick;
+ on_part $chatnet, canonical $address, $nick, $channel,
+ ['left', mark_private($server->channel_find($channel), $channel), $reason];
+};
+
+Irssi::signal_add "event quit", sub {
+ my ($server, $args, $nick, $address) = @_;
+ $args =~ /^:(.*)$/ or $args =~ /^([^ ]+)$/ or $args =~ /^()$/ or return;
+ my $reason = $1;
+ my $chatnet = lc $server->{chatnet};
+ my $lc_nick = lc_irc $nick;
+ return if defined $nick_absent{$chatnet}{$lc_nick};
+ $reason = "" if $reason =~ /^(Quit: )?(leaving)?$/;
+ my @channels = $channels{$chatnet}{$lc_nick} ?
+ @{$channels{$chatnet}{$lc_nick}} : ();
+ on_quit $chatnet, canonical $address, $nick,
+ ['quit', join(",", map {mark_private($server->channel_find($_), $_)} sort @channels), $reason];
+};
+
+Irssi::signal_add "event kick", sub {
+ my ($server, $args, $kicker, $kicker_address) = @_;
+ $args =~ /^([^ ]+) +([^ ]+) +:(.*)$/ or $args =~ /^([^ ]+) +([^ ]+) +([^ ]+)$/ or
+ $args =~ /^([^ ]+) +([^ ]+)()$/ or return;
+ my ($channel, $nick, $reason) = ($1, $2, $3);
+ my $chatnet = lc $server->{chatnet};
+ $reason = "" if $reason eq $kicker;
+ on_part $chatnet, $addresses{$chatnet}{lc_irc $nick}, $nick, $channel,
+ ['was_kicked', mark_private($server->channel_find($channel), $channel), $kicker, $reason];
+};
+
+Irssi::signal_add "event nick", sub {
+ my ($server, $args, $old_nick, $address) = @_;
+ $args =~ /^:(.*)$/ or $args =~ /^([^ ]+)$/ or return;
+ my $new_nick = $1;
+ return if $address eq "";
+ my $chatnet = lc $server->{chatnet};
+ on_nick $chatnet, canonical $address, $old_nick, $new_nick;
+ check_asked $chatnet, $server, $new_nick;
+};
+
+######## Commands ########
+
+Irssi::command_bind "seen", sub {
+ my ($args, $server, $target) = @_;
+ my $nick;
+ if ($args =~ /^ *([^ ]+) *$/) {
+ $nick = $1;
+ } else {
+ Irssi::print "Usage: /seen <nick>";
+ return;
+ }
+ unless ($server && $server->{connected}) {
+ Irssi::print "Not connected to server";
+ return;
+ }
+ my ($reply, $found, $remember_asked) =
+ seen $server, $nick, undef, undef, sub {1}, undef;
+ Irssi::print $reply;
+};
+
+Irssi::command_bind "say_seen", sub {
+ my ($args, $server, $target) = @_;
+ my $chatnet = lc $server->{chatnet};
+ my ($nick_asks, $prefix, $nick);
+ if ($args =~ /^ *([^ ]+) *$/) {
+ $nick_asks = undef;
+ $prefix = "";
+ $nick = $1;
+ } elsif ($args =~ /^ *([^ ]+) +([^ ]+) *$/) {
+ $nick_asks = $1;
+ $prefix = "$1: ";
+ $nick = $2;
+ } else {
+ Irssi::print "Usage: /say_seen [<to_whom>] <nick>";
+ return;
+ }
+ unless ($server && $server->{connected}) {
+ Irssi::print "Not connected to server";
+ return;
+ }
+ unless ($target) {
+ Irssi::print "Not in a channel or query";
+ return;
+ }
+ my $can_show =
+ $target->{type} eq 'CHANNEL' ?
+ can_show_this_channel($target->{name}) :
+ $target->{type} eq 'QUERY' ?
+ can_show_his_channels($chatnet, $target->{name}) :
+ sub {0};
+ my ($reply, $found, $remember_asked) =
+ seen $server, $nick, undef, $target->{name}, $can_show, undef;
+ on_ask $chatnet, $nick, $nick_asks
+ if defined $nick_asks && $remember_asked;
+ $server->command("msg $target->{name} $prefix$reply");
+};
+
+sub cmd_listen_switch($$$$) {
+ my ($state, $args, $server, $target) = @_;
+ if ($args =~ /^ *$/) {
+ unless ($server && $server->{connected}) {
+ Irssi::print "Not connected to server";
+ return;
+ }
+ unless ($target && $target->{type} eq 'CHANNEL') {
+ Irssi::print "Not in a channel";
+ return;
+ }
+ on_listen lc $server->{chatnet}, lc_irc $target->{name}, $state;
+ } elsif ($args =~ /^ *([^ ]+) *$/)
+ {
+ unless ($server && $server->{connected}) {
+ Irssi::print "Not connected to server";
+ return;
+ }
+ on_listen lc $server->{chatnet}, lc_irc $1, $state;
+ } elsif ($args =~ /^ *([^ ]+) +([^ ]+) *$/)
+ {
+ on_listen lc $1, lc_irc $2, $state;
+ } else {
+ Irssi::print "Usage: /listen $state [[<chatnet>] <channel>]";
+ }
+}
+
+Irssi::command_bind "listen", sub {
+ my ($args, $server, $target) = @_;
+ Irssi::command_runsub "listen", $args, $server, $target;
+};
+
+Irssi::command_bind "listen on", sub {
+ my ($args, $server, $target) = @_;
+ cmd_listen_switch "on", $args, $server, $target;
+};
+
+Irssi::command_bind "listen off", sub {
+ my ($args, $server, $target) = @_;
+ cmd_listen_switch "off", $args, $server, $target;
+};
+
+Irssi::command_bind "listen delay", sub {
+ my ($args, $server, $target) = @_;
+ cmd_listen_switch "delay", $args, $server, $target;
+};
+
+Irssi::command_bind "listen private", sub {
+ my ($args, $server, $target) = @_;
+ cmd_listen_switch "private", $args, $server, $target;
+};
+
+Irssi::command_bind "listen disable", sub {
+ my ($args, $server, $target) = @_;
+ cmd_listen_switch "disable", $args, $server, $target;
+};
+
+our @joined_text = (" ", "joined");
+
+Irssi::command_bind "listen list", sub {
+ my ($args, $server, $target) = @_;
+ if ($args =~ /^ *$/) {
+ my %all_channels = ();
+ foreach my $server (Irssi::servers()) {
+ my $chatnet = lc $server->{chatnet};
+ foreach my $channel ($server->channels()) {
+ $all_channels{$chatnet}{lc_irc $channel->{name}}[0] = 1;
+ }
+ }
+ foreach my $chatnet (keys %listen_on) {
+ foreach my $channel (keys %{$listen_on{$chatnet}}) {
+ $all_channels{$chatnet}{$channel}[1] = $listen_on{$chatnet}{$channel};
+ }
+ }
+ my $max_chatnet_width = 1;
+ my $max_channel_width = 1;
+ foreach my $chatnet (keys %all_channels) {
+ $max_chatnet_width = length $chatnet
+ if length $chatnet > $max_chatnet_width;
+ foreach my $channel (keys %{$all_channels{$chatnet}}) {
+ $max_channel_width = length $channel
+ if length $channel > $max_channel_width;
+ }
+ }
+ Irssi::print "'seen' is listening:";
+ foreach my $chatnet (sort keys %all_channels) {
+ foreach my $channel (sort keys %{$all_channels{$chatnet}}) {
+ Irssi::print
+ $chatnet .
+ " " x ($max_chatnet_width - length ($chatnet) + 1) .
+ $channel .
+ " " x ($max_channel_width - length ($channel) + 3) .
+ $joined_text[$all_channels{$chatnet}{$channel}[0]] .
+ " " .
+ $all_channels{$chatnet}{$channel}[1];
+ }
+ }
+ } else {
+ Irssi::print "Usage: /listen list";
+ }
+};
+
+Irssi::command_bind "forget", sub {
+ my ($args, $server, $target) = @_;
+ my $nick;
+ if ($args =~ /^ *([^ ]+) *$/) {
+ $nick = $1;
+ } else {
+ Irssi::print "Usage: /forget <nick>";
+ return;
+ }
+ unless ($server) {
+ Irssi::print "Not connected to server";
+ return;
+ }
+ my $chatnet = lc $server->{chatnet};
+ return unless $asked{$chatnet}{$nick};
+ foreach my $nick_asked (keys %{$asked{$chatnet}{$nick}}) {
+ do_forget_ask $chatnet, $nick, $nick_asked;
+ append_to_database "forget_ask $chatnet $nick $nick_asked";
+ }
+};
+
+######## Listen to seen requests from other people ########
+
+our $last_reply = undef;
+our $last_asked = undef;
+
+our %pending_replies = ();
+
+sub seen_reply($$$$$$) {
+ my ($server, $nick_asks, $address, $target, $nick, $sure) = @_;
+ my $chatnet = lc $server->{chatnet};
+ my ($reply, $found, $remember_asked) =
+ seen $server, $nick, $address, $target,
+ can_show_this_channel($target), undef;
+ return unless $sure || $found;
+ unless ($reply eq $last_reply && $nick eq $last_asked) {
+ Irssi::print "[$target] $nick_asks: $reply";
+ $server->command("msg $target $nick_asks: $reply");
+ $last_reply = $reply;
+ $last_asked = $nick;
+ }
+ on_ask $chatnet, $nick, $nick_asks if $remember_asked;
+}
+
+sub private_seen_reply($$$$$$) {
+ my ($server, $nick_asks, $address, $target, $nick, $sure) = @_;
+ my $chatnet = lc $server->{chatnet};
+ my ($reply, $found, $remember_asked) =
+ seen $server, $nick, $address, undef,
+ can_show_his_channels($chatnet, $nick_asks), undef;
+ return unless $sure || $found;
+ $server->command("notice $nick_asks $reply");
+ $server->command("notice $nick_asks " .
+ "Pytac o obecnosc ludzi mozesz mnie tez prywatnie, np. /msg $server->{nick} seen $nick");
+ on_ask $chatnet, $nick, $nick_asks if $remember_asked;
+}
+
+sub delayed_seen_reply($$$$$$) {
+ my ($server, $nick_asks, $address, $target, $nick, $sure) = @_;
+ my $chatnet = lc $server->{chatnet};
+ my $lc_nick = lc_irc $nick;
+ return if defined $pending_replies{$chatnet}{$target}{$lc_nick};
+ my $timeout = Irssi::settings_get_int("seen_delay") * 1000;
+ $pending_replies{$chatnet}{$target}{$lc_nick} = Irssi::timeout_add_once $timeout, sub {
+ delete $pending_replies{$chatnet}{$target}{$lc_nick};
+ seen_reply $server, $nick_asks, $address, $target, $nick, $sure;
+ }, undef;
+}
+
+our %reply_method = (
+ on => \&seen_reply,
+ off => undef,
+ delay => \&delayed_seen_reply,
+ private => \&private_seen_reply,
+ disable => undef,
+);
+
+sub check_another_seen($$$$) {
+ my ($chatnet, $channel, $msg, $nick_asks) = @_;
+ my $lc_channel = lc_irc $channel;
+ if ($listen_on{$chatnet}{$lc_channel} eq 'delay') {
+ foreach my $nick (keys %{$pending_replies{$chatnet}{$channel}}) {
+ my $nick_regexp = lc_irc_regexp $nick;
+ if ($msg =~ /(^|[ \cb])$nick_regexp($|[ !,.:;?\cb])/ ||
+ lc_irc $nick_asks eq $nick) {
+ my $tag = $pending_replies{$chatnet}{$channel}{$nick};
+ Irssi::timeout_remove $tag;
+ delete $pending_replies{$chatnet}{$channel}{$nick};
+ }
+ }
+ }
+}
+
+Irssi::signal_add "message public", sub {
+ my ($server, $msg, $nick_asks, $address, $channel) = @_;
+ my $chatnet = lc $server->{chatnet};
+ $address = canonical $address;
+ on_spoke $chatnet, $address;
+ my $lc_channel = lc_irc $channel;
+ my ($msg_body, $func) =
+ $msg =~ /^\Q$server->{nick}\E(?:|:|\cb:\cb) +(.*)$/i ? ($1, \&seen_reply) :
+ ($msg, $reply_method{$listen_on{$chatnet}{$lc_channel} || 'off'});
+ if (defined $func) {
+ my $sure =
+ $msg_body =~ $seen_regexp ? 1 :
+ $msg_body =~ $maybe_seen_regexp1 ||
+ $msg_body =~ $maybe_seen_regexp2 ? 0 :
+ undef;
+ if (defined $sure) {
+ my $nick = $1;
+ return if $sure == 0 && $nick =~ $exclude_regexp;
+ Irssi::signal_continue @_;
+ $func->($server, $nick_asks, $address, $channel, $nick, $sure);
+ return;
+ }
+ }
+ check_another_seen $chatnet, $channel, $msg, $nick_asks;
+};
+
+Irssi::signal_add "message irc notice", sub {
+ my ($server, $msg, $nick_asks, $address, $target) = @_;
+ my $chatnet = lc $server->{chatnet};
+ check_another_seen $chatnet, $target, $msg, $nick_asks;
+};
+
+Irssi::signal_add "message private", sub {
+ my ($server, $msg, $nick_asks, $address) = @_;
+ my $chatnet = lc $server->{chatnet};
+ on_spoke $chatnet, canonical $address;
+ check_asked $chatnet, $server, $nick_asks;
+ my $sure =
+ $msg =~ $seen_regexp ? 1 :
+ $msg =~ $maybe_seen_regexp1 ||
+ $msg =~ $maybe_seen_regexp2 ? 0 :
+ undef;
+ if (defined $sure) {
+ my $nick = $1;
+ my ($reply, $found, $remember_asked) =
+ seen $server, $nick, canonical $address, undef,
+ can_show_his_channels($chatnet, $nick_asks), undef;
+ return unless $sure || $found;
+ Irssi::signal_continue @_;
+ $server->command("msg $nick_asks $reply");
+ on_ask $chatnet, $nick, $nick_asks if $remember_asked;
+ }
+};
+
+Irssi::signal_add "message irc action", sub {
+ my ($server, $msg, $nick, $address, $target) = @_;
+ on_spoke lc $server->{chatnet}, canonical $address;
+};
diff --git a/scripts/servercomplete.pl b/scripts/servercomplete.pl
new file mode 100644
index 0000000..4d92f96
--- /dev/null
+++ b/scripts/servercomplete.pl
@@ -0,0 +1,85 @@
+use Irssi 20020101.0250 ();
+$VERSION = "2";
+%IRSSI = (
+ authors => 'David Leadbeater',
+ contact => 'dgl@dgl.cx',
+ name => 'servercomplete',
+ description => 'Tab complete servers and userhosts (irc. -> irc server, user@ -> user@host). Useful for lazy ircops for /squit and so on :)',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.dgl.yi.org/',
+);
+
+use strict;
+my %servers;
+
+sub sig_complete {
+ my ($complist, $window, $word, $linestart, $want_space) = @_;
+ my $tag = $window->{active_server}->{tag};
+
+ if($word =~ /[!*@]/) {
+ my $wi = Irssi::active_win()->{active};
+ return unless ref $wi and $wi->{type} eq 'CHANNEL';
+ my $server = $wi->{server};
+ return unless ref $server;
+
+ my($nick,$ident,$host) = ('','','');
+
+ $nick = $1 if $word =~ /([^!]+)!/ && $1;
+ $ident = $1 if $word !~ /!$/ && $word =~ /!?([^@]+)(@|$)/ && $1;
+ $host = $1 if $word =~ /@(.*)$/ && $1;
+
+ for my $n ($wi->nicks()) {
+ next if not_wild($nick) and $n->{nick} !~ /^\Q$nick\E/i;
+
+ my($user,$addr) = split(/@/, $n->{host});
+
+ next if not_wild($ident) and $user !~ /^\Q$ident\E/i;
+ next if not_wild($host) and $addr !~ /^\Q$host\E/i;
+
+ if($word =~ /!/) {
+ push @$complist, get_match($n->{nick}, $nick) . '!' . get_match($user, $ident) . '@' . get_match($addr,$host);
+ }else{
+ push @$complist, get_match($user, $ident) . '@' . get_match($addr,$host);
+ }
+ }
+ }
+
+ return unless $servers{$tag};
+ for (keys %{$servers{$tag}}) {
+ push @$complist, $_ if /^\Q$word\E/;
+ }
+}
+
+sub get_match {
+ my($match, $thing) = @_;
+ return $thing eq '*' ? '*' : $match;
+}
+
+sub not_wild {
+ return 0 if($_[0] eq '*' || $_[0] eq '');
+ 1;
+}
+
+sub add_server {
+ my($tag,$data,$offset) = @_;
+ $servers{$tag}{(split(/ /,$data))[$offset]} = 1;
+}
+
+Irssi::signal_add_last('complete word', 'sig_complete');
+
+Irssi::signal_add('event 352', sub {
+ my($server,$data) = @_;
+ add_server($server->{tag}, $data, 4);
+} );
+
+Irssi::signal_add('event 312', sub {
+ my($server,$data) = @_;
+ add_server($server->{tag}, $data, 2);
+} );
+
+Irssi::signal_add('event 364', sub {
+ my($server,$data) = @_;
+ add_server($server->{tag}, $data, 1);
+ add_server($server->{tag}, $data, 2);
+} );
+
diff --git a/scripts/seti.pl b/scripts/seti.pl
new file mode 100644
index 0000000..cb0f489
--- /dev/null
+++ b/scripts/seti.pl
@@ -0,0 +1,50 @@
+# This is not a well written script, but it works. I hope.
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '0.1';
+%IRSSI = (
+ authors => 'optical',
+ contact => 'optical@linux.nu',
+ name => 'SETI@home info',
+ description => 'Tell ppl how far you\'ve gotten with you SETI\@home workunit.',
+ license => 'GPL',
+ url => 'http://optical.kapitalet.org/seti/',
+ changed => 'Sat Jul 13 12:03:42 CEST 2002',
+ commands => '/seti <#channel>|<nick>',
+ note => 'Make sure you set the seti_state_sah with /set'
+);
+
+sub seti_info {
+
+ my $WHERES_SETI_STATE_SAH = Irssi::settings_get_str('seti_state_sah');
+
+ my ($data, $server, $witem) = @_;
+
+ my $line;
+ open(INFO, "<", $WHERES_SETI_STATE_SAH);
+ for(my $tmp = 0; $tmp < 5; $tmp++) {
+ $line = <INFO>;
+ }
+ close(INFO);
+ my $proc = substr($line, 7, 4)/100;
+ my $output = "progress of this SETI\@home workunit: $proc%";
+
+ if($data)
+ {
+ $server->command("MSG $data $output");
+ }
+ elsif($witem && ($witem->{type} == "QUERY" ||
+ $witem->{type} == "CHANNEL"))
+ {
+ $witem->command("MSG ".$witem->{name}." $output");
+ }
+ else
+ {
+ Irssi::print("$output");
+ }
+}
+
+Irssi::command_bind('seti', 'seti_info');
+Irssi::settings_add_str('misc', 'seti_state_sah', '~/setiathome-3.03.i386-pc-linux-gnu-gnulibc2.1/state.sah');
diff --git a/scripts/shortenurl.pl b/scripts/shortenurl.pl
new file mode 100644
index 0000000..8428842
--- /dev/null
+++ b/scripts/shortenurl.pl
@@ -0,0 +1,170 @@
+# shortenurl.pl v 0.7.1 by Marcin Ró¿ycki (derwan@irssi.pl)
+#
+# Usage:
+# /shortenurl [url]
+# /shortenurl -L
+# /shortenurl [index]
+#
+# Settings:
+# shortenurl_autoconvert_minlen [length]
+# if shortenurl_autoconvert_minlen is greater than 0 and length of url is
+# greater than shortenurl_autoconvert_minlen then link will be
+# converted automaticaly
+#
+# Simultaneously there can be three links converted!
+#
+# Special thanks to Piotr Kucharski (Beeth) for changes in 42.pl/url/ service which
+# made communication between script and web easier.
+#
+
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use LWP::UserAgent;
+use POSIX '_exit';
+use IO::File;
+use Irssi qw( command_bind version settings_add_int settings_get_int signal_add_last theme_register active_win );
+
+$VERSION = '0.7.1';
+%IRSSI = (
+ authors => 'Marcin Rozycki',
+ contact => 'derwan@irssi.pl',
+ name => 'shortenurl',
+ description => 'shortenurl',
+ license => 'GNU GPL v2',
+ url => 'http://derwan.irssi.pl',
+ changed => 'Sat Jun 26 19:17:02 CEST 2004',
+);
+
+our $agent = sprintf("Irssi %s ", version);
+our $active = 0;
+our $active_max = 3;
+our @url = ();
+our %tags = ();
+our %cache = ();
+our $maxlength = 0;
+
+theme_register([
+ 'shortenurl_url_list', '[%_$0%_] url %_$1%_ [by $2 ($3), $4 secs ago]',
+ 'shortenurl_url_show', 'Shortened url $0 => %_$1%_',
+ 'shortenurl_connect', 'Connecting to http://42.pl/url, this may take a while...',
+ 'shortenurl_url_error', 'Cannot connect to http://42.pl/url service!'
+]);
+
+sub shortenurl ($$$) {
+ my ($data, $server, $witem) = @_;
+ $witem = $server->window_item_find($1) if ( $data =~ s/^-w\s([^\s]+)\s// );
+ $witem = active_win() unless $witem;
+ if ( $data =~ /^-L/i ) {
+ my $time = time();
+ for (my $idx = 0; $idx <= $#url; $idx++) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'shortenurl_url_list', sprintf('%2d',($idx + 1)),
+ url2short($url[$idx]->[0]), $url[$idx]->[1], $url[$idx]->[2], ($time - $url[$idx]->[3]) );
+ }
+ return;
+ } elsif ( $data =~ m/^\d+$/ ) {
+ if ( my $url = $url[--$data] ) {
+ $server->command('shortenurl ' . $url->[0]);
+ } else {
+ Irssi::print("shortenurl: index too high", MSGLEVEL_CRAP);
+ }
+ return;
+ } elsif ( not $data ) {
+ Irssi::print('Usage: /shortenurl [url]', MSGLEVEL_CRAP);
+ Irssi::print('Usage: /shortenurl -L', MSGLEVEL_CRAP);
+ Irssi::print('Usage: /shortenurl [index]', MSGLEVEL_CRAP);
+ return;
+ }
+
+ my $url = $data;
+ $url =~ s/([^\w])/sprintf("%%%02X",ord($1))/ge;
+
+ my $hash = unpack('H*', $url);
+ if ( exists $cache{$hash} ) {
+ $witem->printformat(MSGLEVEL_CRAP, 'shortenurl_url_show', url2short($data), $cache{$hash});
+ return;
+ }
+
+ return if ( $active > $active_max );
+
+ my $reader = IO::File->new() or return;
+ my $writer = IO::File->new() or return;
+ pipe($reader, $writer);
+ my $pid = fork();
+
+ if ( $pid ) {
+ $active++;
+ close($writer);
+ Irssi::pidwait_add($pid);
+ $witem->printformat(MSGLEVEL_CRAP, 'shortenurl_connect');
+ $tags{$reader} = [ Irssi::input_add(fileno($reader), INPUT_READ, \&do_fork, $reader), $server->{tag}, $witem->{name} ];
+ } elsif ( defined $pid ) {
+ close($reader);
+ my $ua = new LWP::UserAgent;
+ $ua->agent($agent . $ua->agent);
+ my $request = new HTTP::Request GET => "http://42.pl/url/?auto=1&url=$url";
+ my $s = $ua->request($request);
+ my $content = $s->content();
+ my $buf = ( $content =~ m/(http\:\/\/[^\s]+)/ ) ? "$1 -- $hash -- $data\n" : 0;
+ print($writer "$buf\n");
+ close($writer);
+ POSIX::_exit(1);
+ } else {
+ close($reader);
+ close($writer);
+ Irssi::print("Cannot fork!");
+ }
+}
+
+sub url2short ($) {
+ my $url = shift;
+ my $length = length($url);
+ substr($url, 15, $length - 32) = '...' if ( $length - 32 > 0 );
+ return $url;
+}
+
+sub do_fork {
+ my $reader = shift();
+ my $data = <$reader>;
+ Irssi::input_remove($tags{$reader}->[0]);
+ close($reader);
+ my $server = Irssi::server_find_tag($tags{$reader}->[1]);
+ my $window = ( $server ) ? $server->window_item_find($tags{$reader}->[2]) : undef;
+ $tags{$reader} = ();
+ delete $tags{$reader};
+ $active--;
+ $window = active_win() unless $window;
+ if ( $data =~ m/(.*) -- (.*) -- (.*)/ ) {
+ $window->printformat(MSGLEVEL_CRAP, 'shortenurl_url_show', url2short($3), $1);
+ $cache{$2} = $1;
+ } else {
+ $window->printformat(MSGLEVEL_CRAP, 'shortenurl_url_error');
+ }
+}
+
+sub do_shortenurl ($$$$$) {
+ my ($server, $data, $who, $where, $winname) = @_;
+ while ( $data =~ m/((http|ftp|https):\/\/[^\s]+)/g ) {
+ my ($test, $url) = (0, $1);
+ $server->command(sprintf('shortenurl -w %s %s', $winname, $url)) if
+ ( $url !~ m/^http:\/\/42\.pl\/url/ and $maxlength > 0 and length($url) > $maxlength );
+ foreach my $u ( @url ) {
+ $test = 1, last if ( $u->[0] eq $url );
+ }
+ next if $test;
+ unshift @url, [ $url, $who, $where, time ];
+ $#url = 9 if ( $#url > 9 );
+ }
+}
+
+sub do_setup { $maxlength = settings_get_int('shortenurl_autoconvert_minlen'); };
+
+command_bind('shortenurl', 'shortenurl');
+command_bind('42.pl', 'shortenurl');
+signal_add_last('message public' => sub { do_shortenurl($_[0], $_[1], $_[2], $_[4], $_[4]) });
+signal_add_last('message private' => sub { do_shortenurl($_[0], $_[1], $_[2], $_[3], $_[2]) });
+signal_add_last('setup changed', 'do_setup');
+settings_add_int('misc', 'shortenurl_autoconvert_minlen', $maxlength);
+
+do_setup();
diff --git a/scripts/showhilight.pl b/scripts/showhilight.pl
new file mode 100644
index 0000000..e55dd31
--- /dev/null
+++ b/scripts/showhilight.pl
@@ -0,0 +1,32 @@
+# Print hilighted messages with MSGLEVEL_PUBLIC to active window
+# for irssi 0.7.99 by Paweł 'Styx' Chuchmała based on hilightwin.pl by Timo Sirainen
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.2";
+%IRSSI = (
+ authors => "Paweł \'Styx\' Chuchmała",
+ contact => "styx\@irc.pl",
+ name => "showhilight",
+ description => "Show hilight messages in active window",
+ license => "GNU GPLv2",
+ changed => "Fri Jun 28 11:09:42 CET 2002"
+
+);
+
+sub sig_printtext {
+ my ($dest, $text, $stripped) = @_;
+
+ my $window = Irssi::active_win();
+
+ if (($dest->{level} & MSGLEVEL_HILIGHT) && ($dest->{level} & MSGLEVEL_PUBLIC) &&
+ ($window->{refnum} != $dest->{window}->{refnum}) && ($dest->{level} & MSGLEVEL_NOHILIGHT) == 0) {
+
+ $text =~ s/%/%%/g;
+ $text = $dest->{target}.":%K[".Irssi::settings_get_str('hilight_color').$dest->{window}->{refnum}."%K]:".$text;
+
+ $window->print($text, MSGLEVEL_CLIENTCRAP);
+ }
+}
+
+Irssi::signal_add('print text', 'sig_printtext');
diff --git a/scripts/showhost.pl b/scripts/showhost.pl
new file mode 100644
index 0000000..9f2841b
--- /dev/null
+++ b/scripts/showhost.pl
@@ -0,0 +1,68 @@
+use strict;
+use Irssi 20021028;
+use vars qw($VERSION %IRSSI);
+
+# Usage:
+# To add the host by a kick, for example, use:
+# /format kick {channick $0} {chanhost $host{$0}} was kicked from {channel $1} by {nick $2} {reason $3}
+#
+# Result:
+# 19:23:42 -!- Nick [user@leet.hostname.org] was kicked from #channel by MyNick [leet reason]
+
+
+
+$VERSION = "0.2";
+%IRSSI = (
+ authors => "Michiel v Vaardegem",
+ contact => "michielv\@zeelandnet.nl",
+ name => "showhost",
+ description => "show host kicks",
+ license => "GPL",
+ changed => "Mon Dec 8 19:23:51 CET 2003"
+);
+
+my $lasthost;
+
+sub setlast
+{
+ my ($server, $channelname, $nickname) = @_;
+ my @channels;
+ $lasthost = {};
+ if (defined($channelname))
+ {
+ $channels[0] = $server->channel_find($channelname);
+ if (!defined($channels[0]))
+ {
+ return;
+ }
+ }
+ else
+ {
+ @channels = $server->channels();
+ }
+
+ foreach my $channel (@channels)
+ {
+ my $nick = $channel->nick_find($nickname);
+ if (defined($nick))
+ {
+ $lasthost->{$channel->{'name'}} = $nick->{host};
+ }
+ }
+}
+
+sub expando_mode
+{
+ my ($server,$item,$mode2) = @_;
+ if (!defined($item) || $item->{'type'} ne 'CHANNEL' )
+ {
+ return '';
+ }
+ return $lasthost->{$item->{'name'}};
+}
+
+
+Irssi::signal_add_first('message kick', sub {setlast($_[0],$_[1],$_[2]); });
+
+Irssi::expando_create('host', sub {expando_mode($_[0],$_[1],0)},{ 'message part' => 'None'});
+
diff --git a/scripts/showmode.pl b/scripts/showmode.pl
new file mode 100644
index 0000000..3095b2c
--- /dev/null
+++ b/scripts/showmode.pl
@@ -0,0 +1,83 @@
+# This script shows modes in parts, quits, kicks, topic changes or actions, like show_nickmode does for public messages
+#
+# Usage:
+# You must change your formats to include the $mode, for example:
+# default format for part is:
+# {channick $0} {chanhost $1} has left {channel $2} {reason $3}
+# to include the mode, do
+# /format part $mode{channick $0} {chanhost $1} has left {channel $2} {reason $3}
+# for quits:
+# /format $mode{channick $0} {chanhost $1} has quit {reason $2}
+
+# Copyright (C) 2003-2007 Wouter Coekaerts <coekie@irssi.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+use strict;
+use Irssi 20021028;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.3";
+%IRSSI = (
+ authors => "Wouter Coekaerts",
+ contact => "wouter\@coekaerts.be",
+ name => "showmode",
+ description => "show modes in parts, quits, kicks, topic changes or actions, like show_nickmode does for public messages",
+ license => "GPLv2 or later",
+ changed => "2007-07-28"
+);
+
+my @lastmode;
+
+# $mode2 is 0 for $mode, 1 for $mode2 (only used for 'the kicker')
+sub setlast {
+ my ($mode2, $server, $channelname, $nickname) = @_;
+ my @channels;
+ @lastmode[$mode2] = {};
+ if (defined($channelname)) {
+ $channels[0] = $server->channel_find($channelname);
+ if (!defined($channels[0])) {
+ return;
+ }
+ } else {
+ @channels = $server->channels();
+
+ }
+
+ foreach my $channel (@channels) {
+ my $nick = $channel->nick_find($nickname);
+ if (defined($nick)) {
+ $lastmode[$mode2]->{$channel->{'name'}} = $nick->{'op'} ? '@' : $nick->{halfop} ? '%' : $nick->{voice} ? '+' : '' ;
+ }
+ }
+}
+
+sub expando_mode {
+ my ($server,$item,$mode2) = @_;
+ if (!defined($item) || $item->{'type'} ne 'CHANNEL' ) {
+ return '';
+ }
+ return $lastmode[$mode2]->{$item->{'name'}};
+}
+
+Irssi::signal_add_first('message part', sub {setlast(0,$_[0],$_[1],$_[2]);});
+Irssi::signal_add_first('message quit', sub {setlast(0,$_[0],undef,$_[1]);});
+Irssi::signal_add_first('message topic', sub {setlast(0,$_[0],$_[1],$_[2]);});
+Irssi::signal_add_first('message kick', sub {setlast(0,$_[0],$_[1],$_[2]); setlast(1,$_[0],$_[1],$_[3]);});
+Irssi::signal_add_first('message irc action', sub {setlast(0,$_[0],$_[4],$_[2]);});
+Irssi::signal_add_first('message irc own_action', sub {setlast(0,$_[0],$_[2],$_[0]->{nick});});
+
+Irssi::expando_create('mode', sub {expando_mode($_[0],$_[1],0)},{ 'message part' => 'None'});
+Irssi::expando_create('mode2', sub {expando_mode($_[0],$_[1],1)},{ 'message part' => 'None'});
diff --git a/scripts/smiley.pl b/scripts/smiley.pl
new file mode 100644
index 0000000..d81437b
--- /dev/null
+++ b/scripts/smiley.pl
@@ -0,0 +1,43 @@
+use Irssi;
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = '0.69';
+
+%IRSSI = (
+ authors => 'Jonne Piittinen',
+ contact => 'jip@loota.org',
+ name => 'Smiley',
+ description => 'Very useful smiley-flooder',
+ license => 'Public Domain',
+);
+
+print "<--------[------------------------------]-------->";
+print "<--------[ smiley-script v. $VERSION. ]-------->";
+print "<--------[ /smiley to generate a smiley ]-------->";
+print "<--------[------------------------------]-------->";
+
+sub gen_smiley {
+
+ my ($data, $server, $witem) = @_;
+ my @smilies;
+ my $string;
+ my $i;
+
+ @smilies = (':)',':D',';D',':P',':>','=D','=)',':E',':]');
+
+ for ($i = 0; $i < 100; $i++) {
+ if (rand(4) > 2 && $i > 0 && $string !~ / $/) {
+ $string .= " ";
+ } else {
+ $string .= @smilies[rand($#smilies-1)];
+ }
+ }
+
+ if ($witem) {
+ $witem->command("MSG ".$witem->{name}." ".$string);
+ } else {
+ Irssi::print("No active channel or query in this window.");
+ }
+}
+
+Irssi::command_bind('smiley', 'gen_smiley');
diff --git a/scripts/sms.pl b/scripts/sms.pl
new file mode 100644
index 0000000..14a4125
--- /dev/null
+++ b/scripts/sms.pl
@@ -0,0 +1,439 @@
+use strict;
+use Irssi 20020300;
+use 5.6.0;
+use Socket;
+use POSIX;
+
+use vars qw($VERSION %IRSSI %HELP);
+$HELP{sms} = "
+SMS <handle or phone number> <text>
+
+Sends sms to handle from addressbook (see HELP addsms and listsms)
+or phone number.
+";
+$HELP{addsms} = "
+ADDSMS <handle> <phone number>
+
+Adds 'handle' with phone 'phone number' to addressbook,
+or change phone number of existing handle.
+";
+$HELP{delsms} = "
+DELSMS <handle or number from listsms>
+
+Deletes entry from addressbook.
+";
+$HELP{listsms} = "
+LISTSMS [handle match]
+
+Lists addressbook.
+";
+$VERSION = "1.5b";
+%IRSSI = (
+ authors => "Maciek \'fahren\' Freudenheim",
+ contact => "fahren\@bochnia.pl",
+ name => "SMS",
+ description => "/ADDSMS, /DELSMS, /LISTSMS and /SMS - phone address-book with smssender, for now supports only Polish operators",
+ license => "GNU GPLv2 or later",
+ changed => "Fri Jan 10 03:54:07 CET 2003"
+);
+
+Irssi::theme_register([
+ 'sms_sending', '>> Sending SMS to %_$0%_ /$1/',
+ 'sms_sent', '>> Message to %_$0%_ has been sent.',
+ 'sms_esent', '>> Message $1/$2 to %_$0%_ has been sent.',
+ 'sms_notsent', '>> Message to %_$0%_ has %_NOT%_ been sent.',
+ 'sms_enotsent', '>> Message $1/$2 to %_$0%_ has %_NOT%_ been sent.',
+ 'sms_stat', '>> Total of %_$0%_ entries: %_$1%_ from PLUS, %_$2%_ from ERA, %_$3%_ from IDEA.',
+ 'sms_listline', '[%W$[!-2]0%n]%| $[9]1%_:%_ $2 /$[-4]3/',
+]);
+
+# Chanelog:
+## version 1.5b
+# $ENV{HOME}/.irssi -> Irssi::get_irssi_dir
+## version 1.5
+# - added new prefixes
+## version 1.4
+# - sorting /smslist
+# - do not lowercasing handles
+## version 1.3
+# - fixed smsfork(), ifork()
+# - added help
+## version 1.2d
+# - ... more ERA() fixes
+## version 1.2c
+# - added parsing of 'request cannot be processed at this time' in IDEA()
+# - added [act/total] in ERA() split messages
+## version 1.2b
+# - more fixes in ERA() messages spliting
+## version 1.2
+# - fixed long message spliting in ERA()
+## version 1.1
+# - fixed IDEA()
+# - inf. ifork() loop fixed (found by Lam)
+# - fixed regex matching in /delsms, /listsms and /sms
+# - changed kill() to POSIX::_exit()
+## version 1.0
+# - forking before sending SMS
+
+my $smssender = getlogin || getpwuid($<) || "anonymous";
+my $smsfile = Irssi::get_irssi_dir . "/smslist";
+my (@smslist, $fh, %ftag);
+
+sub cmd_sms {
+ my ($target, $text) = split(/ +/, $_[0], 2);
+ my $window = Irssi::active_win();
+ my $phone;
+
+ if ($text eq "") {
+ Irssi::print("Usage: /SMS <handle or phone number> <text>");
+ return;
+ }
+
+ if (isnumber($target)) {
+ if ($phone = corrnum($target)) {
+ my $net = smsnet($phone);
+ $window->printformat(MSGLEVEL_CLIENTNOTICE, 'sms_sending', smsnum($phone), $net);
+ &$net($phone, $text) unless &smsfork;
+ } else {
+ Irssi::print("%R>>%n Wrong number.");
+ }
+ } else {
+ my $i = 0;
+ my $handle = lc($target);
+ my $all = $handle eq "*"? 1 : 0;
+ for my $sms (@smslist) {
+ next unless ($all || lc($sms->{handle}) eq $handle);
+ $i++;
+ my $net = smsnet($sms->{phone});
+ $window->printformat(MSGLEVEL_CLIENTNOTICE, 'sms_sending', $sms->{handle}, $net);
+ &$net($sms->{phone}, $text) unless &smsfork;
+ }
+ Irssi::print("%R>>%n Can't find %_$target%_ in address book.") unless $i;
+ }
+}
+
+sub cmd_addsms {
+ my ($handle, $num) = split(/ +/, $_[0], 2);
+ my $phone;
+
+ unless ($phone = corrnum($num)) {
+ Irssi::print("Usage: /ADDSMS <handle> <phone number>");
+ return;
+ }
+
+ for my $sms (@smslist) {
+ if (lc($sms->{handle}) eq lc($handle)) {
+ Irssi::print(">> Changing phone number for %_$handle%_ /to $phone/");
+ $sms->{phone} = $phone;
+ &savesms;
+ return;
+ }
+ }
+ my $sms = {};
+ $sms->{handle} = $handle;
+ $sms->{phone} = $phone;
+ Irssi::print(">> Adding %_$handle%_ with num %_$phone%_.");
+ push @smslist, $sms;
+ &savesms;
+}
+
+sub cmd_delsms {
+ my $handle = shift;
+
+ if ($handle eq "") {
+ Irssi::print("Usage: /DELSMS <handle or number from listsms>");
+ return;
+ }
+
+ my @num;
+ $handle = lc($handle);
+
+ if ($handle =~ /^[0-9]+$/) {
+ push @num, $handle - 1;
+ } else {
+ my $all = $handle eq "*"? 1 : 0;
+ @smslist = sort { lc($a->{handle}) cmp lc($b->{handle}) } @smslist;
+ for (my $i = 0; $i < @smslist; $i++) {
+ push @num, $i if ($all || lc($smslist[$i]->{handle}) eq $handle);
+ }
+ }
+ for my $n (reverse(@num)) {
+ if (my($sms) = splice(@smslist, $n, 1)) {
+ Irssi::print(">> Deleted %_$sms->{handle}%_.");
+ }
+ }
+
+ &savesms;
+}
+
+sub cmd_listsms {
+ my $match = shift || "*";
+ my $window = Irssi::active_win();
+
+ if (@smslist == 0) {
+ Irssi::print("%R>>%n Your SMSLIST is empty.");
+ return;
+ }
+ my $all = $match eq "*"? 1 : 0;
+ @smslist = sort { lc($a->{handle}) cmp lc($b->{handle}) } @smslist;
+ my $i = 1;
+ for my $sms (@smslist) {
+ next unless $all || $sms->{handle} =~ /\Q$match\E/i;
+ $window->printformat(MSGLEVEL_CLIENTNOTICE, 'sms_listline', $i++, $sms->{handle}, $sms->{phone}, smsnet($sms->{phone}));
+ }
+ &smsstat if $match eq "*";
+}
+
+sub smsstat {
+ my ($plus, $era, $idea) = (0, 0, 0);
+
+ for my $sms (@smslist) {
+ for ($sms->{phone}) {
+ /^6(0[1,3,5,7,9]|91)/ and $plus++;
+ /^6(0[0,2,4,6,8]|92)/ and $era++;
+ /^50/ and $idea++;
+ }
+ }
+ Irssi::active_win()->printformat(MSGLEVEL_CLIENTNOTICE, 'sms_stat', scalar(@smslist), $plus, $era, $idea);
+}
+
+sub savesms {
+ local *fp;
+ open (fp, ">", $smsfile) or die "Couldn't open $smsfile for writing";
+ for my $sms (@smslist) {
+ print(fp "$sms->{handle} $sms->{phone}\n");
+ }
+ close(fp);
+}
+
+sub loadsms {
+ @smslist = ();
+ return unless (-e $smsfile);
+ local *fp;
+ open(fp, "<", $smsfile);
+ local $/ = "\n";
+ while (<fp>) {
+ chop;
+ my $sms = {};
+ ($sms->{handle}, $sms->{phone}) = split(/ /);
+ push(@smslist, $sms);
+ }
+ close(fp);
+ Irssi::print("Loaded address book:");
+ &smsstat;
+}
+
+sub isnumber {
+ return ($_[0] =~ /^([+]|[0-9])[0-9]{6,}$/);
+}
+
+sub corrnum {
+ my $num = shift;
+
+ return 0 unless isnumber($num);
+
+ if ($num =~ /^\+/) {
+ return 0 unless $num =~ s/^(\+48)//g;
+ }
+ $num =~ s/^(48)//;
+
+ return $num;
+}
+
+sub smsnum {
+ my $num = shift;
+ for my $sms (@smslist) {
+ if ($sms->{phone} eq $num) {
+ return $sms->{handle}
+ }
+ }
+ return $num;
+}
+
+sub smsnet {
+ for (@_) {
+ /^6(0[13579]|9[135])/ and return "PLUS";
+ /^6(0[02468]|9[24])/ and return "ERA";
+ /^50/ and return "IDEA";
+ }
+ return "UNKNOWN";
+}
+
+sub urlencode {
+ my $ret = shift;
+ $ret =~ s/([^a-zA-Z0-9])/sprintf("%%%.2x", ord($1));/eg;
+ return $ret;
+}
+
+sub smsfork {
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ my $pid = fork();
+ unless (defined $pid) {
+ Irssi::print("%R>>%n Failed to fork() :/ - $!");
+ close $rh; close $wh;
+ return 1;
+ } elsif ($pid) { # parent
+ close $wh;
+ $ftag{$rh} = Irssi::input_add(fileno($rh), INPUT_READ, \&ifork, $rh);
+ Irssi::pidwait_add($pid);
+ } else { # child
+ close $rh;
+ $fh = $wh;
+ }
+ return $pid;
+}
+
+sub smskill {
+ print($fh "finished\n");
+ close $fh;
+ POSIX::_exit(1);
+}
+
+sub ifork {
+ my $rh= shift;
+ my $ret = 0;
+ while (<$rh>) {
+ /^sent (.+)/ and Irssi::active_win()->printformat(MSGLEVEL_CLIENTNOTICE, 'sms_sent', smsnum($1)), last;
+ /^esent ([0-9]+)\s([0-9]+)\s([0-9]+)$/ and Irssi::active_win()->printformat(MSGLEVEL_CLIENTNOTICE, 'sms_esent', smsnum($1), $2, $3), last;
+ /^notsent (.+)/ and Irssi::active_win()->printformat(MSGLEVEL_CLIENTNOTICE, 'sms_notsent', smsnum($1)), last;
+ /^enotsent ([0-9]+)\s([0-9]+)\s([0-9]+)$/ and Irssi::active_win()->printformat(MSGLEVEL_CLIENTNOTICE, 'sms_enotsent', smsnum($1), $2, $3), last;
+ /^info (.+)/ and Irssi::print("$1"), last;
+ /^finished$/ and $ret = 1, last;
+ }
+ return unless $ret;
+ Irssi::input_remove($ftag{$rh});
+ delete $ftag{$rh};
+ close $rh;
+}
+
+sub sconnect {
+ my $target = shift;
+ my ($proto, $iaddr, $saddr);
+
+ $proto = getprotobyname('tcp');
+ $iaddr = inet_aton($target);
+ socket(SOCK, PF_INET, SOCK_STREAM, $proto) || return 0;
+ local $SIG{ALRM} = sub {
+ print($fh "info %R>>%n connect() to $target timeouted :/\n");
+ close SOCK;
+ return 0;
+ };
+ alarm 10;
+ unless (connect(SOCK, sockaddr_in(80, $iaddr))) {
+ print($fh "info %R>>%n Couldn't connect to $target: $!\n");
+ close SOCK;
+ return 0;
+ }
+ alarm 0;
+ my $old = select(SOCK); $| = 1; select($old);
+ return 1;
+}
+
+sub PLUS {
+ my ($phone, $text) = @_;
+ &smskill unless sconnect("sms.plusgsm.pl");
+ my $tosend = "tprefix=" . substr($phone, 0, 3) . "&numer=" . substr($phone, 3) . "&odkogo=$smssender&tekst=" . urlencode($text) . "&dzien=dzisiaj&godz=&min=";
+ print SOCK "POST /sms/sendsms.php HTTP/1.0\n";
+ print SOCK "Host: www.text.plusgsm.pl:80\n";
+ print SOCK "Accept: */*\n";
+ print SOCK "Content-type: application/x-www-form-urlencoded\n";
+ print SOCK "Content-length: " . length($tosend) . "\n\n";
+ print SOCK "$tosend\r\n";
+ while (<SOCK>) {
+ /wiadomo¶æ zosta³a wys³ana/ and print($fh "sent $phone\n"), last;
+ /nie zosta³ wys³any/ and print($fh "notsent $phone\n"), last;
+ }
+ close SOCK;
+ &smskill;
+}
+
+sub ERA {
+ my ($phone, $cutme) = @_;
+ my $ml = 126 - length($smssender);
+ my $cl = length($cutme);
+ my $total = int($cl / $ml) + (($cl%$ml)? 1 : 0);
+ if ($total > 1) {
+ $ml -= (4 + length($total) * 2);
+ $total = int($cl / $ml) + (($cl%$ml)? 1 : 0);
+ printf($fh "info >> Spliting SMS to $total messages.\n");
+ }
+ my $act = 0;
+ while ($cutme =~ s/.{1,$ml}//) {
+ my ($cookie, $code, $tosend, $text);
+ &smskill unless sconnect("boa.eragsm.pl");
+ $act++;
+ $text = "<$act/$total> " if $total > 1;
+ $text .= $&;
+ print SOCK "POST /sms/sendsms.asp?sms=1 HTTP/1.0\n";
+ print SOCK "Host: boa.eragsm.com.pl:80\n";
+ print SOCK "Accept: */*\n\r\n";
+ while (<SOCK>) {
+ $cookie = $1 if /Set\-Cookie\:\ ([^\;]+?)\;/;
+ $code = $1 if /name\=\"Code\"\ value\=\"(.+?)\"/;
+ }
+ close SOCK;
+ $tosend = "numer=$phone&bookopen=&message=" . urlencode($text) . "&podpis=$smssender&kontakt=&Nadaj=Nadaj&code=$code&Kasuj=Kasuj&Telefony=Telefony";
+ &smskill unless sconnect("boa.eragsm.pl");
+ print SOCK "POST /sms/sendsms.asp HTTP/1.0\n";
+ print SOCK "Host: boa.eragsm.com.pl:80\n";
+ print SOCK "Accept: */*\n";
+ print SOCK "Cookie: $cookie\n";
+ print SOCK "Referer: http://boa.eragsm.com.pl/sms/sendsms.asp\n";
+ print SOCK "Content-type: application/x-www-form-urlencoded\n";
+ print SOCK "Content-length: " . length($tosend) . "\n\n";
+ print SOCK "$tosend\r\n";
+ if ($total > 1) {
+ while (<SOCK>) {
+ /nie zosta³a wys³ana!/ and print($fh "enotsent $phone $act $total\n"), last;
+ /zosta³a wys³ana/ and print($fh "esent $phone $act $total\n"), last;
+ }
+ } else {
+ while (<SOCK>) {
+ /nie zosta³a wys³ana!/ and print($fh "notsent $phone\n"), last;
+ /zosta³a wys³ana/ and print($fh "sent $phone\n"), last;
+ }
+ }
+ close SOCK;
+ }
+ &smskill;
+}
+
+sub IDEA {
+ my ($phone, $text) = @_;
+ my ($sec, $min, $hour, $day, $mon, $year) = (localtime)[0,1,2,3,4,5];
+ $year += 1900;
+ $mon += 1;
+ &smskill unless sconnect("sms.idea.pl");
+ my $tosend = "LANGUAGE=pl&NETWORK=smsc1&DELIVERY_TIME=0&SENDER=$smssender&RECIPIENT=$phone&VALIDITY_PERIOD=24&DELIVERY_DATE=$day&DELIVERY_MONTH=$mon&DELIVERY_YEAR=$year&DELIVERY_HOUR=$hour&DELIVERY_MIN=$min&NOTIFICATION_FLAG=false&NOTIFICATION_ADDRESS=&SHORT_MESSAGE=" . urlencode($text) . "&SUBMIT=Wyslij";
+ print SOCK "POST /sendsms.asp HTTP/1.0\n";
+ print SOCK "Host: sms.idea.pl:80\n";
+ print SOCK "Accept: */*\n";
+ print SOCK "Content-type: application/x-www-form-urlencoded\n";
+ print SOCK "Content-length: " . length($tosend) . "\n\n";
+ print SOCK "$tosend\r\n";
+ while (<SOCK>) {
+ /SMS nie zostanie/ and print($fh "notsent $phone\n"), last;
+ /doby zosta³ wyczerpany/ and print($fh "notsent $phone\n"), last;
+ /zosta³a wys³ana/ and print($fh "sent $phone\n"), last;
+ /request cannot be processed/ and print($fh "notsent $phone\n"), last;
+ }
+ close SOCK;
+ &smskill;
+}
+
+sub UNKNOWN {
+ print($fh "info %R>>%n Sorry, sms.pl supports only polish operators :/\n");
+ &smskill;
+}
+
+&loadsms;
+
+Irssi::command_bind("sms", "cmd_sms");
+Irssi::command_bind("addsms", "cmd_addsms");
+Irssi::command_bind("smsadd", "cmd_addsms");
+Irssi::command_bind("smsdel", "cmd_delsms");
+Irssi::command_bind("delsms", "cmd_delsms");
+Irssi::command_bind("listsms", "cmd_listsms");
+Irssi::command_bind("smslist", "cmd_listsms");
+Irssi::command_bind("smsstat", "smsstat");
diff --git a/scripts/snmpup.pl b/scripts/snmpup.pl
new file mode 100644
index 0000000..7a37950
--- /dev/null
+++ b/scripts/snmpup.pl
@@ -0,0 +1,101 @@
+use strict;
+use Net::SNMP;
+use vars qw($VERSION %IRSSI);
+
+# Changes:
+# Apr 6:
+# - Added debug option
+# - Checks for remote OS type.. Windows' snmpd is somewhat different
+# - Included load averages
+# - Multiple hosts support
+# Mar 13:
+# - Typofixes
+
+$VERSION = "2.00";
+%IRSSI = (
+ authors => "Rick (strlen) Jansen",
+ contact => "strlen\@shellz.nl",
+ name => "snmpup",
+ description => "This script queries remote hosts (/snmpup <host1> <host2> <hostN>) running snmpd for it's uptime and cpu usage",
+ license => "GPL/2",
+ changed => "Sun Apr 6 17:57:28 CET 2002"
+);
+
+use Irssi;
+sub snmpup {
+ my ($input, $server, $data) = @_;
+
+ # Assume $input are hostnames if no debug flag is given
+ my (@hostnames, $debug, @mibs, $hostname);
+
+ if ($input !~ /^\-d/) {
+ @hostnames = split(" ",$input);
+ $debug = 0;
+ } else {
+ $input =~ s/^\-d //;
+ @hostnames = split(" ",$input);
+ $debug = 1;
+ }
+ if (!@hostnames) { Irssi::print("snmpup: invalid syntax: $input"); return }
+
+ my $hostUpTime = '1.3.6.1.2.1.25.1.1.0';
+ my $sysSystem = '1.3.6.1.2.1.1.1.0';
+ my $sysUpTime = '1.3.6.1.2.1.1.3.0';
+ my $hrLoad = '1.3.6.1.2.1.25.3.3.1.2.1';
+ my $laLoadInt1 = '1.3.6.1.4.1.2021.10.1.5.1';
+ my $laLoadInt5 = '1.3.6.1.4.1.2021.10.1.5.2';
+ my $laLoadInt15 = '1.3.6.1.4.1.2021.10.1.5.3';
+
+ foreach $hostname (@hostnames) {
+ my ($session, $error) = Net::SNMP->session(
+ -hostname => $hostname,
+ -community => 'public',
+ -port => '161',
+ );
+ if (!defined($session)) {
+ $server->command("/msg ".$data->{name}." Unable to create SNMP connection: $error");
+ return;
+ } elsif ($debug) {
+ Irssi::print("Net::SNMP session created.");
+ }
+
+ my $a = $session->get_request(-varbindlist=>[$sysSystem]);
+
+ my $system = $a->{$sysSystem};
+
+ if ($debug) {
+ Irssi::print("Remote system type is $system");
+ }
+
+ if ($system =~ /Windows/) {
+ @mibs = [$sysUpTime,$hrLoad];
+ } else {
+ @mibs = [$hostUpTime,$laLoadInt1,$laLoadInt5,$laLoadInt15];
+ }
+
+ my $result = $session->get_request(-varbindlist=>@mibs);
+
+ if (!defined($result)) {
+ my $err = $session->error;
+ $server->command("/msg ".$data->{name}." SNMP get error: $err");
+ $session->close();
+ } else {
+ my $host = $session->hostname;
+ my ($uptime, $load);
+ if ($system =~ /Windows/) {
+ $uptime = $result->{$sysUpTime};
+ $load = sprintf("CPU Usage: %d%",$result->{$hrLoad});
+ } else {
+ $uptime = $result->{$hostUpTime};
+ $load = sprintf("load averages: %.2f, %.2f, %.2f",
+ $result->{$laLoadInt1} / 100,
+ $result->{$laLoadInt5} / 100,
+ $result->{$laLoadInt15} / 100);
+ }
+ $server->command("/msg ".$data->{name}." SNMP uptime for host '$host' is $uptime, $load");
+ $session->close();
+ }
+ $session->close();
+ }
+}
+Irssi::command_bind("snmpup","snmpup");
diff --git a/scripts/spambot.pl b/scripts/spambot.pl
new file mode 100644
index 0000000..e466a1c
--- /dev/null
+++ b/scripts/spambot.pl
@@ -0,0 +1,80 @@
+# This script was originally written by Mike McDonald of
+# FoxChat.Net for the X-Chat Client to be used by Opers
+# to Kline/kill spam bots that message you or say in
+# open channel -
+# "Come watch me on my webcam and chat /w me :-) http://some.domain.com/me.mpg".
+#
+# This is my first script so I'm sure there is a more
+# efficient way of doing this.
+#
+# --------[ Note ]-------------------------------------------------------------
+# I symlink this to my ~/.irssi/scripts/autorun
+# Just know that it will not work if you are not op'd.
+#
+#------------------------------------------------------------------------------
+
+use Irssi;
+use strict;
+use vars qw($VERSION %IRSSI $SCRIPT_NAME);
+
+%IRSSI = (
+ authors => 'Daemon @ ircd.foxchat.net',
+ name => 'Spam Bot Killer',
+ description => 'Oper script to kill Spam Bots.',
+ license => 'Public Domain'
+);
+($VERSION) = '$Revision: 1.2 $' =~ / (\d+\.\d+) /;
+
+$SCRIPT_NAME = 'Spam Bot Killer';
+
+# ======[ Credits ]============================================================
+#
+# Thanks to:
+#
+# Mike - For letting me use parts of his bot_killer.pl which was written for
+# the X-Chat client.
+#
+# Garion - Let me use parts of his "ho_easykline" to make this work with
+# Irssi and gave me -
+# return unless $server->{server_operator};
+# so the script won't try to run if you aren't oper'd.
+#
+# mannix and lestefer of ircd.foxchat.net for letting me kline them :)
+#
+#------------------------------------------------------------------------------
+ sub event_privmsg
+ {
+ # $data = "nick/#channel :text"
+ my ($server, $data, $nick, $host, $user, $address) = @_;
+
+
+ # Set Temp K-Line time here in minutes.
+ my $klinetime = 1440;
+ my $msg = "Spamming is lame ... go spam somewhere else.";
+ my ($target, $text) = split(/ :/, $data, 2);
+
+ if ($text =~ /chat \/w me/ || / \/me.mpg/)
+ {
+# --------[ Notice ]-----------------------------------------------------------
+ # Uncomment this line if you don't want to use temp klines
+ # and comment the following line.
+
+ # $server->command("quote kline $host :$msg");
+
+ $server->command("quote kline $klinetime $host :$msg");
+
+#------------------------------------------------------------------------------
+
+ Irssi::print("K-lined $nick :$msg");
+
+ # Do a Kill in case they are on another server
+ # and the local Kline doesn't get them.
+
+ $server->command("quote kill $nick :$msg");
+ }
+ }
+
+Irssi::signal_add("event privmsg", "event_privmsg");
+
+Irssi::print("\00311:: Spam Bot Killer loaded ::\003\n");
+Irssi::print("\00311::You can only use this script if you are Oper. ::\003\n");
diff --git a/scripts/special_complete.pl b/scripts/special_complete.pl
new file mode 100644
index 0000000..d8f0672
--- /dev/null
+++ b/scripts/special_complete.pl
@@ -0,0 +1,30 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi;
+$VERSION = '1.1';
+%IRSSI = (
+ authors => 'Wouter Coekaerts',
+ contact => 'wouter@coekaerts.be, coekie@#irssi',
+ name => 'special_complete',
+ description => '(tab)complete irssi special variables (words that start with $) by evaluating them',
+ license => 'GPLv2',
+ url => 'http://wouter.coekaerts.be/irssi/',
+ changed => '28/07/03',
+);
+
+Irssi::signal_add_last 'complete word', sub {
+ my ($complist, $window, $word, $linestart, $want_space) = @_;
+ if ($word =~ /^\$/){
+ my $evaluated;
+ if (Irssi::active_win->{'active'}) {
+ $evaluated = Irssi::active_win->{'active'}->parse_special($word);
+ } elsif (Irssi::active_win->{'active_server'}) {
+ $evaluated = Irssi::active_win->{'active_server'}->parse_special($word);
+ } else {
+ $evaluated = Irssi::parse_special($word);
+ }
+ if ($evaluated ne '') {
+ push @$complist, $evaluated;
+ }
+ }
+};
diff --git a/scripts/spellcheck.pl b/scripts/spellcheck.pl
new file mode 100644
index 0000000..3fc6861
--- /dev/null
+++ b/scripts/spellcheck.pl
@@ -0,0 +1,301 @@
+# Copyright © 2008 Jakub Jankowski <shasta@toxcorp.com>
+# Copyright © 2012-2020 Jakub Wilk <jwilk@jwilk.net>
+# Copyright © 2012 Gabriel Pettier <gabriel.pettier@gmail.com>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 dated June, 1991.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+
+use strict;
+use warnings;
+
+use vars qw($VERSION %IRSSI);
+use Irssi 20070804;
+use Irssi::TextUI;
+use Encode;
+use Text::Aspell;
+
+$VERSION = '0.9.1';
+%IRSSI = (
+ authors => 'Jakub Wilk, Jakub Jankowski, Gabriel Pettier, Nei',
+ name => 'spellcheck',
+ description => 'checks for spelling errors using Aspell',
+ license => 'GPLv2',
+ url => 'http://jwilk.net/software/irssi-spellcheck',
+);
+
+my %speller;
+
+sub spellcheck_setup
+{
+ my ($lang) = @_;
+ my $speller = $speller{$lang};
+ return $speller if defined $speller;
+ $speller = Text::Aspell->new or return;
+ $speller->set_option('lang', $lang) or return;
+ $speller->set_option('sug-mode', 'fast') or return;
+ $speller{$lang} = $speller;
+ return $speller;
+}
+
+# add_rest means "add (whatever you chopped from the word before
+# spell-checking it) to the suggestions returned"
+sub spellcheck_check_word
+{
+ my ($langs, $word, $add_rest) = @_;
+ my $win = Irssi::active_win();
+ my $prefix = '';
+ my $suffix = '';
+
+ my @langs = split(/[+]/, $langs);
+ for my $lang (@langs) {
+ my $speller = spellcheck_setup($lang);
+ if (not defined $speller) {
+ $win->print('%R' . "Error while setting up spell-checker for $lang" . '%N', MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ }
+
+ return if $word =~ m{^/}; # looks like a path
+ $word =~ s/^([[:punct:]]*)//; # strip leading punctuation characters
+ $prefix = $1 if $add_rest;
+ $word =~ s/([[:punct:]]*)$//; # ...and trailing ones, too
+ $suffix = $1 if $add_rest;
+ return if $word =~ m{^\w+://}; # looks like a URL
+ return if $word =~ m{^[^@]+@[^@]+$}; # looks like an e-mail
+ return if $word =~ m{^[[:digit:][:punct:]]+$}; # looks like a number
+
+ my @result;
+ for my $lang (@langs) {
+ my $ok = $speller{$lang}->check($word);
+ if (not defined $ok) {
+ $win->print('%R' . "Error while spell-checking for $lang" . '%N', MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ if ($ok) {
+ return;
+ } else {
+ push @result, map { "$prefix$_$suffix" } $speller{$lang}->suggest($word);
+ }
+ }
+ return \@result;
+}
+
+sub _spellcheck_find_language
+{
+ my ($network, $target) = @_;
+ return Irssi::settings_get_str('spellcheck_default_language') unless (defined $network && defined $target);
+
+ # support !channels correctly
+ $target = '!' . substr($target, 6) if ($target =~ /^\!/);
+
+ # lowercase net/chan
+ $network = lc($network);
+ $target = lc($target);
+
+ # possible settings: network/channel/lang or channel/lang
+ my @languages = split(/[ ,]+/, Irssi::settings_get_str('spellcheck_languages'));
+ for my $langstr (@languages) {
+ my ($t, $c, $l) = $langstr =~ m{^(?:([^/]+)/)?([^/]+)/([^/]+)/*$};
+ $t //= $network;
+ if (lc($c) eq $target and lc($t) eq $network) {
+ return $l;
+ }
+ }
+
+ # no match, use defaults
+ return Irssi::settings_get_str('spellcheck_default_language');
+}
+
+sub spellcheck_find_language
+{
+ my ($win) = @_;
+ return _spellcheck_find_language(
+ $win->{active_server}->{tag},
+ $win->{active}->{name}
+ );
+}
+
+sub spellcheck_key_pressed
+{
+ my ($key) = @_;
+ my $win = Irssi::active_win();
+
+ my $correction_window;
+ my $window_height;
+
+ my $window_name = Irssi::settings_get_str('spellcheck_window_name');
+ if ($window_name ne '') {
+ $correction_window = Irssi::window_find_name($window_name);
+ $window_height = Irssi::settings_get_str('spellcheck_window_height');
+ }
+
+ return unless Irssi::settings_get_bool('spellcheck_enabled');
+
+ # hide correction window when message is sent
+ if (chr($key) =~ /\A[\r\n]\z/ && $correction_window) {
+ $correction_window->command("^window hide $window_name");
+ if (Irssi->can('gui_input_clear_extents')) {
+ Irssi::gui_input_clear_extents(0, 9999);
+ }
+ }
+
+ # get current inputline
+ my $inputline = Irssi::parse_special('$L');
+ my $utf8 = lc Irssi::settings_get_str('term_charset') eq 'utf-8';
+ if ($utf8) {
+ Encode::_utf8_on($inputline);
+ }
+
+ # ensure that newly added characters are not colored
+ # when correcting a colored word
+ # FIXME: this works at EOL, but not elsewhere
+ if (Irssi->can('gui_input_set_extent')) {
+ Irssi::gui_input_set_extent(length $inputline, '%n');
+ }
+
+ # don't bother unless pressed key is space
+ # or a terminal punctuation mark
+ return unless grep { chr $key eq $_ } (' ', qw(. ? !));
+
+ $inputline = substr $inputline, 0, Irssi::gui_input_get_pos();
+
+ # check if inputline starts with any of cmdchars
+ # we shouldn't spell-check commands
+ # (except /SAY and /ME)
+ my $cmdchars = Irssi::settings_get_str('cmdchars');
+ my $re = qr{^(?:
+ [\Q$cmdchars\E] (?i: say | me ) \s* \S |
+ [^\Q$cmdchars\E]
+ )}x;
+ return if ($inputline !~ $re);
+
+ # get last bit from the inputline
+ my ($word) = $inputline =~ /\s*(\S+)\s*$/;
+ defined $word or return;
+
+ # remove color from the last word
+ # (we will add it back later if needed)
+ my $start = $-[1];
+ if (Irssi->can('gui_input_clear_extents')) {
+ Irssi::gui_input_clear_extents($start, length $word);
+ }
+
+ my $lang = spellcheck_find_language($win);
+
+ return if $lang eq 'und';
+
+ my $suggestions = spellcheck_check_word($lang, $word, 0);
+
+ return unless defined $suggestions;
+
+ # strip leading and trailing punctuation
+ $word =~ s/^([[:punct:]]+)// and $start += length $1;
+ $word =~ s/[[:punct:]]+$//;
+
+ # add color to the misspelled word
+ my $color = Irssi::settings_get_str('spellcheck_word_input_color');
+ if ($color && Irssi->can('gui_input_set_extents')) {
+ Irssi::gui_input_set_extents($start, length $word, $color, '%n');
+ }
+
+ return unless Irssi::settings_get_bool('spellcheck_print_suggestions');
+
+ # show corrections window if hidden
+ if ($correction_window) {
+ $win->command("^window show $window_name");
+ $correction_window->command('^window stick off');
+ $win->set_active;
+ $correction_window->command("window size $window_height");
+ } else {
+ $correction_window = $win;
+ }
+
+ # we found a mistake, print suggestions
+
+ $word =~ s/%/%%/g;
+ $color = Irssi::settings_get_str('spellcheck_word_color');
+ if (scalar @$suggestions > 0) {
+ if ($utf8) {
+ Encode::_utf8_on($_) for @$suggestions;
+ }
+ $correction_window->print("Suggestions for $color$word%N - " . join(', ', @$suggestions));
+ } else {
+ $correction_window->print("No suggestions for $color$word%N");
+ }
+
+ return;
+}
+
+sub spellcheck_complete_word
+{
+ my ($complist, $win, $word, $lstart, $wantspace) = @_;
+
+ return unless Irssi::settings_get_bool('spellcheck_enabled');
+
+ my $lang = spellcheck_find_language($win);
+
+ return if $lang eq 'und';
+
+ # add suggestions to the completion list
+ my $suggestions = spellcheck_check_word($lang, $word, 1);
+ push(@$complist, @$suggestions) if defined $suggestions;
+
+ return;
+}
+
+sub spellcheck_add_word
+{
+ my ($cmd_line, $server, $win_item) = @_;
+ my $win = Irssi::active_win();
+ my @args = split(' ', $cmd_line);
+
+ if (@args <= 0) {
+ $win->print('SPELLCHECK_ADD <word>... add word(s) to personal dictionary');
+ return;
+ }
+
+ my $lang = spellcheck_find_language($win);
+
+ my $speller = spellcheck_setup($lang);
+ if (not defined $speller) {
+ $win->print('%R' . "Error while setting up spell-checker for $lang" . '%N', MSGLEVEL_CLIENTERROR);
+ return;
+ }
+
+ $win->print("Adding to $lang dictionary: @args");
+ for my $word (@args) {
+ $speller{$lang}->add_to_personal($word);
+ }
+ my $ok = $speller{$lang}->save_all_word_lists();
+ if (not $ok) {
+ $win->print('%R' . "Error while saving $lang dictionary" . '%N', MSGLEVEL_CLIENTERROR);
+ }
+
+ return;
+}
+
+Irssi::command_bind('spellcheck_add', 'spellcheck_add_word');
+
+Irssi::settings_add_bool('spellcheck', 'spellcheck_enabled', 1);
+Irssi::settings_add_bool('spellcheck', 'spellcheck_print_suggestions', 1);
+Irssi::settings_add_str( 'spellcheck', 'spellcheck_default_language', 'en_US');
+Irssi::settings_add_str( 'spellcheck', 'spellcheck_languages', '');
+Irssi::settings_add_str( 'spellcheck', 'spellcheck_word_color', '%R');
+Irssi::settings_add_str( 'spellcheck', 'spellcheck_word_input_color', '%U');
+Irssi::settings_add_str( 'spellcheck', 'spellcheck_window_name', '');
+Irssi::settings_add_str( 'spellcheck', 'spellcheck_window_height', 10);
+
+Irssi::signal_add_last('key word_completion', sub{spellcheck_key_pressed(ord '.')});
+Irssi::signal_add_last('key word_completion_backward', sub{spellcheck_key_pressed(ord '.')});
+Irssi::signal_add_last('gui key pressed', 'spellcheck_key_pressed');
+Irssi::signal_add_last('complete word', 'spellcheck_complete_word');
+
+1;
+
+# vim:ts=4 sts=4 sw=4 et
diff --git a/scripts/sping.pl b/scripts/sping.pl
new file mode 100644
index 0000000..4842454
--- /dev/null
+++ b/scripts/sping.pl
@@ -0,0 +1,41 @@
+use Irssi;
+use Irssi::Irc;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.0";
+%IRSSI = (
+ authors => "Maciek \'fahren\' Freudenheim, David Leadbeater",
+ contact => "fahren\@bochnia.pl",
+ name => "Server Ping",
+ description => "/SPING [server] - checks latency between current server and [server]",
+ license => "GNU GPLv2 or later",
+ changed => "Sun 15 Jun 18:56:52 BST 2014",
+);
+
+# us. /SPING [server]
+
+use Time::HiRes qw(gettimeofday);
+
+my %askping;
+
+sub cmd_sping {
+ my ($target, $server, $winit) = @_;
+
+ $target = $server->{address} unless $target;
+ $askping{$target} = gettimeofday();
+ # using nickname rather than server seems to work better here
+ $server->send_raw("PING $server->{nick} $target");
+}
+
+sub event_pong {
+ my ($server, $args, $sname) = @_;
+ return unless exists $askping{$sname};
+
+ Irssi::signal_stop();
+ Irssi::print(">> $sname latency: " . sprintf("%0.3f",gettimeofday() - $askping{$sname}) . "s");
+ delete $askping{$sname};
+}
+
+Irssi::signal_add("event pong", "event_pong");
+Irssi::command_bind("sping", "cmd_sping");
diff --git a/scripts/stocks.pl b/scripts/stocks.pl
new file mode 100644
index 0000000..2bd2ec9
--- /dev/null
+++ b/scripts/stocks.pl
@@ -0,0 +1,431 @@
+#!/usr/bin/env perl
+
+use strict;
+use LWP::Simple;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+use HTML::Entities;
+
+$VERSION = '0.9';
+%IRSSI = (
+ authors => 'Marcus \'darix\' Rückert, tira, Stefan \'tommie\' Tomanek',
+ contact => 'darix@irssi.de, tira@isx.de, stefan@pico.ruhr.de',
+ name => 'stocks',
+ description => 'prints the stats for german stocks',
+ license => 'Public Domain',
+ url => 'http://irssi.org/scripts/',
+ sbitems => 'stocks_ticker'
+);
+
+my %stocklist = (
+ DE => 'FSE+DTB+MUN+HAM+HAN+BRE+STU+BER+ETR+DUS+FFM+FFI+FFK+FFC+DFK+FFT',
+ EU =>
+'LIF+LCE+MSE+MAT+LME+NLK+ZRH+SFF+EOE+ROT+MEE+MIF+BBA+PSE+ASX+BSE+MSX+HSE+MIX+ISE+WSE+KSX+SSE+OSX+ENM+POP+BAS+BRN+MOP+SQ2+LTO+PAB+ISS+SQ1+ATH+LIS+LUX',
+ OTHERS =>
+'FX1+IPE+CSC+FNX+TSE+PAR+TYO+OPR+IMM+FFX+IOM+SMX+HFE+TOR+TIF+OSE+MRF+MRV+TFE+TOC+BIS+TGE+CSH+ICP+NXC+IMC+CBC+HOX+OPA+CBQ+SON+MAS+RDW+BHL+AUS+SSW+ALB+COC+TOE+VSE+CBF+NAT+MBF+TWI+TGT',
+ US =>
+'NYS+IND+NAS+CBT+CME+KBT+WPG+NYC+NYM+CMX+NYF+SFE+MIN+ASE+MAC+CEC+FOX+FRE+DOA+BOE+NAP',
+ ASE => 'ASE',
+ ASX => 'ASX',
+ ATH => 'ATH',
+ BER => 'BER',
+ BRE => 'BRE',
+ BSE => 'BSE',
+ C05 => 'C05',
+ CBT => 'CBT',
+ CME => 'CME',
+ DFK => 'DFK',
+ DTB => 'DTB',
+ DUS => 'DUS',
+ ENM => 'ENM',
+ ETR => 'ETR',
+ FFC => 'FFC',
+ FFI => 'FFI',
+ FFM => 'FFM',
+ FFT => 'FFT',
+ FSE => 'FSE',
+ FX1 => 'FX1',
+ HAM => 'HAM',
+ HAN => 'HAN',
+ IND => 'IND',
+ ISE => 'ISE',
+ ISS => 'ISS',
+ MIX => 'MIX',
+ MUN => 'MUN',
+ NAP => 'NAP',
+ NAS => 'NAS',
+ NYS => 'NYS',
+ PAR => 'PAR',
+ PSE => 'PSE',
+ SFF => 'SFF',
+ SON => 'SON',
+ SQ1 => 'SQ1',
+ SQ2 => 'SQ2',
+ SSE => 'SSE',
+ STU => 'STU',
+ TGT => 'TGT',
+ TWI => 'TWI',
+ WSE => 'WSE',
+ ZRH => 'ZRH'
+);
+
+my %stockhelp = (
+ DE =>
+'Deutschland (FSE DTB MUN HAM HAN BRE STU BER ETR DUS FFM FFI FFK FFC DFK FFT)',
+ EU =>
+'Europa (LIF LCE MSE MAT LME NLK ZRH SFF EOE ROT MEE MIF BBA PSE ASX BSE MSX HSE MIX ISE WSE KSX SSE OSX ENM POP BAS BRN MOP SQ2 LTO PAB ISS SQ1 ATH LIS LUX)',
+ OTHERS =>
+'Andere (FX1 IPE CSC FNX TSE PAR TYO OPR IMM FFX IOM SMX HFE TOR TIF OSE MRF MRV TFE TOC BIS TGE CSH ICP NXC IMC CBC HOX OPA CBQ SON MAS RDW BHL AUS SSW ALB COC TOE VSE CBF NAT MBF TWI TGT)',
+ US =>
+'USA (NYS IND NAS CBT CME KBT WPG NYC NYM CMX NYF SFE MIN ASE MAC CEC FOX FRE DOA BOE NAP)',
+ ASE => 'AMEX',
+ ASX => 'Amsterdam',
+ ATH => 'Athen',
+ BER => 'Berlin',
+ BRE => 'Bremen',
+ BSE => 'Brüssel',
+ C05 => 'LiveTrading',
+ CBT => 'CBoT',
+ CME => 'CME',
+ DFK => 'Fonds DE',
+ DTB => 'EUREX',
+ DUS => 'Düsseldorf',
+ ENM => 'EURO.NM',
+ ETR => 'XETRA',
+ FFC => 'Frankfurt',
+ FFI => 'FFM Indizes 2',
+ FFM => 'FFM Indizes 1',
+ FFT => 'Frankfurt STOXX',
+ FSE => 'Frankfurt',
+ FX1 => 'FOREX',
+ HAM => 'Hamburg',
+ HAN => 'Hannover',
+ IND => 'USA Indizes',
+ ISE => 'London',
+ ISS => 'London Inl.',
+ MIX => 'Mailand',
+ MUN => 'München',
+ NAP => 'Nasdaq OTC',
+ NAS => 'Nasdaq',
+ NYS => 'NYSE',
+ PAR => 'Int. Indizes',
+ PSE => 'Paris',
+ SFF => 'SOFFEX',
+ SON => 'Sonderwerte',
+ SQ1 => 'London Auslandsak.',
+ SQ2 => 'London Auslandsak.',
+ SSE => 'Stockholm',
+ STU => 'Stuttgart',
+ TGT => 'TD GT',
+ TWI => 'TD Indizes',
+ WSE => 'Wien',
+ ZRH => 'Zürich'
+);
+
+my %WPArt = (
+ STK => 'Aktie',
+ BND => 'Anleihe',
+ FND => 'Fonds',
+ FUT => 'Future',
+ IND => 'Index',
+ OPT => 'Option',
+ WNT => 'Optionsschein',
+ OTC => 'Over The Counter',
+ MSC => 'Sonstige',
+ SPC => 'Sonderwert',
+ CUR => 'Währung',
+ RTE => 'Zinssatz'
+);
+
+# search
+# -boerse {eu|de|us|others|}
+
+sub cmd_kurs {
+ my $XsearchWPArt = 'UKN';
+ my $XsearchBoersen = 'UKN';
+ my $params = shift ();
+
+ if ( $params =~ m/-help/ ) {
+ if ( $params =~ m/stocks/ ) {
+ Irssi::print( "\cBhelp for stocks\cB", MSGLEVEL_CRAP );
+ foreach my $key ( sort keys %stockhelp ) {
+ Irssi::print( "$key - $stockhelp{$key}", MSGLEVEL_CRAP );
+ }
+ }
+ else {
+ if ( $params =~ m/bonds/ ) {
+ Irssi::print( "\cBhelp for kind of bonds\cB", MSGLEVEL_CRAP );
+ foreach my $key ( sort keys %WPArt ) {
+ Irssi::print( "$key - $WPArt{$key}", MSGLEVEL_CRAP );
+ }
+ }
+ else {
+ Irssi::print(
+"\cBSTOCKS\cB [-stocks <stocklist>] [-bonds <wplist>] <querysting>",
+ MSGLEVEL_CRAP
+ );
+ Irssi::print( "", MSGLEVEL_CRAP );
+ Irssi::print( "\cBSee also:\cB", MSGLEVEL_CRAP );
+ Irssi::print( " STOCKS -help stocks", MSGLEVEL_CRAP );
+ Irssi::print( " STOCKS -help bonds", MSGLEVEL_CRAP );
+ }
+ }
+ return;
+ }
+
+ while ( $params =~ m/-(\S+) (\S+)/ ) {
+
+ # Irssi::print($2." ".$3, MSGLEVEL_CRAP);
+ my $vars = $2;
+ my $option = $1;
+ if ( $option eq "stocks" ) {
+ my @stocks = split ( ',', $vars );
+ for my $stock (@stocks) {
+ if ( exists $stocklist{$stock} ) {
+ $stock = $stocklist{$stock};
+ }
+ else {
+ Irssi::print( "stock $stock does not exists see /STOCKS -help stocks",
+ MSGLEVEL_CRAP );
+ return;
+ }
+ }
+ $XsearchBoersen = join ( "+", @stocks );
+ }
+ else {
+ if ( $option eq "bonds" ) {
+ my @wps = split ( ',', $vars );
+ for my $wp (@wps) {
+ if ( !exists $WPArt{$wp} ) {
+ Irssi::print( "Kind of bond $wp does not exists see /STOCKS -help bonds",
+ MSGLEVEL_CRAP );
+ return;
+ }
+ }
+ $XsearchWPArt = join ( "+", @wps );
+ }
+ else {
+ Irssi::print( "unknown option $option see /STOCKS -help", MSGLEVEL_CRAP );
+ return;
+ }
+ }
+ $params =~ s/-(\S+) (\S+)//;
+ }
+ $params =~ s/\^s+//;
+
+ # Irssi::print($XsearchBoersen, MSGLEVEL_CRAP);
+ # Irssi::print($XsearchWPArt, MSGLEVEL_CRAP);
+ # Irssi::print($params, MSGLEVEL_CRAP);
+ if ( $params eq "" ) {
+ Irssi::print( "empty query string see /STOCKS -help", MSGLEVEL_CRAP );
+ return;
+ }
+ my $searchfor = $params;
+ $searchfor =~ s/ /\%20/g;
+ my $host = "http://informer2.comdirect.de";
+ my $path = '/de/suche/main.html?';
+ my $searchButton = 'Exakt';
+ my $querystring =
+"&searchButton=$searchButton&XsearchWPArt=$XsearchWPArt&XsearchBoersen=$XsearchBoersen&searchfor=$searchfor";
+
+ my $content = get( $host . $path . $querystring );
+
+ my ( $oldcompany, $comp, $nbr, $boerse ) = "";
+
+ $searchfor =~ s/\%20/ /g;
+
+ if ( $content =~ m/Suchbegriff/s ) {
+ if ( $content =~ m/Kurszeit/ ) {
+ Irssi::print( "\cB" . $searchfor . " found:\cB", MSGLEVEL_CRAP );
+ $content =~ s/\&nbsp//g;
+ $content =~ m/Kurszeit.*?<\/tr>(.*?)<\/table>/s;
+ $content = $1;
+ while ( $content =~
+m/<td.*?>(.*?)<\/td>.*?<td.*?>(.*?)<\/td>.*?<td.*?>(.*?)<\/td>.*?<td.*?>(.*?)<\/td>.*?/s
+ )
+ {
+ $comp = $1;
+ $nbr = $3;
+ $boerse = $2;
+ decode_entities($comp);
+ decode_entities($nbr);
+ decode_entities($boerse);
+ if ($comp) {
+ Irssi::print( " " . $nbr . " " . $boerse . ": " . $comp,
+ MSGLEVEL_CRAP );
+ $oldcompany = $comp;
+ }
+ else {
+ Irssi::print(
+ " " . $nbr . " " . $boerse . ": " . $oldcompany,
+ MSGLEVEL_CRAP );
+ }
+ $content =~ m/<tr.*?>.*?<\/tr>(.*)/s;
+ $content = $1;
+ }
+ }
+ else {
+ Irssi::print( "\cBcould not find:\cB $searchfor", MSGLEVEL_CRAP );
+ }
+ return;
+ }
+
+ if ( $content =~
+m/<th width="99%" class="news">(.*?)<\/th>.*?<td.*?>WKN.*?class="sym">(\d+)/s
+ )
+ {
+ Irssi::print( "\c_WKN " . $2 . " - " . $1 . "\c_", MSGLEVEL_CRAP );
+ }
+
+ if ( $content =~ m/<td.*?>(Aktueller Kurs)<\/td>\s+<td>(.*?)<\/td>/s ) {
+ Irssi::print( " \cB" . $1 . ":\cB " . $2, MSGLEVEL_CRAP );
+ }
+
+ if ( $content =~ m/<td.*?>R&uuml;cknahmepreis<\/td>\s+<td>(.*?)<\/td>/s ) {
+ Irssi::print( " \cBRücknahmepreis:\cB " . $1, MSGLEVEL_CRAP );
+ }
+
+ if ( $content =~ m/<td.*?>(Ausgabepreis)<\/td>\s+<td>(.*?)<\/td>/s ) {
+ Irssi::print( " \cB" . $1 . ":\cB " . $2, MSGLEVEL_CRAP );
+ }
+
+ if ( $content =~ m/<td.*?>(Differenz)<\/td>\s+<td>(.*?)<\/td>/s ) {
+ Irssi::print( " \cB" . $1 . ":\cB " . $2, MSGLEVEL_CRAP );
+ }
+}
+
+
+# added by Stefan 'tommie' Tomanek
+use vars qw{$ticker_shift $ticker_text $update_tag $refresh_tag};
+
+sub get_stock {
+ my ($wkn, $exchange) = @_;
+
+ my $XsearchWPArt = 'STK';
+ my $XsearchBoersen = $exchange;
+
+ my $searchfor = $wkn;
+ #$searchfor =~ s/ /\%20/g;
+ my $host = "http://informer2.comdirect.de";
+ my $path = '/de/suche/main.html?';
+ my $searchButton = 'Exakt';
+ my $querystring = "&searchfor=".$wkn."&searchButton=Exakt&XsearchWPArt=STK&XsearchBoersen=".$exchange;
+
+ my $content = get( $host . $path . $querystring );
+
+ my ( $oldcompany, $comp, $nbr, $boerse ) = "";
+
+ my %stock;
+ if ( $content =~
+m/<th width="99%" class="news">(.*?)<\/th>.*?<td.*?>WKN.*?class="sym">(\d+)/s
+ )
+ {
+ $stock{'wkn'} = $2;
+ $stock{'company'} = $1;
+ }
+
+ if ( $content =~ m/<td.*?>(Aktueller Kurs)<\/td>\s+<td>(.*?)<\/td>/s ) {
+ $stock{'price'} = $2;
+ $stock{'price'} =~ s/&nbsp;<small>.*<\/small>//;
+ }
+ if ( $content =~ m/<td.*?>(Differenz)<\/td>\s+<td>(.*?)<\/td>/s ) {
+ $stock{'diff'} = $2;
+ }
+ return %stock;
+}
+
+sub update_ticker {
+ fork_get();
+}
+
+sub fork_get {
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ my $pid = fork();
+ if ($pid > 0) {
+ close $wh;
+ Irssi::pidwait_add($pid);
+ my $pipetag;
+ my @args = ($rh, \$pipetag);
+ $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
+ } else {
+ eval {
+ my $data = get_ticker_data();
+ print($wh $data);
+ close($wh)
+ };
+ POSIX::_exit(1);
+ }
+}
+
+sub pipe_input ($) {
+ my ($rh, $pipetag) = @{$_[0]};
+ my @lines = <$rh>;
+ close($rh);
+ Irssi::input_remove($pipetag);
+ my $text = join("", @lines);
+ $ticker_text = $text;
+}
+
+sub shift_string {
+ my ($string, $pos) = @_;
+ my $first = substr($string, 0, $pos);
+ my $middle = substr($string, $pos);
+ return $middle.$first;
+}
+
+$ticker_shift = 0;
+sub show_ticker {
+ my ($item, $get_size_only) = @_;
+ my $ticker_string = $ticker_text;
+ unless ($get_size_only) {
+ $ticker_shift = 0 if ($ticker_shift >= length($ticker_string));
+ }
+ my $max_width = Irssi::settings_get_int('stocks_ticker_max_width');
+ my $ticker_text = shift_string($ticker_string, $ticker_shift);
+ $ticker_text = substr($ticker_text, 0, $max_width-3) if (length($ticker_text)+2 > $max_width);
+ $item->{min_size} = $item->{max_size} = length("$ticker_text")+2;
+ $ticker_text =~ s/\%/\%\%/g;
+ $ticker_text = '>'.$ticker_text.'%n>';
+ $ticker_text =~ s/\(\-/\%R\(\-/g;
+ $ticker_text =~ s/\(\+/\%G\(\+/g;
+ $ticker_text =~ s/\)/\)\%n/g;
+ my $format = "{sb ".$ticker_text."}";
+ $item->default_handler($get_size_only, $format, 0, 1);
+}
+
+sub ticker_redraw {
+ $ticker_shift++;
+ Irssi::statusbar_items_redraw('stocks_ticker');
+}
+
+sub get_ticker_data {
+ my @stocks = split(/,/, Irssi::settings_get_str('stocks_ticker_stocks'));
+ my $tape='';
+ foreach (@stocks) {
+ my ($wkn, $exchange, $name) = split(/\//, $_);
+ my %stock = get_stock($wkn, $exchange);
+ if ($name eq '') { $name = $stock{'company'}; };
+ $tape = $tape.'| '.$name.': '.$stock{'price'}.'/'.$stock{'diff'};
+ }
+ return $tape;
+}
+
+sub load_config {
+ Irssi::timeout_remove($update_tag);
+ Irssi::timeout_remove($refresh_tag);
+ $update_tag = Irssi::timeout_add(Irssi::settings_get_int('stocks_ticker_update_delay'), 'update_ticker', undef);
+ $refresh_tag = Irssi::timeout_add(Irssi::settings_get_int('stocks_ticker_scroll_delay'), 'ticker_redraw', undef);
+ update_ticker();
+}
+
+Irssi::statusbar_item_register('stocks_ticker', 0, 'show_ticker');
+Irssi::settings_add_int('misc', 'stocks_ticker_max_width', 20);
+Irssi::settings_add_int('misc', 'stocks_ticker_update_delay', 120000);
+Irssi::settings_add_int('misc', 'stocks_ticker_scroll_delay', 2000);
+Irssi::settings_add_str('misc', 'stocks_ticker_stocks', '');
+
+Irssi::command_bind( 'stocks', 'cmd_kurs' );
+Irssi::command_bind( 'stocks_ticker_update', 'load_config' );
+
+load_config();
diff --git a/scripts/synccheck.pl b/scripts/synccheck.pl
new file mode 100644
index 0000000..0bce93c
--- /dev/null
+++ b/scripts/synccheck.pl
@@ -0,0 +1,346 @@
+#
+# usage: /sync-check [channel (servers)|-stop]
+# examples:
+# /sync-check *.de
+# /sync-check
+# /sync-check #irssi
+# /sync-check poznan.irc.pl
+# /sync-check #irssi poznan.irc.pl *.de
+# /sync-check -stop
+# usage: /SET synccheck_show_all_errors [On/Off]
+#
+
+use strict;
+use Irssi 20020313 ();
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.4.9.1";
+%IRSSI = (
+ authors => 'Marcin Rozycki',
+ contact => 'derwan@irssi.pl',
+ name => 'sync-check',
+ description => 'Script checking channel synchronization. Usage: /sync-check [channel (servers)|-stop]',
+ license => 'GNU GPL v2',
+ url => 'http://derwan.irssi.pl',
+ changed => 'Fri Aug 9 23:00:00 CEST 2002'
+);
+
+my $synccheck = undef;
+
+sub _print ($$$)
+{
+ my ($server, $level, $msg) = @_;
+ if (defined $synccheck and $server and my $win = $server->channel_find($synccheck->{name})) {
+ $win->print($msg, $level);
+ }
+}
+
+sub _endof
+{
+ %$synccheck = (), undef $synccheck if (defined $synccheck);
+ Irssi::print(shift) if (@_);
+}
+
+sub _new ($)
+{
+ _endof; my $server = shift;
+ return 0 unless ($server and $server->{type} eq 'SERVER' and $server->{connected});
+
+ $synccheck = {};
+ $synccheck->{time} = time;
+ $synccheck->{server} = $server->{address};
+ $synccheck->{tag} = $server->{tag};
+ $synccheck->{_error} = 0;
+ $synccheck->{_tested} = 0;
+ $synccheck->{_info} = 0;
+
+ return $synccheck;
+}
+
+sub _setchan ($)
+{
+ if (defined $synccheck) {
+ $synccheck->{name} = shift;
+ $synccheck->{channel} = lc($synccheck->{name});
+ }
+}
+
+sub _addlink ($)
+{
+ my $link = shift;
+ if (defined $synccheck and $link and $link ne $synccheck->{server}) {
+ push (@{$synccheck->{links}}, $link);
+ }
+}
+
+sub _register
+{
+ my $server = shift; my $nick = lc(shift); my $sig = shift;
+ %{$synccheck->{names}->{$server}->{$nick}} = (
+ NULL => 1,
+ op => 0,
+ voice => 0,
+ $sig => 1,
+ ) if (defined $synccheck);
+}
+
+sub _isregister ($$)
+{
+ my $server = shift; my $nick = lc(shift);
+ return ((defined $synccheck and defined $synccheck->{names}->{$server}->{$nick}->{NULL}) ? 1 : 0);
+}
+
+sub _isop ($$)
+{
+ my $server = shift; my $nick = lc(shift);
+ return ((_isregister($server, $nick) and $synccheck->{names}->{$server}->{$nick}->{op}) ? 1 : 0);
+}
+
+sub _isvoice ($$)
+{
+ my $server = shift; my $nick = lc(shift);
+ return ((_isregister($server, $nick) and $synccheck->{names}->{$server}->{$nick}->{voice}) ? 1 : 0);
+}
+
+sub _rec2mod ($)
+{
+ my $hash = shift;
+ my $mod = ($hash->{voice}) ? '+' : undef; $mod .= ($hash->{op}) ? '@' : undef;
+ return $mod;
+}
+
+sub _reg2mod ($$)
+{
+ my $server = shift; my $nick = lc(shift); my $mod = undef;
+ if (_isregister($server, $nick)) {
+ $mod .= ($synccheck->{names}->{$server}->{$nick}->{voice}) ? '+' : ($synccheck->{names}->{$server}->{$nick}->{op}) ? '@' : '';
+ }
+ return $mod;
+}
+
+sub _errorregister ($$) {
+ my ($nick, $sig) = @_; my $retval = 1;
+ unless (Irssi::settings_get_bool("synccheck_show_all_errors")) {
+ $retval = ($synccheck->{registered_errors}->{$nick}->{$sig}) ? 0 : 1;
+ }
+ $synccheck->{registered_errors}->{$nick}->{$sig}++;
+ return $retval;
+}
+
+sub _adderror ($$$$)
+{
+ my ($nick, $sig, $server, $error) = @_;
+ if (_errorregister $nick, $sig) {
+ push @{$synccheck->{errors}->{$server}}, $error;
+ }
+}
+
+sub _flusherrors ($$)
+{
+ my ($local, $remote) = @_;
+ if ($#{$synccheck->{errors}->{$remote}} >= 0) {
+ _print($local, MSGLEVEL_CLIENTCRAP, "(error in synchronization will be shown only once for the first server where the error exists, but it can exists on more servers; if you want to show all errors use /set synccheck_show_all_errors On)")
+ if (!Irssi::settings_get_bool("synccheck_show_all_errors") and !$synccheck->{_info}++);
+ _print($local, MSGLEVEL_CLIENTCRAP, "%RPossible channel %n%_$synccheck->{name}%_%R desynced%n%_ $synccheck->{server} <-> $remote%_:");
+ for (@{$synccheck->{errors}->{$remote}})
+ {
+ _print($local, MSGLEVEL_CLIENTCRAP, "%_".sprintf("%03d", ++$synccheck->{_error}).".%_ $_");
+ }
+ delete $synccheck->{errors}->{$remote};
+ }
+}
+
+sub _addnames
+{
+ my $remote = shift; return unless ($remote and defined $synccheck);
+ for (@_)
+ {
+ /^\@/ and substr($_, 0, 1) = "", _register($remote, $_, "op"), next;
+ /^\+/ and substr($_, 0, 1) = "", _register($remote, $_, "voice"), next;
+ _register($remote, $_, "NULL");
+ }
+}
+
+sub _numlinks
+{
+ return ((defined $synccheck and defined $synccheck->{links}) ? scalar(@{$synccheck->{links}}) : 0);
+}
+
+sub tdiff ($)
+{
+ my $end = time(); my $start = shift;
+ return (($start and $start =~ /^\d+$/ and $start <= $end) ? ($end - $start) : 0);
+}
+
+sub _synccheck ($)
+{
+ my $local = shift; my $remote = ${$synccheck->{links}}[$synccheck->{_tested}++];
+
+ _endof("End of sync-check (canceled)"), return
+ if (!$synccheck or !$local->channel_find($synccheck->{name}));
+
+ unless ($remote) {
+ _print($local, MSGLEVEL_CLIENTCRAP, "%_Sync-check%_ in $synccheck->{name} ($synccheck->{tag}) %_finished in ".tdiff($synccheck->{time})." secs%_");
+ _endof; return;
+ }
+
+ _print($local, MSGLEVEL_CLIENTCRAP, "%K->%n checking $synccheck->{name}: $synccheck->{server} %_<-> $remote%_ %K[%n$synccheck->{_tested}/"._numlinks."%K]%n");
+
+ $local->redirect_event("names", 0, '', 1, undef, {
+ 'event 353' => 'redir names line',
+ 'event 366' => 'redir names done',
+ 'event 402', => 'redir names split',
+ '' => 'event empty' });
+
+ $local->send_raw("NAMES $synccheck->{channel} :$remote");
+}
+
+sub _test
+{
+ my ($local, $remote) = @_;
+
+ unless (_isregister $remote, $local->{nick}) {
+ _adderror($local->{nick}, "notexsit", $remote, "%_you\'re%_ not in channel $synccheck->{name} on $remote");
+ _flusherrors($local, $remote);
+ delete $synccheck->{names}->{$remote};
+ return;
+ }
+
+ my $channel = $local->channel_find($synccheck->{name});
+ _endof, return unless $channel;
+
+ my %orig = (); map($orig{lc($_->{nick})} = $_, $channel->nicks());
+
+ foreach my $nick (keys %{$synccheck->{names}->{$remote}})
+ {
+ if (!$orig{$nick}) {
+ _adderror($nick, "notexist", $remote, "%_*notexist%_($synccheck->{server}) %_!= "._reg2mod($remote, $nick)."$nick%_($remote)");
+ $orig{$nick} = 0; next;
+ }
+
+ my $op = _isop $remote, $nick; my $voice = _isvoice $remote, $nick;
+ if ($orig{$nick}->{op} != $op) {
+ my $mod1 = _rec2mod($orig{$nick}); my $mod2 = _reg2mod($remote, $nick);
+ _adderror($nick, "op", $remote, "%_$mod1%_$nick($synccheck->{server}) %_!= $mod2%_$nick($remote)");
+
+ } elsif (!$op and $orig{$nick}->{voice} != $voice) {
+ my $mod1 = _rec2mod($orig{$nick}); my $mod2 = _reg2mod($remote, $nick);
+ _adderror($nick, "voice", $remote, "%_$mod1%_$nick($synccheck->{server}) %_!= $mod2%_$nick($remote)");
+ }
+ $orig{$nick} = 0;
+ }
+ delete $synccheck->{names}->{$remote};
+
+ foreach my $nick (keys %orig)
+ {
+ next unless $orig{$nick};
+ _adderror($nick, "notexist", $remote, _rec2mod($orig{$nick})."%_$nick%_($synccheck->{server}) %_!= *notexist%_($remote)");
+ }
+
+ _flusherrors($local, $remote);
+ _synccheck $local;
+}
+
+Irssi::command_bind 'sync-check' => sub
+{
+ my $usage = "/%_sync-check%_ [%_channel%_ (%_servers%_)|%_-stop%_]";
+
+ unless ($_[1] and $_[1]->{type} eq 'SERVER' and $_[1]->{connected}) {
+ Irssi::print("Not connected to server");
+ return;
+ }
+
+ if (defined $synccheck) {
+ if ($_[0] !~ /^-stop/) {
+ Irssi::print("Sync-check already running " . tdiff($synccheck->{time}) . " secs ago for channel %_$synccheck->{name}%_, wait...");
+ } else {
+ _endof("%_Stopping%_ sync-checker for channel %_$synccheck->{name}%_ in $synccheck->{tag}")
+ }
+ return;
+ }
+
+ return unless _new($_[1]);
+
+ foreach (split / +/, $_[0])
+ {
+ /^-yes/i and $synccheck->{_yes} = 1, next;
+ /^-stop$/ and _endof("Not running any sync-checker"), return;
+ /^-/ and _endof("Unknown argument: %_$_%_, usage: $usage"), return;
+ if ($_[1]->ischannel($_)) { _setchan $_; } else { _addlink $_; }
+ }
+
+ if ($synccheck->{channel} and !$_[1]->channel_find($synccheck->{channel})) {
+ _endof("You\'re not in channel %_$synccheck->{name}%_"); return;
+ } elsif (!$synccheck->{channel}) {
+ if ($_[2] and $_[2]->{type} eq 'CHANNEL') {
+ _setchan $_[2]->{name};
+ } else {
+ _endof("Not joined to any channel"); return;
+ }
+ }
+
+ if (!_numlinks) {
+ _endof("Doing this is not a good idea. Add -YES option to command if you really mean it"), return unless ($synccheck->{_yes});
+
+ _print($_[1], MSGLEVEL_CLIENTCRAP, "Checking for %_links%_ from %_$synccheck->{server}%_ in %_$synccheck->{tag}%_, wait...");
+ $_[1]->redirect_event('links', 0, '', 1, undef, {
+ 'event 364' => 'redir links line',
+ 'event 365' => 'redir links done',
+ '' => 'event empty' });
+ $_[1]->send_raw('LINKS :*');
+
+ } else {
+ if (_numlinks) {
+ _print($_[1], MSGLEVEL_CLIENTCRAP, "%_Checking channel $synccheck->{name} synchronization%_ in: $synccheck->{server} %_<->%_ @{$synccheck->{links}}. This will take a while..");
+ _synccheck $_[1];
+ }
+ }
+};
+
+Irssi::Irc::Server::redirect_register(
+ "links", 0, 0,
+ { "event 364" => 1, },
+ { "event 402" => 1, "event 263" => 1, "event 365" => 1, },
+ undef,
+);
+
+Irssi::Irc::Server::redirect_register(
+ "names", 0, 0,
+ { "event 353" => 1, },
+ { "event 366" => 1,
+ "event 402" => 1, },
+ undef,
+);
+
+Irssi::signal_add 'redir links line' => sub {
+ $_[1] =~ /(.*) (.*) (.*) :(.*)/;
+ _addlink $2;
+};
+
+Irssi::signal_add 'redir links done' => sub {
+ if (_numlinks) {
+ _print($_[0], MSGLEVEL_CLIENTCRAP, "%_Checking channel $synccheck->{name} synchronization%_ in: $synccheck->{server} %_<->%_ @{$synccheck->{links}}. This will take a while..");
+ _synccheck $_[0];
+ }
+};
+
+Irssi::signal_add 'redir names line' => sub {
+ $_[1] =~ /(.*) (.*) :(.*)/;
+ _addnames($_[2], split(" ", $3)) if (defined $synccheck and lc($2) eq $synccheck->{channel});
+};
+
+Irssi::signal_add 'redir names done' => sub
+{
+ $_[1] =~ /(.*) (.*) :(.*)/;
+ _test($_[0], $_[2]) if (defined $synccheck and lc($2) eq $synccheck->{channel});;
+};
+
+Irssi::signal_add 'redir names split' => sub
+{
+ $_[1] =~ /(.*) (.*) :(.*)/;
+ _print($_[0], MSGLEVEL_CLIENTCRAP, "%K->%n%_ $2%_: cannot find link (".lc($3)."), skipping");
+ _synccheck $_[0];
+};
+
+Irssi::settings_add_bool('misc', 'synccheck_show_all_errors', 0);
+
diff --git a/scripts/sysinfo277-irssi.pl b/scripts/sysinfo277-irssi.pl
new file mode 100644
index 0000000..ae8c3e4
--- /dev/null
+++ b/scripts/sysinfo277-irssi.pl
@@ -0,0 +1,546 @@
+#!/usr/bin/perl -w
+#
+# Copyright (c) 2002, 2003 David Rudie
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $ident: sysinfo277-irssi.pl,v 2.77 2003/09/01 04:20:02 drudie Exp $
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = '2.79';
+%IRSSI = (
+ authors => 'David Rudie',
+ contact => 'david@inexistent.com',
+ name => 'SysInfo',
+ description => 'Cross-platform/architecture system information script.',
+ license => 'BSD',
+ url => 'http://www.inexistent.com/',
+ changed => '2019-11-08',
+ bugs => 'Probably some if it cannot read /proc.'
+);
+
+
+use Irssi;
+use POSIX qw(floor);
+
+
+# Set up the arrays and variables first.
+use vars qw(
+ @arr
+ @arr1
+ @arr2
+ $cpu
+ @cpu
+ @cpuinfo
+ $data
+ @data
+ $df
+ @dmesgboot
+ @hinv
+ @meminfo
+ $mhz
+ @mhz
+ $model
+ @netdev
+ @netstat
+ @nic
+ @nicname
+ $smp
+ @smp
+ $stream
+ $sysctl
+ @uptime
+ $var
+ $vara
+ $varb
+ $varc
+ $vard
+ $varh
+ $varm
+ $varp
+ $varx
+ $vary
+ $varz
+);
+
+
+my $os = `uname -s`; chop($os);
+my $osn = `uname -n`; chop($osn);
+my $osv = `uname -r`; chop($osv);
+my $osm = `uname -m`; chop($osm);
+my $uname = "$os $osv/$osm";
+
+
+my $darwin = 1 if $os =~ /^Darwin$/;
+my $freebsd = 1 if $os =~ /^FreeBSD$/;
+my $linux = 1 if $os =~ /^Linux$/;
+my $netbsd = 1 if $os =~ /^NetBSD$/;
+my $openbsd = 1 if $os =~ /^OpenBSD$/;
+my $irix = 1 if $os =~ /^IRIX$/;
+my $irix64 = 1 if $os =~ /^IRIX64$/;
+
+
+my $alpha = 1 if $osm =~ /^alpha$/;
+my $armv4l = 1 if $osm =~ /^armv4l$/;
+my $armv5l = 1 if $osm =~ /^armv5l$/;
+my $armv7l = 1 if $osm =~ /^armv7l$/;
+my $i586 = 1 if $osm =~ /^i586$/;
+my $i686 = 1 if $osm =~ /^i686$/;
+my $ia64 = 1 if $osm =~ /^ia64$/;
+my $mips = 1 if $osm =~ /^mips$/;
+my $parisc64 = 1 if $osm =~ /^parisc64$/;
+my $ppc = 1 if $osm =~ /^ppc$/;
+my $x86_64 = 1 if $osm =~ /^x86_64$/;
+
+
+# linux => 2.6
+$osv =~ m/^(\d+\.\d+)/;
+my $l26 = 1 if 2.6 <=$1;
+
+
+sub cmd_sysinfo {
+ # Specify your NIC interface name (eth0, rl0, fxp0, etc) and a name for it.
+ #
+ # Example: @nic = ('eth0', 'eth1');
+ # @nicname = ('External', 'Internal');
+ #
+ # NOTE: If you set one then you HAVE to set the other.
+ @nic = split(/;/, Irssi::settings_get_str('sysinfo_nics'));
+ @nicname = split(/;/, Irssi::settings_get_str('sysinfo_nicnames'));
+
+
+ # These are the default settings for which information gets displayed.
+ # 0 = Off; 1 = On
+ my $showHostname = 1;
+ my $showOS = 1;
+ my $showCPU = 1;
+ my $showProcesses = 1;
+ my $showUptime = 1;
+ my $showLoadAverage = 1;
+ my $showBattery = 0;
+ my $showMemoryUsage = 1;
+ my $showDiskUsage = 1;
+ my $showNetworkTraffic= 1;
+
+
+ ###############################################
+ ### Nothing below here should need changed. ###
+ ###############################################
+
+
+ if($linux) {
+ @cpuinfo = &openfile("/proc/cpuinfo");
+ @meminfo = &openfile("/proc/meminfo");
+ @netdev = &openfile("/proc/net/dev");
+ @uptime = &openfile("/proc/uptime");
+ } elsif($irix || $irix64) {
+ @hinv = `hinv`;
+ } else {
+ @dmesgboot = &openfile("/var/run/dmesg.boot");
+ @netstat = `netstat -ibn`;
+ if($darwin) {
+ $sysctl = '/usr/sbin/sysctl';
+ } else {
+ $sysctl = '/sbin/sysctl';
+ }
+ }
+
+
+ if($armv4l || $armv5l || $armv7l) {
+ $df = 'df -k';
+ } else {
+ $df = 'df -lk';
+ }
+
+
+ if($showCPU) {
+ if($freebsd) {
+ if($alpha) {
+ @cpu = grep(/^COMPAQ/, @dmesgboot);
+ $cpu = join("\n", $cpu[0]);
+ } else {
+ @cpu = grep(/CPU: /, @dmesgboot);
+ $cpu = join("\n", @cpu);
+ @cpu = split(/: /, $cpu);
+ $cpu = $cpu[1];
+ @smp = grep(/ cpu/, @dmesgboot);
+ $smp = scalar @smp;
+ }
+ }
+ if($netbsd) {
+ if($alpha) {
+ @cpu = grep(/^COMPAQ/, @dmesgboot);
+ $cpu = join("\n", $cpu[0]);
+ @cpu = split(/, /, $cpu);
+ $cpu = $cpu[0];
+ } else {
+ @cpu = grep(/cpu0: /, @dmesgboot);
+ @cpu = grep(!/apic/, @cpu);
+ $cpu = join("\n", $cpu[0]);
+ @cpu = split(/: /, $cpu);
+ $cpu = $cpu[1];
+ @smp = grep(/cpu\d+:/, @dmesgboot);
+ @smp = grep(/MHz/, @smp);
+ $smp = scalar @smp;
+ }
+ }
+ if($openbsd) {
+ @cpu = grep(/cpu0: /, @dmesgboot);
+ @cpu = grep(/[M|G]Hz/, @cpu);
+ $cpu = join("\n", @cpu);
+ @cpu = split(/: /, $cpu);
+ $cpu = $cpu[1];
+ }
+ if($irix || $irix64) {
+ @cpu = grep(/CPU:/, @hinv);
+ $cpu = join("\n", @cpu);
+ $cpu =~ s/^.*(R[0-9]*) .*$/$1/;
+ @mhz = grep(/MHZ/, @hinv);
+ $mhz = join("\n", @mhz);
+ $mhz = $mhz[0];
+ $mhz =~ s/^.* ([0-9]*) MHZ.*$/$1/;
+ @smp = grep(/ IP/, @hinv);
+ $smp = scalar @smp;
+ chop($cpu);
+ chop($mhz);
+ $cpu = "MIPS $cpu ($mhz MHz)";
+ }
+ if($linux) {
+ if($alpha) {
+ $cpu = &cpuinfo("cpu\\s+: ");
+ $model = &cpuinfo("cpu model\\s+: ");
+ $cpu = "$cpu $model";
+ $smp = &cpuinfo("cpus detected\\s+: ");
+ }
+ if($armv4l || $armv5l) {
+ $cpu = &cpuinfo("Processor\\s+: ");
+ }
+ if($armv7l) {
+ $cpu = &cpuinfo("model name\\s+: ");
+ }
+ if($i686 || $i586 || $x86_64) {
+ $cpu = &cpuinfo("model name\\s+: ");
+ $cpu =~ s/(.+) CPU family\t+\d+MHz/$1/g;
+ $cpu =~ s/(.+) CPU .+GHz/$1/g;
+ $mhz = &cpuinfo("cpu MHz\\s+: ");
+ $cpu = "$cpu ($mhz MHz)";
+ @smp = grep(/processor\s+: /, @cpuinfo);
+ $smp = scalar @smp;
+ }
+ if($ia64) {
+ $cpu = &cpuinfo("vendor\\s+: ");
+ $model = &cpuinfo("family\\s+: ");
+ $mhz = &cpuinfo("cpu MHz\\s+: ");
+ $mhz = sprintf("%.2f", $mhz);
+ $cpu = "$cpu $model ($mhz MHz)";
+ @smp = grep(/processor\s+: /, @cpuinfo);
+ $smp = scalar @smp;
+ }
+ if($mips) {
+ $cpu = &cpuinfo("cpu\\s+: ");
+ $model = &cpuinfo("cpu model\\s+: ");
+ $cpu = "$cpu $model";
+ }
+ if($parisc64) {
+ $cpu = &cpuinfo("cpu\\s+: ");
+ $model = &cpuinfo("model name\\s+: ");
+ $mhz = &cpuinfo("cpu MHz\\s+: ");
+ $mhz = sprintf("%.2f", $mhz);
+ $cpu = "$model $cpu ($mhz MHz)";
+ }
+ if($ppc) {
+ $cpu = &cpuinfo("cpu\\s+: ");
+ $mhz = &cpuinfo("clock\\s+: ");
+ if($cpu =~ /^9.+/) {
+ $model = "IBM PowerPC G5";
+ } elsif($cpu =~ /^74.+/) {
+ $model = "Motorola PowerPC G4";
+ } else {
+ $model = "IBM PowerPC G3";
+ }
+ $cpu = "$model $cpu ($mhz)";
+ }
+ } elsif($darwin) {
+ $cpu = `hostinfo | grep 'Processor type' | cut -f2 -d':'`; chomp($cpu);
+ $cpu =~ s/^\s*(.+)\s*$/$1/g;
+ if($cpu =~ /^ppc7.+/) {
+ $cpu = "Motorola PowerPC G4";
+ }
+ $mhz = `$sysctl -n hw.cpufrequency`; chomp($mhz);
+ $mhz = sprintf("%.2f", $mhz / 1000000);
+ $cpu = "$cpu ($mhz MHz)";
+ $smp = `hostinfo | grep "physically available" | cut -f1 -d' '`; chomp($smp);
+ }
+ if($smp && $smp gt 1) {
+ $cpu = "$smp x $cpu";
+ }
+ }
+
+
+ my $output;
+ if($showHostname) { $output = "Hostname: $osn - "; }
+ if($showOS) { $output .= "OS: $uname - "; }
+ if($showCPU) { $output .= "CPU: $cpu - "; }
+ if($showProcesses) { $output .= "Processes: ".&processes." - "; }
+ if($showUptime) { $output .= "Uptime: ".&uptime." - "; }
+ if($showLoadAverage) { $output .= "Load Average: ".&loadaverage." - "; }
+ if($showBattery) { $output .= "Battery: ".&battery." - "; }
+ if($showMemoryUsage) { $output .= "Memory Usage: ".&memoryusage." - "; }
+ if($showDiskUsage) { $output .= "Disk Usage: ".&diskusage." - "; }
+ if($showNetworkTraffic) { $output .= &networktraffic; }
+ $output =~ s/ - $//g;
+ Irssi::active_win()->command("/ $output");
+ return 1;
+}
+
+
+sub battery {
+ $data = "";
+ if(open(FD, "<", '/proc/apm')) {
+ while($stream = <FD>) {
+ $data .= $stream;
+ @data = split(/\n/, $data);
+ }
+ close(FD);
+ }
+ $data = $data[0];
+ $data =~ s/.+\s(\d+%).+/$1/;
+ return $data;
+}
+
+
+sub cpuinfo {
+ my $string = shift;
+ @arr = grep(/$string/, @cpuinfo);
+ $var = join("\n", $arr[0]);
+ @arr = split(/: /, $var);
+ $var = $arr[1];
+ return $var;
+}
+
+
+sub diskusage {
+ if($irix || $irix64) {
+ $vara = `$df | grep -v Filesystem | awk '{ sum+=\$3 / 1024 / 1024}; END { print sum }'`; chomp($vara);
+ $vard = `$df | grep -v Filesystem | awk '{ sum+=\$4 / 1024 / 1024}; END { print sum }'`; chomp($vard);
+ } else {
+ $vara = `$df | grep -v Filesystem | awk '{ sum+=\$2 / 1024 / 1024}; END { print sum }'`; chomp($vara);
+ $vard = `$df | grep -v Filesystem | awk '{ sum+=\$3 / 1024 / 1024}; END { print sum }'`; chomp($vard);
+ }
+ $varp = sprintf("%.2f", $vard / $vara * 100);
+ $vara = sprintf("%.2f", $vara);
+ $vard = sprintf("%.2f", $vard);
+ return $vard."GB/".$vara."GB ($varp%)";
+}
+
+
+sub loadaverage {
+ $var = `uptime`; chomp($var);
+ if($irix || $irix64 || $linux) {
+ @arr = split(/average: /, $var, 2);
+ } else {
+ @arr = split(/averages: /, $var, 2);
+ }
+ @arr = split(/, /, $arr[1], 2);
+ $var = $arr[0];
+ return $var;
+}
+
+
+sub meminfo {
+ my $string = shift;
+ @arr = grep(/$string/, @meminfo);
+ $var = join("\n", $arr[0]);
+ @arr = split(/\s+/, $var);
+ $var = $arr[1];
+ return $var;
+}
+
+
+sub memoryusage {
+ if($linux) {
+ if($l26) {
+ $vara = &meminfo("MemTotal:") * 1024;
+ $varb = &meminfo("Buffers:") * 1024;
+ $varc = &meminfo("Cached:") * 1024;
+ $vard = &meminfo("MemFree:") * 1024;
+ } else {
+ @arr = grep(/Mem:/, @meminfo);
+ $var = join("\n", @arr);
+ @arr = split(/\s+/, $var);
+ $vara = $arr[1];
+ $varb = $arr[5];
+ $varc = $arr[6];
+ $vard = $arr[3];
+ }
+ $vard = ($vara - $vard) - $varb - $varc;
+ } elsif($darwin) {
+ $vard = `vm_stat | grep 'Pages active' | awk '{print \$3}'` * 4096;
+ $vara = `$sysctl -n hw.physmem`;
+ } elsif($irix || $irix64) {
+ $var = `top -d1 | grep Memory`; chomp($var);
+ $vara = $var;
+ $vard = $var;
+ $vara =~ s/^.* ([0-9]*)M max.*$/$1/;
+ $vara *= 1024 * 1024;
+ $vard =~ s/^.* ([0-9]*)M free,.*$/$1/;
+ $vard = $vara - ($vard * 1024 * 1024);
+ } else {
+ $vard = `vmstat -s | grep 'pages active' | awk '{print \$1}'` * `vmstat -s | grep 'per page' | awk '{print \$1}'`;
+ $vara = `$sysctl -n hw.physmem`;
+ }
+ $varp = sprintf("%.2f", $vard / $vara * 100);
+ $vara = sprintf("%.2f", $vara / 1024 / 1024);
+ $vard = sprintf("%.2f", $vard / 1024 / 1024);
+ return $vard."MB/".$vara."MB ($varp%)";
+}
+
+
+sub networkinfobsd {
+ $varc = shift;
+ $vard = shift;
+ @arr = grep(/$varc/, @netstat);
+ @arr = grep(/Link/, @arr);
+ $var = join("\n", @arr);
+ @arr = split(/\s+/, $var);
+ $var = $arr[$vard] / 1024 / 1024;
+ $var = sprintf("%.2f", $var);
+ return $var;
+}
+
+
+sub networkinfolinux {
+ $varc = shift;
+ $vard = shift;
+ @arr = grep(/$varc/, @netdev);
+ $var = join("\n", @arr);
+ @arr = split(/:\s*/, $var);
+ @arr = split(/\s+/, $arr[1]);
+ $var = $arr[$vard] / 1024 / 1024;
+ $var = sprintf("%.2f", $var);
+ return $var;
+}
+
+
+sub networktraffic {
+ $vara = 0;
+ $varz = "";
+ $varb = scalar @nic;
+ if($nic[$vara] ne "") {
+ while($vara lt $varb) {
+ if($nic[$vara] ne "") {
+ if($darwin || $freebsd) {
+ $varx = &networkinfobsd($nic[$vara], 6);
+ $vary = &networkinfobsd($nic[$vara], 9);
+ }
+ if($netbsd || $openbsd) {
+ $varx = &networkinfobsd($nic[$vara], 4);
+ $vary = &networkinfobsd($nic[$vara], 5);
+ }
+ if($linux) {
+ $varx = &networkinfolinux($nic[$vara], 0);
+ $vary = &networkinfolinux($nic[$vara], 8);
+ }
+ $varz .= $nicname[$vara]." Traffic (".$nic[$vara]."): ".$varx."MB In/".$vary."MB Out - ";
+ }
+ $vara++;
+ }
+ return $varz;
+ }
+}
+
+
+sub openfile {
+ my $string = shift;
+ $data = "";
+ if(open(FD, "<", $string)) {
+ while($stream = <FD>) {
+ $data .= $stream;
+ @data = split(/\n/, $data);
+ }
+ close(FD);
+ }
+ return @data;
+}
+
+
+sub processes {
+ if($irix || $irix64) {
+ $var = `ps -e | grep -v PID | wc -l`;
+ } else {
+ $var = `ps ax | grep -v PID | wc -l`;
+ }
+ chomp($var);
+ $var = $var;
+ $var =~ s/^\s+//;
+ $var =~ s/\s+$//;
+ return $var;
+}
+
+
+sub uptime {
+ if($irix || $irix64) {
+ $var = `uptime`; chomp($var);
+ if($var =~ /day/) {
+ $var =~ s/^.* ([0-9]*) day.* ([0-9]*):([0-9]*), .*$/$1d $2h $3m/;
+ } elsif($var =~/min/) {
+ $var =~ s/^.* ([0-9]*) min.*$/0d 0h $1m/;
+ } else {
+ $var =~ s/^.* ([0-9]*):([0-9]*),.*$/0d $1h $2m/;
+ }
+ return $var;
+ } else {
+ if($freebsd) {
+ $var = `$sysctl -n kern.boottime | awk '{print \$4}'`;
+ }
+ if($netbsd || $openbsd || $darwin) {
+ $var = `$sysctl -n kern.boottime`;
+ }
+ if($linux) {
+ @arr = split(/ /, $uptime[0]);
+ $varx = $arr[0];
+ } else {
+ chomp($var);
+ $var =~ s/,//g;
+ $vary = `date +%s`; chomp($vary);
+ $varx = $vary - $var;
+ }
+ $varx = sprintf("%2d", $varx);
+ $vard = floor($varx / 86400);
+ $varx %= 86400;
+ $varh = floor($varx / 3600);
+ $varx %= 3600;
+ $varm = floor($varx / 60);
+ if($vard eq 0) { $vard = ''; } elsif($vard >= 1) { $vard = $vard.'d '; }
+ if($varh eq 0) { $varh = ''; } elsif($varh >= 1) { $varh = $varh.'h '; }
+ if($varm eq 0) { $varm = ''; } elsif($varm >= 1) { $varm = $varm.'m'; }
+ return $vard.$varh.$varm;
+ }
+}
+
+Irssi::settings_add_str("sysinfo", "sysinfo_nics", "");
+Irssi::settings_add_str("sysinfo", "sysinfo_nicnames", "");
+
+Irssi::command_bind("sysinfo", "cmd_sysinfo");
diff --git a/scripts/sysinfo_dg.pl b/scripts/sysinfo_dg.pl
new file mode 100644
index 0000000..360a916
--- /dev/null
+++ b/scripts/sysinfo_dg.pl
@@ -0,0 +1,330 @@
+#!/usr/bin/perl
+use strict;
+use Irssi 20011210.0250 ();
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.3";
+%IRSSI = (
+ authors => 'David Leadbeater',
+ contact => 'dgl@dgl.cx',
+ name => 'sysinfo-dg',
+ description => 'Adds a /sysinfo command which prints system information (linux only).',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.dgl.cx/',
+);
+
+#This script is mostly my own work but some ideas where taken from /sinfo by
+#Laurens Buhler and Alain van Acker. Please leave this credit in the script and
+#if you edit it and think the change is worthwhile tell me and i may add it into
+#the script and credit you
+
+use vars qw/$colour $graphs $graphs2 $colour2 $style/;
+Irssi::command_bind("sysinfo","sysinfo");
+
+sub sysinfo{
+ my @options = split(/ /,$_[0]);
+ my %info;
+ my($hostname,$uname,$procs) = basicinfo();
+ my($distro) = distro();
+ my($uptime,$users,$loadavg) = uptime();
+ my($memsize,$memfree) = meminfo();
+ my($swapsize,$swapfree) = swapinfo();
+ my($cpumodel,$cpumhz,$cpucache,$bogomips) = cpuinfo();
+ my %netinfo = netinfo();
+ my($disktotal,$diskused,$hddtype) = df();
+ my($videocard,$ethernet) = pciinfo();
+ my($screenres,$screendepth);
+ ($screenres,$screendepth) = screenres() if $ENV{DISPLAY};
+
+ ($colour,$graphs,$graphs2,$colour2,$style) = parseoptions(\%netinfo,@options);
+
+ %info = (
+ 'os' => "$uname - $distro",
+ 'up' => $uptime,
+ 'cpu' => "$cpumodel, $cpumhz MHz ($bogomips bogomips)",
+ 'cache' => $cpucache,
+ 'mem' => ($memsize-$memfree) . "/$memsize MB (" . percent(($memsize-$memfree),$memsize) . ")",
+ 'host' => $hostname,
+ 'users' => $users,
+ 'load' => $loadavg,
+ 'procs' => $procs,
+ 'swap' => ($swapsize-$swapfree) . "/$swapsize MB (" . percent(($swapsize-$swapfree),$swapsize) . ")",
+ 'disk' => "$diskused/$disktotal MB (" . percent($diskused,$disktotal) . ") ($hddtype)",
+ 'video' => "$videocard at $screenres ($screendepth bits)",
+ 'ethernet' => $ethernet,
+ );
+
+ for(keys %netinfo){
+ $info{$_} = "in: $netinfo{$_}{in} MB, out: $netinfo{$_}{out} MB";
+ }
+
+ my $tmp;
+ for(split(/ /,$style)){
+ $tmp .= ircbit($_,$info{$_}) . " ";
+ }
+ $tmp =~ s/ $//;
+ Irssi::active_win()->command('say ' . $tmp);
+ ($colour,$graphs,$graphs2,$colour2,$style) = undef;
+}
+
+sub parseoptions{
+ my($netinfo,@options) = @_;
+
+ my $tmp = shift(@options) if $options[0] =~ /^\-/;
+ $tmp =~ s/^\-//;
+ for(split //,$tmp){
+ if($_ eq "c"){
+ $tmp =~ /c(\d+)/;
+ $colour = $1;
+ if(!$colour){
+ $colour = 3;
+ }
+ }elsif($_ eq "g"){
+ $tmp =~ /g(\d+)/;
+ $graphs = $1;
+ if(!$graphs){
+ $graphs = 9;
+ }
+ }elsif($_ eq "G"){
+ $tmp =~ /G(\d+)/;
+ $graphs2 = $1;
+ }elsif($_ eq "C"){
+ $tmp =~ /C(\d+)/;
+ $colour2 = $1;
+ }
+ }
+ if(!defined $colour2 && $colour){
+ $colour2 = 15;
+ }
+ if(defined $graphs && !defined $graphs2){
+ $graphs2 = 3;
+ }
+
+# We got the names on the command line
+ if($options[1]){
+ $style = join(" ",@options);
+# style name
+ }elsif($options[0]){
+ if($options[0] eq "std"){
+ $style = "os up cpu mem video";
+ }elsif($options[0] eq "bigger"){
+ $style = "os up cpu cache mem load procs disk video";
+ }elsif($options[0] eq "full"){
+ $style = "host os up cpu cache mem users load procs swap disk video ethernet ".join(" ",keys %{$netinfo});
+ }elsif($options[0] eq "net"){
+ $style = join(" ",keys %{$netinfo});
+ }elsif($options[0] eq "uptime"){
+ $style = "os up";
+ }elsif($options[0] eq "use"){
+ $style = "mem swap disk";
+ }
+ }else{
+# no input - default
+ $style = "os up cpu mem video";
+ }
+
+ return($colour,$graphs,$graphs2,$colour2,$style);
+}
+
+sub ircbit{
+ my($name,$text) = @_;
+ $name = " " . $name if $name =~ /^\d/;
+ $text = " " . $text if $text =~ /^\d/;
+ if($colour){
+ return "$colour$name$colour2\[$text$colour2\]";
+ }else{
+ return "$name\[$text\]";
+ }
+}
+
+sub percent{
+ my $percent = ($_[1] != 0) ? sprintf("%.1f",(($_[0]/$_[1])*100)) : 0;
+ if($graphs){
+ my $tmp = "[";
+ for(1..10){
+ if($_ > sprintf("%.0f",$percent / 10)){
+ $tmp .= "-" if !defined $colour;
+ $tmp .= "$graphs2-" if defined $colour;
+ }else{
+ $tmp .= "|" if !defined $colour;
+ $tmp .= "$graphs|" if defined $colour;
+ }
+ }
+ $tmp .= "]";
+ return $percent."% ".$tmp;
+ }
+ return $percent."%";
+}
+
+sub uptime{
+ my $uptimeinfo = `uptime`;
+ if ($uptimeinfo =~ /^\s+(\d+:\d+\w+|\d+:\d+:\d+)\s+up\s+(\d+)\s+day.?\W\s+(\d+):(\d+)\W\s+(\d+)\s+\w+\W\s+\w+\s+\w+\W\s+(\d+).(\d+)/igx) {
+ return("$2 days, $3 hours, $4 minutes", $5, "$6.$7");
+ }elsif ($uptimeinfo =~ /^\s+(\d+:\d+\w+|\d+:\d+:\d+)\s+up+\s+(\d+):(\d+)\W\s+(\d+)\s+\w+\W\s+\w+\s+\w+\W\s+(\d+).(\d+)/igx) {
+ return("$2 hours, $3 minutes", $4, "$5.$6");
+ }elsif ($uptimeinfo =~ /^\s+(\d+:\d+\w+|\d+:\d+:\d+)\s+up\s+(\d+)\s+day.?\W\s+(\d+)\s+min\W\s+(\d+)\s+\w+\W\s+\w+\s+\w+\W\s+(\d+).(\d+)/igx) {
+ return("$2 days, $3 minutes", $4, "$5.$6");
+ }elsif ($uptimeinfo =~ /^\s+(\d+:\d+\w+|\d+:\d+:\d+)\s+up+\s+(\d+)\s+min\W\s+(\d+)\s+\w+\W\s+\w+\s+\w+\W\s+(\d+).(\d+)/igx) {
+ return("$2 minutes", $3, "$4.$5");
+ }
+ return undef;
+}
+
+sub meminfo{
+ my($memsize,$memfree);
+ open(MEMINFO, "<", "/proc/meminfo") or return undef;
+ while(<MEMINFO>){
+ chomp;
+ if(/^MemTotal:\s+(\d+)/){
+ $memsize = sprintf("%.2f",$1/1024);
+ }elsif(/^MemFree:\s+(\d+)/){
+ $memfree = sprintf("%.2f",$1/1024);
+ }
+ }
+ close(MEMINFO);
+ return($memsize,$memfree);
+}
+
+sub swapinfo{
+ my($swapsize,$swapused);
+ open(SWAPINFO, "<", "/proc/swaps");
+ while(<SWAPINFO>){
+ chomp;
+ next if !/^\//;
+ /\S+\s+\S+\s+(\S+)\s+(\S+)/;
+ $swapsize += $1;
+ $swapused += $2;
+ }
+ close(SWAPINFO);
+ my $swapfree = sprintf("%.2f",($swapsize - $swapused) / 1024);
+ $swapsize = sprintf("%.2f", $swapsize / 1024);
+ return($swapsize,$swapfree);
+}
+
+sub netinfo{
+ my(%netinfo);
+ open(NETINFO, "<", "/proc/net/dev") or return undef;
+ while(<NETINFO>){
+ chomp;
+ next if /^(\s+)?(Inter|face|lo)/;
+ /^\s*(\w+):\s*(\d+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+(\d+)\s+/;
+ $netinfo{$1}{in} = sprintf("%.2f",$2 / 1048576);
+ $netinfo{$1}{out} = sprintf("%.2f",$3 / 1048576);
+ }
+ close(NETINFO);
+ return %netinfo;
+}
+
+sub distro{
+ my $distro;
+ if(-f "/etc/coas"){
+ $distro = firstline("/etc/coas");
+ }elsif(-f "/etc/environment.corel"){
+ $distro = firstline("/etc/environment.corel");
+ }elsif(-f "/etc/debian_version"){
+ $distro = "Debian ".firstline("/etc/debian_version");
+ }elsif(-f "/etc/mandrake-release"){
+ $distro = firstline("/etc/mandrake-release");
+ }elsif(-f "/etc/SuSE-release"){
+ $distro = firstline("/etc/SuSE-release");
+ }elsif(-f "/etc/turbolinux-release"){
+ $distro = firstline("/etc/turbolinux-release");
+ }elsif(-f "/etc/slackware-release"){
+ $distro = firstline("/etc/slackware-release");
+ }elsif(-f "/etc/redhat-release"){
+ $distro = firstline("/etc/redhat-release");
+ }
+ return $distro;
+}
+
+sub df{
+ my($disktotal,$diskused,$mainhd);
+ for(`df`){
+ chomp;
+ next if !/^\/dev\/\S+/;
+ next if /(cd|cdrom|fd|floppy)/;
+ /^(\S+)\s+(\S+)\s+(\S+)/;
+ $mainhd = $1 if !defined $mainhd;
+ next if not defined $1 or not defined $2;
+ $disktotal += $2;
+ $diskused += $3;
+ }
+ $disktotal = sprintf("%.2f",$disktotal / 1024);
+ $diskused = sprintf("%.2f",$diskused / 1024);
+
+ $mainhd =~ s/\/dev\/([a-z]+)\d+/$1/;
+ my $hddtype = firstline("/proc/ide/$mainhd/model");
+
+ return($disktotal,$diskused,$hddtype);
+}
+
+sub basicinfo{
+ my($hostname,$sysinfo,$procs);
+ chomp($hostname = `hostname`);
+ chomp($sysinfo = `uname -sr`);
+ opendir(PROC, "/proc");
+ $procs = scalar grep(/^\d/,readdir PROC);
+ return($hostname,$sysinfo,$procs);
+}
+
+sub cpuinfo{
+ my($cpumodel,$cpusmp,$cpumhz,$cpucache,$bogomips);
+ open(CPUINFO, "<", "/proc/cpuinfo") or return undef;
+ while(<CPUINFO>){
+ if(/^model name\s+\:\s+(.*?)$/){
+ if(defined $cpumodel){
+ if(defined $cpusmp){
+ $cpusmp++;
+ }else{
+ $cpusmp=2;
+ }
+ }else{
+ $cpumodel = $1;
+ }
+ }elsif(/^cpu MHz\s+:\s+([\d\.]*)/){
+ $cpumhz = $1;
+ }elsif(/^cache size\s+:\s+(.*)/){
+ $cpucache = $1;
+ }elsif(/^bogomips\s+:\s+([\d\.]*)/){
+ $bogomips += $1;
+ }
+ }
+ $cpumodel .= " SMP ($cpusmp processors)" if defined $cpusmp;
+ return($cpumodel,$cpumhz,$cpucache,$bogomips);
+}
+
+sub pciinfo{
+ my($videocard,$ethernet);
+ open(PCI, "-|", "/sbin/lspci") or return undef;
+ while(<PCI>){
+ chomp;
+ if(/VGA compatible controller: (.*?)$/){
+ $videocard .= "${1}+ ";
+ }elsif(/(Ethernet|Network) controller: (.*?)$/){
+ $ethernet = $1;
+ }
+ }
+ close(PCI);
+ $videocard =~ s/\+ $//;
+ return($videocard,$ethernet);
+}
+
+sub screenres{
+ my ($res,$depth);
+ for(`xdpyinfo`){
+ if(/\s+dimensions:\s+(\S+)/){
+ $res = $1;
+ }elsif(/\s+depth:\s+(\S+)/){
+ $depth = $1;
+ }
+ }
+ return($res,$depth);
+}
+
+sub firstline{
+ my $file = shift;
+ open(FILE, "<", $file) or return undef;
+ chomp(my $line = <FILE>);
+ close(FILE);
+ return $line;
+}
+
diff --git a/scripts/sysinfoplus.pl b/scripts/sysinfoplus.pl
new file mode 100644
index 0000000..fc0cff0
--- /dev/null
+++ b/scripts/sysinfoplus.pl
@@ -0,0 +1,107 @@
+
+# Those <censored> mIRC'ers have all those irritating system info "remotes" to
+# brag about their system.
+# Now, it's up to Irssi users to brag about their pentium 75's and 2 Gio harddisks.
+# :)
+
+# Differences to Juerd-only-version:
+# -YASFU units (Mio, Gio) - http://snull.cjb.net/?yasfu
+# -Free memory and free swap are displayed (previously only total swap/mem)
+# -Reorganized and tuned output
+# -Displays length of your virtual penis (this is quite tricky, so you might want to disable it by commenting)
+# -Doesn't display info on nfs/smbfs/none-type mounts (edit script if you want those)
+
+# Vpenis is not 100% compatible with Cras' vpenis.sh - I have fixed some bugs:
+# -More network filesystems excluded (originally only NFS was excluded)
+# -Total amount of memory counts (not the used amount, as before)
+
+# Changelog 2.10 -> 2.20: memory/swap info is displayed now (it was broken previously) and code is properly indented
+use strict;
+use vars qw/$VERSION %IRSSI/;
+
+$VERSION = "2.21";
+%IRSSI = (
+ authors => "Juerd, Tronic",
+ contact => "trn\@iki.fi",
+ name => "SysinfoPlus",
+ description => "Linux system information (with vPenis and other stuff)",
+ license => "Public Domain",
+ url => "http://juerd.nl/irssi/",
+ changed => "2017-04-02"
+ );
+
+BEGIN{
+ use vars '$console';
+ eval q{
+ use Irssi;
+ Irssi::version();
+ };
+ $console = !!$@;
+}
+
+
+# Tronic has no time for maintaining this and Juerd hates braces, so it might be better
+# not to expect any new versions ...
+
+sub sysinfo{
+ # This should really need indenting, but I'm kinda lazy.
+
+ my (@uname, $ret, @pci, $usr, $avg, $up, $vpenis);
+
+ @uname = (split ' ', `uname -a`)[0..2];
+
+ $ret = "Host '@uname[1]', running @uname[0] @uname[2] - ";
+
+ open FOO,'<', '/proc/cpuinfo';
+ while (<FOO>){
+ /^processor\s*:\s*(\d+)/ ? $ret .= "Cpu$1: "
+ : /^model name\s*:\s*(\w+[ A-Za-z]*)/ ? do { my $t = $1; $t =~ s/\s+$//; $ret .= "$t " }
+ : /^cpu MHz\s*:\s*([\.\d]+)/ ? $ret .= int(.5+$1) . ' MHz '
+ : undef;
+ }
+ close FOO;
+ $ret =~ s/( ?)$/;$1/;
+ open FOO,'<', '/proc/pci';
+ while (<FOO>){
+ /^\s*(?:multimedia )?(.*?)( storage| compatible)? controller/i and push @pci, $1;
+ }
+ close FOO;
+ $ret .= 'PCI: ' . join(',', map ucfirst, @pci) . '; ' if @pci;
+ if (`uptime` =~ /^.*?up\s*(.*?),\s*(\d+) users?,.*: ([\d\.]+)/){
+ ($usr, $avg) = ($2, $3);
+ ($up = $1) =~ s/\s*days?,\s*|\+/d+/;
+ $ret .= "Up: $up; Users: $usr; Load: $avg; ";
+ }
+
+ # Free space
+ $ret .= "Free:";
+ if (`free` =~ /Mem:\s*(\d*)\s*\d*\s*(\d*)/) { $ret .= " [Mem: " . int(.5 + $2/2**10) . "/" . int(.5 + $1/2**10) . " Mio]"; } # For compatibility: replace $1 with $2
+ if (`free` =~ /Swap:\s*(\d*)\s*\d*\s*(\d*)/) { $ret .= " [Swap: " . int(.5 + $2/2**10) . "/" . int(.5 + $1/2**10) . " Mio]"; } # For compatibility: replace $1 with $2
+
+ for (`df -m -x nfs -x smbfs -x none`) {
+ /^\/\S*\s*(\S*)\s*\S*\s*(\S*)\s*\S*\s*(\S*)/ and $ret .= " [$3: $2/$1 Mio]";
+ }
+ $ret .= ";";
+
+ # Vpenis (derived from vpenis.sh)
+ $vpenis = 70;
+ if (`cat /proc/uptime` =~ /(\d*)/) { $vpenis += int($1/3600/24)/10; }
+ if (`cat /proc/cpuinfo` =~ /MHz\s*:\s*(\S*)/) { $vpenis += $1/30; }
+ if (`free` =~ /Mem:\s*(\d*)\s*(\d*)/) { $vpenis += $1/1024/3; } # For compatibility: replace $1 with $2
+ for (`df -P -k -x nfs -x smbfs -x none|grep -v blocks`) { # For compatibility: remove -x smbfs -x none
+ if (/^\S*\s*(\S*)/) { $usr = $1; $vpenis += ((/^\/dev\/(scsi|sd)/) ? 2*$usr : $usr)/1024/50/15; }
+ }
+ $ret .= " Vpenis: " . int($vpenis)/10 . " cm;";
+
+ if ($console){
+ print "$ret\n";
+ }else{
+ Irssi::active_win->command("/say $ret");
+ }
+} #end of sub
+
+if ($console){
+ sysinfo();
+}else{
+ Irssi::command_bind('sysinfo', 'sysinfo')
+}
diff --git a/scripts/tab_stop.pl b/scripts/tab_stop.pl
new file mode 100644
index 0000000..2a3ba12
--- /dev/null
+++ b/scripts/tab_stop.pl
@@ -0,0 +1,61 @@
+# Created by Stefan "tommie" Tomanek [stefan@kann-nix.org]
+# to free the world from the evil inverted I
+#
+# 23.02.2002
+# *First release
+#
+# 01.03.200?
+# *Changed to GPL
+#
+# 24.05.2011
+# * Buggered about with by shabble.
+#
+# 19.01.2022
+# * Added tabstop_interval support
+
+use strict;
+use warnings;
+
+use Irssi;
+
+our $VERSION = "2022011900";
+our %IRSSI = (
+ authors => "Stefan 'tommie' Tomanek, shabble",
+ contact => "stefan\@pico.ruhr.de, shabble@#irssi/Freenode",
+ name => "tab_stop",
+ description => 'Replaces \t TAB characters to line up with tab stops '
+ . '(default 8) or to contents of /set tabstop_replacement '
+ . 'if tabstop_interval is set to 0',
+ license => "GPLv2",
+ changed => "$VERSION",
+ );
+
+my $not_tab;
+my $interval;
+
+sub sig_gui_print_text {
+ return unless $_[4] =~ /\t/;
+ if ($interval) {
+ while ($_[4] =~ s{^(.*?)\t}{ sprintf("%s%s", $1, " " x ($interval - length($1) % $interval)) }e) {
+ }
+ } else {
+ $_[4] =~ s/\t/$not_tab/g;
+ }
+ Irssi::signal_continue(@_);
+}
+
+# create an expando $TAB which produces real tabs
+Irssi::expando_create('TAB', sub { "\t" }, { 'gui exit' => 'never' });
+
+# then rewrite them just before they're printed.
+Irssi::signal_add_first('gui print text', \&sig_gui_print_text);
+Irssi::signal_add('setup changed', \&sig_setup_changed);
+Irssi::settings_add_str('misc', 'tabstop_replacement', " ");
+Irssi::settings_add_int('misc', 'tabstop_interval', 8);
+
+sub sig_setup_changed {
+ $not_tab = Irssi::settings_get_str('tabstop_replacement');
+ $interval = Irssi::settings_get_int('tabstop_interval');
+}
+
+sig_setup_changed();
diff --git a/scripts/talk.pl b/scripts/talk.pl
new file mode 100644
index 0000000..4cafc2b
--- /dev/null
+++ b/scripts/talk.pl
@@ -0,0 +1,274 @@
+# -*- CPerl -*-
+# $Id$
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+$VERSION = '1.02';
+%IRSSI = (
+ authors => 'Alexander Mieland',
+ contact => 'dma147\@mieland-programming.de',
+ name => 'Talk',
+ description => 'This script talks to you *g*. It reads the chat-msgs for you.',
+ license => 'GPL2',
+);
+
+##########################################################################
+# view settings with /set Talk
+#
+# your preferred language
+my $language = "en"; # (en|de)
+#
+# should I say all of the joins, parts and quits?
+my $sayjpq = 0; # (1|0)
+#
+# should I say all of the nickchanges?
+my $saynickchg = 0; # (1|0)
+#
+##########################################################################
+
+
+Irssi::theme_register(
+[
+ 'talk_loaded',
+ '{line_start}{hilight Talk:} $0',
+]);
+
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'talk_loaded', "Version $VERSION loaded. Type /talk_help, if you have any questions or problems.");
+
+sub cmd_talk_help
+ {
+ my $help = "
+[talk.pl]
+
+This script is a text2speech engine for your irssi. It reads the msgs from
+your irssi client and speaks them through your soundcard.
+
+It is highly recommended, that you\'ve set up your txt2speech in linux with
+a tutorial, which provides a little bash-script, called \'say\', which must
+be able to be useed in a pipe.
+
+Because this irssi-script makes use of the bash-script /usr/(local/)bin/say
+and it uses it in a pipe.
+Otherwise this irssi-script will *not* work.
+
+For german people, I would prefer:
+http://www.linux-magazin.de/Artikel/ausgabe/2000/05/Sprachsynthese/sprachsynthese.html
+
+==========================================================================
+
+Commands:
+
+/talk [message] : Speaks the given message through your soundcard
+/talk_about : Licence and Information about this script
+/talk_help : This helptext
+";
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ }
+
+sub cmd_talk_about
+ {
+ my $about = "
+[talk.pl]
+
+This script is a text2speech engine for your irssi. It reads the msgs from
+your irssi client and speaks them through your soundcard.
+
+For information how to use, type /talk_help
+
+This script is written and copyrighted 2004 by Alexander Mieland
+Contact: dma147 in #gentoo.de @ irc.freenode.net
+This script is licenced under the terms of GNU - General Public Licence
+Version 2.
+";
+ Irssi::print($about, MSGLEVEL_CLIENTCRAP);
+ }
+
+sub RepCrap
+ {
+ my $string = lc(shift) || return;
+ $string =~ s/['#\`]//g;
+ $string =~ s/ä/ae/g;
+ $string =~ s/ö/oe/g;
+ $string =~ s/ü/ue/g;
+ $string =~ s/ß/ss/g;
+ if ($language eq "de")
+ {
+ $string =~ s/([ ]+[0-9]*)mbit/\1megabit/g;
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*kbit/\1kilobit/g;
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*bit/\1bit/g;
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*mbyte/\1megabeit/g;
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*kbyte/\1megabeit/g;
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*byte/\1beit/g;
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*mb/\1megabeit/g;
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*kb/\1kilobeit/g;
+ $string =~ s/\"/anfuehrungszeichen/g;
+ $string =~ s/_/unterstrich/g;
+ $string =~ s/;\)/zwinkernder smeili/g;
+ $string =~ s/;-\)/zwinkernder smeili/g;
+ $string =~ s/:\)/smeili/g;
+ $string =~ s/:-\)/smeili/g;
+ $string =~ s/:\(/trauriger smeili/g;
+ $string =~ s/:-\(/trauriger smeili/g;
+ $string =~ s/\*g\*/grins/g;
+ $string =~ s/\*gg\*/grins grins/g;
+ $string =~ s/\*fg\*/freches grinsen/g;
+ $string =~ s/\*ffg\*/sehr freches grinsen/g;
+ $string =~ s/afaik/so weit ich weiss/g;
+ $string =~ s/imho/meiner meinung nach/g;
+ $string =~ s/([^ ]+)\.([^ ]+)/\1punkt\2/g;
+ }
+ else
+ {
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*mbit/\1megabit/g;
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*kbit/\1kilobit/g;
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*mbyte/\1megabyte/g;
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*kbyte/\1megabyte/g;
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*mb/\1megabyte/g;
+ $string =~ s/([ ]+[0-9,\.]*)[ ]*kb/\1kilobyte/g;
+ $string =~ s/\"/quote/g;
+ $string =~ s/_/underscore/g;
+ $string =~ s/;\)/winking smilie/g;
+ $string =~ s/;-\)/winking smilie/g;
+ $string =~ s/:\)/smilie/g;
+ $string =~ s/:-\)/smilie/g;
+ $string =~ s/:\(/sad smilie/g;
+ $string =~ s/:-\(/sad smilie/g;
+ $string =~ s/\*g\*/grin/g;
+ $string =~ s/\*gg\*/grin grin/g;
+ $string =~ s/\*fg\*/sassy grin/g;
+ $string =~ s/\*ffg\*/very sassy grin/g;
+ $string =~ s/afaik/as far as i know/g;
+ $string =~ s/imho/in my humble opinion/g;
+ $string =~ s/([^ ]+)\.([^ ]+)/\1point\2/g;
+ }
+ $string =~ s/;/semicolon/g;
+ $string =~ s/-/minus/g;
+ $string =~ s/\+/plus/g;
+ return($string);
+ }
+
+sub Say
+ {
+ my $text = lc(shift) || return;
+ $text = " ".$text." ";
+ $text = RepCrap($text);
+ system("bash -c \"echo \\\"$text\\\" | say\" &");
+ }
+
+sub on_privmsg
+ {
+ my ($server, $data, $nick, $hostmask) = @_;
+ my ($channel, $text) = split(/ :/, $data, 2);
+ if ($language eq "de")
+ { Say("$nick sagt: $text"); }
+ else
+ { Say("$nick says: $text"); }
+ return 0;
+ }
+
+sub on_join
+ {
+ my ($server, $channel, $nick, $hostmask) = @_;
+ if ($language eq "de")
+ { Say("$nick hat den Channel $channel betreten."); }
+ else
+ { Say("$nick has entered the channel $channel."); }
+ return 0;
+ }
+
+sub on_quit
+ {
+ my ($server, $data, $nick, $hostmask) = @_;
+ my ($channel, $text) = split(/ :/, $data, 2);
+ if ($language eq "de")
+ { Say("$nick hat den Server verlassen."); }
+ else
+ { Say("$nick has left the server."); }
+ return 0;
+ }
+
+sub on_part
+ {
+ my ($server, $data, $nick, $hostmask) = @_;
+ my ($channel, $text) = split(/ :/, $data, 2);
+ if ($language eq "de")
+ { Say("$nick hat den Channel $channel verlassen."); }
+ else
+ { Say("$nick has left the channel $channel."); }
+ return 0;
+ }
+
+sub on_nick
+ {
+ my ($server, $newnick, $nick, $hostmask) = @_;
+ if ($language eq "de")
+ { Say("$nick heisst nun $newnick"); }
+ else
+ { Say("$nick is now known as $newnick"); }
+ return 0;
+ }
+
+sub cmd_say
+ {
+ Say(@_);
+ return 0;
+ }
+
+sub sig_setup_changed {
+ my $l=Irssi::settings_get_str($IRSSI{name}.'_language');
+ if (!($l eq 'en' || $l eq 'de')) {
+ $l= 'en';
+ Irssi::settings_set_str($IRSSI{name}.'_language', $l);
+ }
+ $language=$l;
+ my $j=Irssi::settings_get_bool($IRSSI{name}.'_sayjpq');
+ if ($sayjpq != $j) {
+ if ($j) {
+ Irssi::signal_add("event join", 'on_join');
+ Irssi::signal_add("event quit", 'on_quit');
+ Irssi::signal_add("event part", 'on_part');
+ } else {
+ Irssi::signal_remove("event join", 'on_join');
+ Irssi::signal_remove("event quit", 'on_quit');
+ Irssi::signal_remove("event part", 'on_part');
+ }
+ $sayjpq = $j;
+ }
+ my $n=Irssi::settings_get_bool($IRSSI{name}.'_saynickchg');
+ if ($saynickchg != $n) {
+ if ($n) {
+ Irssi::signal_add("event nick", 'on_nick');
+ } else {
+ Irssi::signal_remove("event nick", 'on_nick');
+ }
+ $saynickchg= $n;
+ }
+}
+
+sub cmd_help {
+ my ($args, $server, $witem)=@_;
+ $args =~ s/\s+//g;
+ if ($args eq 'talk' || $args eq 'talk_help') {
+ cmd_talk_help();
+ Irssi::signal_stop;
+ }
+ if ($args eq 'talk_about') {
+ cmd_talk_about();
+ Irssi::signal_stop;
+ }
+}
+
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_language', 'en');
+Irssi::settings_add_bool($IRSSI{name}, $IRSSI{name}.'_sayjpq', 0);
+Irssi::settings_add_bool($IRSSI{name}, $IRSSI{name}.'_saynickchg', 0);
+
+Irssi::command_bind('talk', 'cmd_say', 'talk.pl');
+Irssi::command_bind('talk_about', 'cmd_talk_about', 'talk.pl');
+Irssi::command_bind('talk_help', 'cmd_talk_help', 'talk.pl');
+Irssi::command_bind('help', 'cmd_help');
+
+Irssi::signal_add("event privmsg", 'on_privmsg');
+Irssi::signal_add('setup changed',\&sig_setup_changed);
+
+sig_setup_changed();
+#end
diff --git a/scripts/target.pl b/scripts/target.pl
new file mode 100644
index 0000000..b049cb9
--- /dev/null
+++ b/scripts/target.pl
@@ -0,0 +1,163 @@
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "2003020801";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "Target",
+ description => "advances IRC warfare to the next level ;)",
+ license => "GPLv2",
+ url => "http://scripts.irssi.org",
+ sbitems => 'target',
+ changed => "$VERSION",
+ commands => "target"
+);
+
+use Irssi 20020324;
+use Irssi::TextUI;
+use vars qw(%target);
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ } $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub show_help() {
+ my $help=$IRSSI{name}." ".$VERSION."
+/target lock <nick>
+ Target <nick> for current channel
+/target unlock
+ Unlock current target
+/target kick [reason]
+ Kick the locked target
+/target ban [reason]
+ Knockout the selected target
+";
+ my $text = '';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP draw_box($IRSSI{name}." help", $text, "help", 1) ;
+}
+
+
+sub lock_target ($$$) {
+ my ($server, $channel, $nick) = @_;
+ my $witem = $server->window_find_item($channel);
+ $witem->print("%R>>%n Target acquired: +>".$nick."<+", MSGLEVEL_CLIENTCRAP) if (ref $witem && not $target{$server->{tag}}{$channel} eq $nick);
+ $target{$server->{tag}}{$channel} = $nick;
+ Irssi::statusbar_items_redraw('target');
+}
+
+sub unlock_target ($$) {
+ my ($server, $channel) = @_;
+ delete $target{$server->{tag}}{$channel};
+ delete $target{$server->{tag}} unless (keys %{ $target{$server->{tag}} });
+ Irssi::statusbar_items_redraw('target');
+}
+
+sub kick_target ($$$$) {
+ my ($server, $witem, $ban, $reason) = @_;
+ my $nick = $target{$server->{tag}}{$witem->{name}};
+ return unless $nick;
+ #my $reason = 'Target destroyed';
+ my $cmd = 'kick '.$nick.' '.$reason;
+ if ($ban) {
+ $cmd = 'kn '.$nick.' '.$reason;
+ }
+ $witem->command($cmd);
+}
+
+sub sb_target ($$) {
+ my ($item, $get_size_only) = @_;
+ my $line = '';
+ my $witem = Irssi::active_win()->{active};
+ if (ref $witem && $witem->{type} eq 'CHANNEL') {
+ my $tag = $witem->{server}->{tag};
+ if ($target{$tag}{$witem->{name}}) {
+ $line .= '+>';
+ if ($witem->nick_find($target{$tag}{$witem->{name}})) {
+ $line .= '%R';
+ } else {
+ $line .= '%y';
+ }
+ $line .= $target{$tag}{$witem->{name}};
+ $line .= '%n';
+ $line .= '<+';
+ }
+ }
+ my $format = "{sb ".$line."}";
+ $item->{min_size} = $item->{max_size} = length($line);
+ $item->default_handler($get_size_only, $format, 0, 1);
+}
+
+sub sig_message_kick ($$$$$$) {
+ my ($server, $channel, $nick, $kicker, $address, $reason) = @_;
+ if (Irssi::settings_get_bool('target_lock_only_on_own_kicks')) {
+ return unless ($kicker eq $server->{nick});
+ }
+ lock_target($server, $channel, $nick);
+ Irssi::statusbar_items_redraw('target');
+}
+
+sub cmd_target ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @arg = split(/ +/, $args);
+ if (@arg == 0) {
+ # list targets
+ show_help();
+ } elsif ($arg[0] eq 'lock') {
+ return unless $server;
+ return unless ref $witem;
+ return unless $witem->{type} eq 'CHANNEL';
+ return unless defined $arg[1];
+ lock_target($server, $witem->{name}, $arg[1]);
+ } elsif ($arg[0] eq 'unlock') {
+ return unless $server;
+ return unless ref $witem;
+ return unless $witem->{type} eq 'CHANNEL';
+ unlock_target($server, $witem->{name});
+ } elsif ($arg[0] eq 'kick') {
+ shift @arg;
+ return unless $server;
+ return unless ref $witem;
+ return unless $witem->{type} eq 'CHANNEL';
+ my $reason = @arg ? join(" ", @arg) : 'Target destroyed';;
+ kick_target($server, $witem, 0, $reason);
+ } elsif ($arg[0] eq 'ban') {
+ shift @arg;
+ return unless $server;
+ return unless ref $witem;
+ return unless $witem->{type} eq 'CHANNEL';
+ my $reason = @arg ? join(" ", @arg) : 'Target destroyed';;
+ kick_target($server, $witem, 1, $reason);
+ } elsif ($arg[0] eq 'help') {
+ show_help();
+ }
+}
+
+
+Irssi::signal_add('message join', sub { Irssi::statusbar_items_redraw('target'); });
+Irssi::signal_add('message part', sub { Irssi::statusbar_items_redraw('target'); });
+Irssi::signal_add('window item changed', sub { Irssi::statusbar_items_redraw('target'); });
+Irssi::signal_add('window changed', sub { Irssi::statusbar_items_redraw('target'); });
+Irssi::signal_add('message kick', \&sig_message_kick);
+Irssi::statusbar_item_register('target', 0, 'sb_target');
+
+Irssi::settings_add_bool($IRSSI{name}, 'target_lock_only_on_own_kicks', 0);
+
+Irssi::command_bind('target', \&cmd_target);
+foreach my $cmd ('lock', 'unlock', 'kick', 'ban', 'help') {
+ Irssi::command_bind('target '.$cmd => sub {
+ cmd_openurl("$cmd ".$_[0], $_[1], $_[2]); });
+}
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /target help for help';
diff --git a/scripts/thankop.pl b/scripts/thankop.pl
new file mode 100644
index 0000000..023b041
--- /dev/null
+++ b/scripts/thankop.pl
@@ -0,0 +1,134 @@
+use Irssi 0.8.10 ();
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION="0.1.7";
+%IRSSI = (
+ authors=> 'BC-bd',
+ contact=> 'bd@bc-bd.org',
+ name=> 'thankop',
+ description=> 'Remembers the last person oping you on a channel',
+ license=> 'GPL v2',
+ url=> 'https://bc-bd.org/svn/repos/irssi/trunk/',
+);
+
+# $Id #
+#
+#########
+# USAGE
+###
+#
+# Type '/thankop' in a channel window to thank the person opping you
+#
+##########
+# OPTIONS
+####
+#
+# /set thankop_command [command]
+# * command : to be executed. The following $'s are expanded
+# $N : Nick (some dude)
+#
+# eg:
+#
+# /set thankop_command say $N: w00t!
+#
+# Would say
+#
+# <nick>: w00t!
+#
+# To the channel you got op in, with <nick> beeing the nick who
+# opped you
+#
+################
+###
+# Changelog
+#
+# Version 0.1.7
+# - fix crash if used in a window != CHANNEL
+# - do not thank someone who has already left
+#
+# Version 0.1.6
+# - added support for multiple networks, thanks to senneth
+# - adapted to signal changes in 0.8.10
+#
+# Version 0.1.5
+# - change back to setting instead of theme item
+#
+# Version 0.1.4
+# - added theme item to customize the message (idea from mordeth)
+#
+# Version 0.1.3
+# - removed '/' from the ->command (thx to mordeth)
+# - removed debug messages (where commented out)
+#
+# Version 0.1.2
+# - added version dependency, since some 0.8.4 users complained about a not
+# working script
+#
+# Version 0.1.1
+# - unsetting of hash values is done with delete not unset.
+#
+# Version 0.1.0
+# - initial release
+#
+###
+################
+
+my %op;
+
+sub cmd_thankop {
+ my ($data, $server, $witem) = @_;
+
+ if (!$witem || ($witem->{type} =! "CHANNEL")) {
+ Irssi::print("thankop: Window not of type CHANNEL");
+ return;
+ }
+
+ my $tag = $witem->{server}->{tag}.'/'.$witem->{name};
+
+ # did we record who opped us here
+ if (!exists($op{$tag})) {
+ $witem->print("thankop: I don't know who op'ed you in here");
+ return;
+ }
+
+ my $by = $op{$tag};
+
+ # still here?
+ if (!$witem->nick_find($by)) {
+ $witem->print("thankop: $by already left");
+ return;
+ }
+
+ my $cmd = Irssi::settings_get_str('thankop_command');
+
+ $cmd =~ s/\$N/$by/;
+ $witem->command($cmd);
+}
+
+sub mode_changed {
+ my ($channel, $nick, $by, undef, undef) = @_;
+
+ return if ($channel->{server}->{nick} ne $nick->{nick});
+
+ # since 0.8.10 this is set after signals have been processed
+ return if ($channel->{chanop});
+
+ my $tag = $channel->{server}->{tag}.'/'.$channel->{name};
+
+ $op{$tag} = $by;
+}
+
+sub channel_destroyed {
+ my ($channel) = @_;
+
+ my $tag = $channel->{server}->{tag}.'/'.$channel->{name};
+
+ delete($op{$tag});
+}
+
+Irssi::command_bind('thankop','cmd_thankop');
+Irssi::signal_add_last('nick mode changed', 'mode_changed');
+
+Irssi::settings_add_str('thankop', 'thankop_command', 'say $N: opthx');
diff --git a/scripts/theme.pl b/scripts/theme.pl
new file mode 100644
index 0000000..7d649b7
--- /dev/null
+++ b/scripts/theme.pl
@@ -0,0 +1,451 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use POSIX;
+use File::Basename;
+use File::Fetch;
+use File::Glob ':bsd_glob';
+use Getopt::Long qw/GetOptionsFromString/;
+use Storable qw/store_fd fd_retrieve/;
+use YAML::XS;
+
+use Irssi;
+
+$VERSION = '0.04';
+%IRSSI = (
+ authors => 'bw1',
+ contact => 'bw1@aol.at',
+ name => 'theme',
+ description => 'activate, show or get theme',
+ license => 'Public Domain',
+ url => 'https://scripts.irssi.org/',
+ changed => '2020-04-12',
+ modules => 'POSIX File::Basename File::Fetch File::Glob Getopt::Long Storable YAML::XS',
+ commands=> 'theme',
+);
+
+my $help = << "END";
+%9Name%9
+ $IRSSI{name}
+%9Version%9
+ $VERSION
+%9Synopsis%9
+ /theme {-g|-get} <theme>
+ /theme [theme] [options]
+%9Options%9
+ -next|-n next theme in dir
+ -previous|-p previous theme in dir
+ -show|-s show a test text
+ -reload|-r reload the dir
+ -get|-g get a theme form a website
+ -list|-l list theme in dir
+ -update|-u download themes.yaml
+ -info|-i print info
+ -fg_color|-f set or reset the foreground color
+ -bg_color|-b set or reset the background color
+ -help|-h
+%9Description%9
+ $IRSSI{description}
+%9Settings%9
+ /set theme_source https://irssi-import.github.io/themes/
+ /set theme_local ~/.irssi/
+ /set theme_autocolor off
+%9Color%9
+ the script can set
+ VT100 text foreground color
+ VT100 text background color
+ tested with xterm, konsole, lxterm
+%9See also%9
+ https://irssi-import.github.io/themes/
+ https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Operating-System-Commands
+ https://en.wikipedia.org/wiki/X11_color_names
+END
+
+my (%themes, @dtl);
+my (@tl, $count);
+my ($show, $update, $get, $list, $phelp, $info, $yupdate, $fg_color, $bg_color);
+my ($noxterm);
+my %options = (
+ 'n' => sub{ $count++; $update=1},
+ 'next' => sub{ $count++; $update=1},
+ 'p' => sub{ $count--; $update=1},
+ 'previous' => sub{ $count--; $update=1},
+ 's' => \$show,
+ 'show' => \$show,
+ 'r' => \&init,
+ 'reload' => \&init,
+ 'g=s' => \$get,
+ 'get=s' => \$get,
+ 'l' => \$list,
+ 'list' => \$list,
+ 'h' => \$phelp,
+ 'help' => \$phelp,
+ 'u' => \$yupdate,
+ 'update' => \$yupdate,
+ 'i:s' => \$info,
+ 'info:s' => \$info,
+ 'f:s' => \$fg_color,
+ 'fg_color:s' => \$fg_color,
+ 'b:s' => \$bg_color,
+ 'bg_color:s' => \$bg_color,
+);
+
+my $lorem = << 'END';
+Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod
+tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At
+vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd
+gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum
+dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor
+invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero
+eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no
+sea takimata sanctus est Lorem ipsum dolor sit amet.
+END
+
+my ($theme_source, $theme_local, $theme_autocolor);
+my %bg_process= ();
+
+sub background {
+ my ($cmd) =@_;
+ my ($fh_r, $fh_w);
+ pipe $fh_r, $fh_w;
+ my $pid = fork();
+ if ($pid ==0 ) {
+ my @res;
+ @res= &{$cmd->{cmd}}(@{$cmd->{args}});
+ store_fd \@res, $fh_w;
+ close $fh_w;
+ POSIX::_exit(1);
+ } else {
+ $cmd->{fh_r}=$fh_r;
+ Irssi::pidwait_add($pid);
+ $bg_process{$pid}=$cmd;
+ }
+}
+
+sub sig_pidwait {
+ my ($pid, $status) = @_;
+ if (exists $bg_process{$pid}) {
+ my @res= @{ fd_retrieve($bg_process{$pid}->{fh_r})};
+ $bg_process{$pid}->{res}=[@res];
+ if (exists $bg_process{$pid}->{last}) {
+ foreach my $p (@{$bg_process{$pid}->{last}}) {
+ &$p($bg_process{$pid});
+ }
+ } else {
+ Irssi::print(join(" ",@res), MSGLEVEL_CLIENTCRAP);
+ }
+ delete $bg_process{$pid};
+ }
+}
+
+sub cmd_show {
+ my ($args, $server, $witem)=@_;
+ my $t = Irssi::settings_get_str('theme');
+ if (defined $witem) {
+ $witem->print(
+ "----- $t -- $count -----",
+ MSGLEVEL_CLIENTCRAP);
+ $witem->command('names');
+ core_printformat_module_w($witem,
+ MSGLEVEL_CLIENTCRAP, 'fe-common/core', 'pubmsg', 'testnick', $lorem, '@');
+ core_printformat_module_w($witem,
+ MSGLEVEL_CLIENTCRAP, 'fe-common/core', 'pubmsg_me', 'testnick',
+ 'me: '.substr($lorem, 0, 30),'@');
+ core_printformat_module_w($witem,
+ MSGLEVEL_CLIENTCRAP, 'fe-common/core', 'own_msg', 'me',
+ substr($lorem, 0, 30),'@');
+ } else {
+ Irssi::print(
+ "----- $t -- $count -----",
+ MSGLEVEL_CLIENTCRAP);
+ core_printformat_module(
+ MSGLEVEL_CLIENTCRAP, 'fe-common/core', 'pubmsg', 'testnick', $lorem, '@');
+ core_printformat_module(
+ MSGLEVEL_CLIENTCRAP, 'fe-common/core', 'pubmsg_me', 'testnick',
+ 'me: '.substr($lorem, 0, 30),'@');
+ core_printformat_module(
+ MSGLEVEL_CLIENTCRAP, 'fe-common/core', 'own_msg', 'me',
+ substr($lorem, 0, 30),'@');
+ }
+}
+
+sub core_printformat_module {
+ my ($level, $module, $format, @args) = @_;
+ {
+ local *CORE::GLOBAL::caller = sub { $module };
+ Irssi::printformat($level, $format, @args);
+ }
+}
+
+sub core_printformat_module_w {
+ my ($witem, $level, $module, $format, @args) = @_;
+ {
+ local *CORE::GLOBAL::caller = sub { $module };
+ $witem->printformat($level, $format, @args);
+ }
+}
+
+sub set_fg_color {
+ my ($fg) = @_;
+ if ($ENV{'TERM'} =~ m/^xterm/) {
+ if ( defined $fg ) {
+ print STDERR "\033]10;$fg\a";
+ } else {
+ print STDERR "\033]110\a";
+ }
+ } else {
+ $noxterm.=" and " if ($noxterm);
+ $noxterm.="fg_color:$fg";
+ }
+}
+
+sub set_bg_color {
+ my ($bg) = @_;
+ if ($ENV{'TERM'} =~ m/^xterm/) {
+ if ( defined $bg) {
+ print STDERR "\033]11;$bg\a";
+ } else {
+ print STDERR "\033]111\a";
+ }
+ } else {
+ $noxterm.=" and " if ($noxterm);
+ $noxterm.="bg_color:$bg";
+ }
+}
+
+
+sub get_theme {
+ my ($args)=@_;
+ local $File::Fetch::WARN=0;
+ $get.= '.theme' if $get !~ m/\.theme/;
+ my $ff= File::Fetch->new(uri => $theme_source.$get);
+ my $where = $ff->fetch( to => $theme_local ) or
+ return "Error: $theme_source$get not found";
+ return "$get downloaded.";
+}
+
+sub get_yaml {
+ local $File::Fetch::WARN=0;
+ my $get='themes.yaml';
+ if (-e $theme_local.$get) {
+ unlink $theme_local.$get;
+ }
+ my $ff= File::Fetch->new(uri => $theme_source.$get);
+ my $where = $ff->fetch( to => $theme_local ) or
+ return "Error: $theme_source$get not found";
+ return "$get downloaded.";
+}
+
+sub cmd_set {
+ my ($args, $server, $witem)=@_;
+ my $t = $tl[$count];
+ if (defined $t) {
+ Irssi::settings_set_str('theme',$t);
+ Irssi::signal_emit('setup changed');
+ if ($theme_autocolor) {
+ set_fg_color($themes{$t}->{fgColor});
+ set_bg_color($themes{$t}->{bgColor});
+ }
+ }
+}
+
+sub cmd {
+ my ($args, $server, $witem)=@_;
+ my ($ret, $arg) = GetOptionsFromString($args, %options);
+ if ( defined $$arg[0]) {
+ my $c=0;
+ foreach my $t (@tl) {
+ if ($t eq $$arg[0]) {
+ $count=$c;
+ last;
+ }
+ $c++;
+ }
+ cmd_set();
+ }
+ if (defined $update) {
+ if ($count <0) {
+ $count = $#tl+$count+1;
+ }
+ if ($count >$#tl) {
+ $count = $count-$#tl-1;
+ }
+ cmd_set();
+ $update= undef;
+ }
+ if (defined $show) {
+ cmd_show($args, $server, $witem);
+ $show = undef;
+ }
+ if (defined $get) {
+ my $cmd;
+ $cmd->{cmd}=\&get_theme;
+ $cmd->{args}=[$args];
+ $cmd->{last}=[
+ \&init,
+ \&print_result,
+ ];
+ background( $cmd );
+ $get = undef;
+ }
+ if (defined $yupdate) {
+ my $cmd;
+ $cmd->{cmd}=\&get_yaml;
+ $cmd->{last}=[
+ \&init,
+ \&print_result,
+ ];
+ background( $cmd );
+ $yupdate = undef;
+ }
+ if (defined $list) {
+ my $c=0;
+ foreach (@tl) {
+ if ($c == $count) {
+ Irssi::print(">>$_<<", MSGLEVEL_CLIENTCRAP);
+ } else {
+ Irssi::print(" $_", MSGLEVEL_CLIENTCRAP);
+ }
+ $c++;
+ }
+ $list = undef;
+ }
+ if (defined $info) {
+ cmd_info($args, $server, $witem);
+ $info = undef;
+ }
+ if (defined $phelp || $args eq '' ) {
+ cmd_help($IRSSI{name}, $server, $witem);
+ $phelp = undef;
+ }
+ if (defined $fg_color) {
+ if (length($fg_color)>0) {
+ set_fg_color($fg_color);
+ } else {
+ set_fg_color();
+ }
+ $fg_color= undef;
+ }
+ if (defined $bg_color) {
+ if (length($bg_color)>0) {
+ set_bg_color($bg_color);
+ } else {
+ set_bg_color();
+ }
+ $bg_color= undef;
+ }
+ if (defined $noxterm) {
+ Irssi::print(
+ "Do not know how to set colour for your terminal ($ENV{TERM})."
+ , MSGLEVEL_CLIENTCRAP);
+ Irssi::print(
+ "Manually configure it for $noxterm"
+ , MSGLEVEL_CLIENTCRAP);
+ $noxterm= undef;
+ }
+}
+
+sub cmd_info {
+ my ($args, $server, $witem)=@_;
+ Irssi::print("Info: $info", MSGLEVEL_CLIENTCRAP);
+ if (exists $themes{$info}) {
+ Irssi::print(Dump($themes{$info}), MSGLEVEL_CLIENTCRAP);
+ } elsif (exists $themes{$tl[$count]}) {
+ Irssi::print(Dump($themes{$tl[$count]}), MSGLEVEL_CLIENTCRAP);
+ }
+}
+
+sub cmd_help {
+ my ($args, $server, $witem)=@_;
+ $args=~ s/\s+//g;
+ if ($IRSSI{name} eq $args) {
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop();
+ }
+}
+
+sub sig_setup_changed {
+ $theme_source= Irssi::settings_get_str($IRSSI{name}.'_source');
+ $theme_source.= '/' if $theme_source !~ m#/$#;
+ my $l= Irssi::settings_get_str($IRSSI{name}.'_local');
+ $theme_local= bsd_glob $l;
+ $theme_local.= '/' if $theme_local !~ m#/$#;
+ $theme_autocolor= Irssi::settings_get_bool($IRSSI{name}.'_autocolor');
+}
+
+sub print_result {
+ my ($cmd) = @_;
+ if (defined $cmd->{res}->[0]) {
+ Irssi::print($cmd->{res}->[0] , MSGLEVEL_CLIENTCRAP);
+ }
+}
+
+sub do_complete {
+ my ($strings, $window, $word, $linestart, $want_space) = @_;
+ return unless $linestart =~ m#^/$IRSSI{name}#;
+ return if $word =~ m#^-#;
+ if ( $linestart !~ m/(-g|-get|-i|-info)/ ) {
+ @$strings = grep { m/^$word/} @tl;
+ } else {
+ @$strings = grep { m/^$word/} @dtl;
+ }
+ Irssi::signal_stop;
+}
+
+sub init {
+ my $theme = Irssi::settings_get_str('theme');
+ my $p1= Irssi::get_irssi_dir();
+ my @t = bsd_glob $p1.'/*.theme';
+ @tl=();
+ my $c=0;
+ foreach my $fn (@t) {
+ $fn = basename($fn, '.theme');
+ push @tl, $fn;
+ $count=$c if $theme eq $fn;
+ $c++;
+ }
+ $lorem =~ s/\n/ /g;
+ if (-e $p1.'/themes.yaml') {
+ @dtl=undef;
+ my @l;
+ open my $fi, '<',$p1.'/themes.yaml';
+ my $syml= do {local $/; <$fi>};
+ close $fi;
+ eval {
+ @l = @{Load($syml)};
+ };
+ if (length($@) >0) {
+ print $@;
+ } else {
+ foreach my $e (@l) {
+ $themes{$e->{name}}=$e;
+ push @dtl, $e->{name};
+ }
+ }
+ }
+}
+
+Irssi::signal_add_first('complete word', \&do_complete);
+Irssi::signal_add('setup changed', \&sig_setup_changed);
+Irssi::signal_add('pidwait', \&sig_pidwait);
+
+Irssi::settings_add_str($IRSSI{name} ,$IRSSI{name}.'_source', 'https://irssi-import.github.io/themes/');
+Irssi::settings_add_str($IRSSI{name} ,$IRSSI{name}.'_local', Irssi::get_irssi_dir());
+Irssi::settings_add_bool($IRSSI{name} ,$IRSSI{name}.'_autocolor', 0);
+
+Irssi::command_bind($IRSSI{name}, \&cmd);
+my @opt=map {s/[=:].*$//, $_} keys %options;
+Irssi::command_set_options($IRSSI{name}, join(" ", @opt));
+Irssi::command_bind('help', \&cmd_help);
+
+init();
+sig_setup_changed();
+
+if (!(-e $theme_local.'themes.yaml')) {
+ my $cmd;
+ $cmd->{cmd}=\&get_yaml;
+ $cmd->{last}=[
+ \&init,
+ \&print_result,
+ ];
+ background( $cmd );
+}
diff --git a/scripts/thistory.pl b/scripts/thistory.pl
new file mode 100644
index 0000000..47bc85d
--- /dev/null
+++ b/scripts/thistory.pl
@@ -0,0 +1,162 @@
+# thistory.pl v1.05 [10.03.2002]
+# Copyright (C) 2001, 2002 Teemu Hjelt <temex@iki.fi>
+#
+# Written for irssi 0.7.98 and later, idea from JSuvanto.
+#
+# Many thanks to fuchs, shasta, Paladin, Koffa and people
+# on #irssi for their help and suggestions.
+#
+# Keeps information about the most recent topics of the
+# channels you are on.
+# Usage: /thistory [channel] and /tinfo [channel]
+#
+# v1.00 - Initial release.
+# v1.02 - Months and topics with formatting were shown
+# incorrectly. (Found by fuchs and shasta)
+# v1.03 - event_topic was occasionally using the wrong
+# server tag. Also added few variables to ease
+# changing the settings and behaviour of this
+# script.
+# v1.04 - Minor bug-fixes.
+# v1.05 - Made the script more consistent with other
+# Irssi scripts.
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+
+# Formatting character.
+my $fchar = '%';
+
+# Format of the line.
+my $format = '"%topic" %nick (%address) [%mday.%mon.%year %hour:%min:%sec]';
+
+# Amount of topics stored.
+my $tamount = 10;
+
+my %topiclist;
+###### Don't edit below this unless you know what you're doing ######
+
+$VERSION = "1.05";
+%IRSSI = (
+ authors => "Teemu Hjelt",
+ contact => "temex\@iki.fi",
+ name => "topic history",
+ description => "Keeps information about the most recent topics of the channels you are on.",
+ license => "GNU GPLv2 or later",
+ url => "http://www.iki.fi/temex/",
+ changed => "Sun Mar 10 14:53:59 EET 2002",
+);
+
+sub cmd_topicinfo {
+ my ($channel) = @_;
+ my $tag = Irssi::active_server()->{'tag'};
+ $channel =~ s/\s+//;
+ $channel =~ s/\s+$//;
+
+ if ($channel eq "") {
+ if (Irssi::channel_find(Irssi::active_win()->get_active_name())) {
+ $channel = Irssi::active_win()->get_active_name();
+ }
+ }
+ if ($channel ne "") {
+ if ($topiclist{lc($tag)}{lc($channel)}{0}) {
+ Irssi::print("%W$channel%n: " . $topiclist{lc($tag)}{lc($channel)}{0}, MSGLEVEL_CRAP);
+ } else {
+ Irssi::print("No topic information for %W$channel%n", MSGLEVEL_CRAP);
+ }
+ } else {
+ Irssi::print("Usage: /tinfo <channel>");
+ }
+}
+
+sub cmd_topichistory {
+ my ($channel) = @_;
+ my $tag = Irssi::active_server()->{'tag'};
+ $channel =~ s/\s+//;
+ $channel =~ s/\s+$//;
+
+ if ($channel eq "") {
+ if (Irssi::channel_find(Irssi::active_win()->get_active_name())) {
+ $channel = Irssi::active_win()->get_active_name();
+ }
+ }
+ if ($channel ne "") {
+ if ($topiclist{lc($tag)}{lc($channel)}{0}) {
+ my $amount = &getamount($tag, $channel);
+ Irssi::print("Topic history for %W$channel%n:", MSGLEVEL_CRAP);
+ for (my $i = 0; $i < $amount; $i++) {
+ if ($topiclist{lc($tag)}{lc($channel)}{$i}) {
+ my $num = $i + 1;
+ if (length($amount) >= length($tamount) && length($i + 1) < length($tamount)) {
+ for (my $j = length($tamount); $j > length($i + 1); $j--) {
+ $num = " " . $num;
+ }
+ }
+ Irssi::print($num . ". " . $topiclist{lc($tag)}{lc($channel)}{$i}, MSGLEVEL_CRAP);
+ } else {
+ last;
+ }
+ }
+ } else {
+ Irssi::print("No topic history for %W$channel%n", MSGLEVEL_CRAP);
+ }
+ } else {
+ Irssi::print("Usage: /thistory <channel>");
+ }
+}
+
+sub event_topic {
+ my ($server, $data, $nick, $address) = @_;
+ my ($channel, $topic) = split(/ :/, $data, 2);
+ my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
+ my $tag = $server->{'tag'};
+ my $output = $format;
+
+ $topic =~ s/%/%%/g;
+ $topic .= '%n';
+
+ my %val;
+ $val{'sec'} = $sec < 10 ? "0$sec" : $sec;
+ $val{'min'} = $min < 10 ? "0$min" : $min;
+ $val{'hour'} = $hour < 10 ? "0$hour" : $hour;
+ $val{'mday'} = $mday < 10 ? "0$mday" : $mday;
+ $val{'mon'} = $mon + 1 < 10 ? "0" . ($mon + 1) : $mon + 1;
+ $val{'year'} = $year + 1900;
+
+ $val{'nick'} = $nick;
+ $val{'address'} = $address;
+ $val{'channel'} = $channel;
+ $val{'topic'} = $topic;
+ $val{'tag'} = $tag;
+
+ $output =~ s/$fchar(\w+)/$val{$1}/g;
+
+ for (my $i = (&getamount($tag, $channel) - 1); $i >= 0; $i--) {
+ if ($topiclist{lc($tag)}{lc($channel)}{$i}) {
+ $topiclist{lc($tag)}{lc($channel)}{$i + 1} = $topiclist{lc($tag)}{lc($channel)}{$i};
+ }
+ }
+ $topiclist{lc($tag)}{lc($channel)}{0} = $output;
+}
+
+sub getamount {
+ my ($tag, $channel) = @_;
+ my $amount = 0;
+
+ for (my $i = 0; $i < $tamount; $i++) {
+ if ($topiclist{lc($tag)}{lc($channel)}{$i}) {
+ $amount++;
+ }
+ }
+ return $amount;
+}
+
+Irssi::command_bind("topichistory", "cmd_topichistory");
+Irssi::command_bind("thistory", "cmd_topichistory");
+Irssi::command_bind("topicinfo", "cmd_topicinfo");
+Irssi::command_bind("tinfo", "cmd_topicinfo");
+Irssi::signal_add("event topic", "event_topic");
+
+Irssi::print("Loaded thistory.pl v$VERSION");
diff --git a/scripts/tictactoe.pl b/scripts/tictactoe.pl
new file mode 100644
index 0000000..0cee27a
--- /dev/null
+++ b/scripts/tictactoe.pl
@@ -0,0 +1,665 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+use Text::ParseWords;
+
+$VERSION = '0.01';
+%IRSSI = (
+ authors => 'bw1',
+ contact => 'bw1@aol.at',
+ name => 'tictactoe',
+ description => 'tic-tac-toe game',
+ license => 'LGPLv3',
+ url => 'https://scripts.irssi.org/',
+ changed => '2019-06-07',
+ modules => 'Text::ParseWords',
+ commands=> 'tictactoe',
+);
+
+my $help = << "END";
+%9Name%n
+ $IRSSI{name}
+%9Version%n
+ $VERSION
+%9description%n
+ $IRSSI{description}
+
+ start the game:
+ /tictactoe game
+ nick: !game
+ print the board
+ /tictactoe board
+ nick: !board
+ drop a stone
+ /tictactoe b0
+ nick: !b0
+END
+
+my ($server, $nick, $target, $witem, $type);
+
+# 0= free, 1= stone player1, 2= stone player2
+my @board= (
+ [0,1,2],
+ [0,2,0],
+ [0,0,0],
+);
+my $step_counter=3;
+
+# 0= free, 1= i, 2= you, 3=whatever
+my @gray= (
+ # over
+ [[1,1,1],[3,3,3],[3,3,3], 0,0, -1],
+ [[3,3,3],[1,1,1],[3,3,3], 0,0, -1],
+ [[1,3,3],[3,1,3],[3,3,1], 0,0, -1],
+
+ [[2,2,2],[3,3,3],[3,3,3], 0,0, -2],
+ [[3,3,3],[2,2,2],[3,3,3], 0,0, -2],
+ [[2,3,3],[3,2,3],[3,3,2], 0,0, -2],
+ # last
+ [[1,1,0],[3,3,3],[3,3,3], 0,2, 1],
+ [[0,1,1],[3,3,3],[3,3,3], 0,0, 1],
+ [[1,0,1],[3,3,3],[3,3,3], 0,1, 1],
+
+ [[3,3,3],[1,1,0],[3,3,3], 1,2, 1],
+ [[3,3,3],[0,1,1],[3,3,3], 1,0, 1],
+ [[3,3,3],[1,0,1],[3,3,3], 1,1, 1],
+
+ [[1,3,3],[3,1,3],[3,3,0], 2,2, 1],
+ [[1,3,3],[3,0,3],[3,3,1], 1,1, 1],
+ # no 3
+ [[2,2,0],[3,3,3],[3,3,3], 0,2, 0],
+ [[0,2,2],[3,3,3],[3,3,3], 0,0, 0],
+ [[2,0,2],[3,3,3],[3,3,3], 0,1, 0],
+
+ [[3,3,3],[2,2,0],[3,3,3], 1,2, 0],
+ [[3,3,3],[0,2,2],[3,3,3], 1,0, 0],
+ [[3,3,3],[2,0,2],[3,3,3], 1,1, 0],
+
+ [[2,3,3],[3,2,3],[3,3,0], 2,2, 0],
+ [[2,3,3],[3,0,3],[3,3,2], 1,1, 0],
+ #
+ [[2,0,0],[0,2,0],[3,0,1], 0,2, 0],
+ [[2,0,3],[0,2,0],[0,0,1], 2,0, 0],
+ # d3
+ [[2,0,0],[3,3,0],[3,3,2], 0,1, 0],
+ [[2,0,0],[3,2,3],[3,0,3], 0,1, 0],
+ [[2,3,3],[0,2,0],[0,3,3], 1,0, 0],
+ [[0,2,0],[2,3,3],[0,3,3], 0,0, 0],
+ [[0,2,0],[0,3,3],[2,3,3], 0,0, 0],
+ [[0,0,2],[2,3,3],[0,3,3], 0,0, 0],
+ # M
+ [[3,3,3],[3,0,3],[3,3,3], 1,1, 0],
+ # M2
+ [[3,3,3],[3,2,3],[3,3,0], 2,2, 0],
+);
+
+# game state
+# 0 off
+# 10 player[0] turn
+# 20 player[1] turn
+# 30 vs computer
+my $state=0;
+# player
+my @player=();
+
+sub rotate {
+ my ($r) =@_;
+ my @ca;
+ for(my $c=0; $c <3; $c++) {
+ push @ca,$board[$c][0];
+ }
+ push @ca,$board[2][1];
+ for(my $c=2; $c >-1; $c--) {
+ push @ca,$board[$c][2];
+ }
+ push @ca,$board[0][1];
+
+ for(my $c=0; $c <$r*2; $c++) {
+ push @ca, shift(@ca);
+ }
+
+ for(my $c=0; $c <3; $c++) {
+ $board[$c][0]= shift(@ca);
+ }
+ $board[2][1]= shift(@ca);
+ for(my $c=2; $c >-1; $c--) {
+ $board[$c][2]= shift(@ca);
+ }
+ $board[0][1]= shift(@ca);
+}
+
+sub compute {
+ my ($max)= @_;
+ my $res;
+ my $mc=0;
+ foreach my $s (@gray) {
+ for(my $r=0; $r<4; $r++) {
+ my $ok=1;
+ for(my $x=0; $x <3; $x++) {
+ for(my $y=0; $y <3; $y++) {
+ if ($s->[$x][$y] !=3) {
+ if ($s->[$x][$y] != $board[$x][$y]) {
+ $ok=0;
+ last;
+ }
+ }
+ }
+ last if ($ok==0);
+ }
+ if ($ok == 1) {
+ if (!defined $res) {
+ $res =$s->[5];
+ if ($s->[5] >=0) {
+ $board[$s->[3]][$s->[4]]=1;
+ $step_counter++;
+ }
+ }
+ }
+ rotate(1);
+ }
+ last if (defined $res);
+ $mc++;
+ last if (defined($max) && $mc > $max);
+ }
+ return $res;
+}
+
+# step_in('a1',2);
+sub step_in {
+ my ($st,$player) = @_;
+
+ return 1 if (length($st) != 2);
+ my $y = ord(lc(substr($st,0,1))) -97;
+ return 2 if ($y <0 || $y >2);
+ my $x = substr($st,1,1);
+ return 3 if ($x <0 || $x >2);
+ return 4 if ($board[$x][$y] !=0);
+ $board[$x][$y]= $player;
+ $step_counter++;
+ return 0;
+}
+
+sub sc_clear {
+ for(my $x=0; $x <3; $x++) {
+ for(my $y=0; $y <3; $y++) {
+ $board[$x][$y]=0;
+ }
+ }
+ $step_counter=0;
+}
+
+# return state
+# 0 normal step
+# 1 last step by computer
+# -1 computer win
+# -2 computer lost
+# -5 draw
+sub sc_compute {
+ my $st=0;
+ my $max;
+ if ($player[1]->{difficult} eq 'e') {
+ $max=5;
+ }
+ if ($player[1]->{difficult} eq 'n') {
+ $max=5+8;
+ }
+ if ($player[1]->{difficult} eq 'i') {
+ $max=5+8+10;
+ }
+ if ($player[1]->{difficult} eq 'a') {
+ $max=5+8+10+6;
+ }
+ if ($player[1]->{difficult} eq 'x') {
+ $max=undef;
+ }
+ my $res=compute($max);
+ if (!defined $res) {
+ my $r= random();
+ if ($r) {
+ $st=-5;
+ }
+ } else {
+ if ($res <0 || $res ==1) {
+ $st=$res;
+ }
+ }
+ if ($step_counter == 9 && $st == 0) {
+ $st= -5;
+ }
+ return $st;
+}
+
+sub sc_check {
+ my $r= compute(5);
+ if (!defined $r && $step_counter == 9) {
+ $r= -5;
+ }
+ return $r;
+}
+
+sub random {
+ my $r = int(rand()*10)+1;
+ my $c;
+ while ($r >0 ) {
+ $c=0;
+ for(my $x=0; $x <3; $x++) {
+ for(my $y=0; $y <3; $y++) {
+ if ($board[$x][$y]==0) {
+ $r--;
+ } else {
+ $c++;
+ }
+ if ($r <=0) {
+ $board[$x][$y]=1;
+ $step_counter++;
+ last;
+ }
+ }
+ last if ($r <=0);
+ }
+ last if ( $c >=8);
+ }
+ return ($c >=8);
+}
+
+sub def_player {
+ my ($num)= @_;
+ if (defined $witem) {
+ $player[$num]->{type}='L';
+ }
+ if (defined $type) {
+ $player[$num]->{type}=$type;
+ }
+ if (defined $server) {
+ $player[$num]->{server}=$server->{tag};
+ }
+ if (defined $target) {
+ $player[$num]->{target}=$target;
+ }
+}
+
+sub board {
+ my $str= " %9abc%n\n";
+ my %c = (
+ 0=>' ',
+ 1=>$player[1]->{stone},
+ 2=>$player[0]->{stone},
+ );
+ for(my $x=0; $x<3; $x++) {
+ my $r="%9 $x%n ";
+ for(my $y=0; $y<3; $y++) {
+ $r .= $c{$board[$x][$y]};
+ }
+ $str .= $r."\n";
+ }
+ $str .= "\n";
+ return $str;
+}
+
+sub cmd {
+ my ($args, $server, $wi)=@_;
+ my @args = grep { $_ ne ''} quotewords('\s+', 0, $args);
+ $witem= $wi;
+ $type= 'L';
+ subcmd(@args);
+ $type= undef;
+ $witem= undef;
+}
+
+sub cmd_help {
+ my ($args, $server, $witem)=@_;
+ $args=~ s/\s+//g;
+ if ($IRSSI{name} eq $args) {
+ Irssi::print($help, MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop();
+ }
+}
+
+sub subcmd {
+ my (@args) =@_;
+ my $a= $args[0];
+ if ($a eq 'help' || $a eq '') {
+ out($help);
+ }
+ if ($a eq 'board') {
+ out(board(),1);
+ }
+ # init
+ if ($state==0 && $a eq 'game') {
+ $state=1;
+ $player[0]->{nick}=$nick;
+ def_player(0);
+ if ($type eq 'L') {
+ $a='c';
+ } else {
+ out('%9tictactoe%n vs %gc%nomputer or vs %gh%numan?');
+ }
+ }
+ if ($state==1 && $player[0]->{nick} eq $nick && $a =~ m/^c/) {
+ $state=2;
+ $player[1]->{computer}=1;
+ out('difficulty: %ge%nasy, %gn%novice, %gi%nntermediate, '.
+ '%ga%ndvanced, e%gx%npert?');
+ # e asy
+ # n ovice
+ # i ntermediate
+ # a dvanced
+ # e x pert
+ }
+ if ($state==2 && $player[0]->{nick} eq $nick && $a =~ m/^([eniax])/) {
+ $state=3;
+ $a='';
+ $player[1]->{difficult}=$1;
+ out('%gX%n or %gO%n?');
+ }
+ # game start vs computer
+ if ($state==3 && $player[0]->{nick} eq $nick && $a =~ m/^[xo]$/i) {
+ $state=30;
+ sc_clear();
+ $player[0]->{win}=0;
+ $player[0]->{draw}=0;
+ $player[1]->{win}=0;
+ if (lc($a) eq 'x') {
+ $player[0]->{stone}='X';
+ $player[1]->{stone}='O';
+ } else {
+ $player[0]->{stone}='O';
+ $player[1]->{stone}='X';
+ # compute
+ sc_compute();
+ }
+ out(board(),1);
+ }
+ # play vs computer
+ if ($state==30 && $player[0]->{nick} eq $nick && $a =~ m/^[abc][012]$/i) {
+ $state=30;
+ if (step_in($a,2) == 0) {
+ my $r=sc_compute();
+ if ( $r==0 || $r==1 || $r==-5 ) {
+ out(board(),1);
+ }
+ if ( $r== -5 ) {
+ $state=31;
+ $player[0]->{draw}++;
+ out("draw");
+ }
+ if ( $r== 1 || $r== -1 ) {
+ $state=31;
+ $player[1]->{win}++;
+ out("computer win");
+ }
+ if ( $r== -2 ) {
+ $state=31;
+ $player[0]->{win}++;
+ out("you win");
+ }
+ if ($state==31) {
+ out("play a gain? (%gy%nes or %gn%no)");
+ }
+ }
+ }
+ if ($state==31 && $player[0]->{nick} eq $nick && $a =~ m/^[yn]/i) {
+ if ( $a=~ m/^n/i) {
+ my $s="%9computer%n:$player[1]->{win} %9draw%n:$player[0]->{draw} ";
+ $s .= "%9";
+ if ( $player[0]->{nick} eq '' ) {
+ $s .= "you";
+ } else {
+ $s .=$player[0]->{nick};
+ }
+ $s .="%n:$player[0]->{win}";
+ out($s);
+ @player=();
+ $state=0;
+ } else {
+ # game
+ $state=30;
+ sc_clear();
+ my $s= $player[0]->{stone};
+ $player[0]->{stone}= $player[1]->{stone};
+ $player[1]->{stone}= $s;
+ if ($player[1]->{stone} eq 'X') {
+ sc_compute();
+ }
+ out(board(),1);
+ }
+ }
+ # init vs human
+ if ($state==1 && $player[0]->{nick} eq $nick && $a =~ m/^h/) {
+ $state=5;
+ out("player 2 ? (".mynick().": !%gg%name)",1);
+ }
+ if ($state==5 && $player[0]->{nick} ne $nick && $a =~ m/^g/) {
+ $player[1]->{nick}=$nick;
+ my $r =int(rand(10)) % 2;
+ sc_clear();
+ $player[0]->{win}=0;
+ $player[0]->{draw}=0;
+ $player[1]->{win}=0;
+ out(board(),1);
+ if ($r == 0) {
+ $player[0]->{stone}='X';
+ $player[1]->{stone}='O';
+ $state=10;
+ out("your turn", 0, $player[0]->{nick});
+ } else {
+ $player[0]->{stone}='O';
+ $player[1]->{stone}='X';
+ $state=20;
+ out("your turn", 0, $player[1]->{nick});
+ }
+ }
+ # play vs human
+ if ($state==10 && $player[0]->{nick} eq $nick && $a =~ m/^[abc][012]$/) {
+ if (step_in($a,2) == 0) {
+ my $r= sc_check();
+ if (!defined $r) {
+ $state=20;
+ out(board(),1);
+ out("your turn", 0, $player[1]->{nick});
+ } else {
+ $state=11;
+ human_end($r);
+ }
+ }
+ }
+ if ($state==20 && $player[1]->{nick} eq $nick && $a =~ m/^[abc][012]$/) {
+ if (step_in($a,1) == 0) {
+ my $r= sc_check();
+ if (!defined $r) {
+ $state=10;
+ out(board(),1);
+ out("your turn", 0, $player[0]->{nick});
+ } else {
+ $state=11;
+ human_end($r);
+ }
+ }
+ }
+ # play again vs human
+ if ($state==11 &&
+ ($player[1]->{nick} eq $nick || $player[0]->{nick} eq $nick)
+ && $a =~ m/^[yn]/) {
+ if ($a =~ m/^y/i) {
+ sc_clear();
+ my $s= $player[0]->{stone};
+ $player[0]->{stone}= $player[1]->{stone};
+ $player[1]->{stone}= $s;
+ out(board(),1);
+ if ($player[1]->{stone} eq 'X') {
+ $state=20;
+ out("your turn", 0, $player[1]->{nick});
+ } else {
+ $state=10;
+ out("your turn", 0, $player[0]->{nick});
+ }
+ } else {
+ $state=0;
+ my $s="%9";
+ if ( $player[1]->{nick} eq '' ) {
+ $s .= "you";
+ } else {
+ $s .=$player[1]->{nick};
+ }
+ $s .= "%n:$player[1]->{win} %9draw%n:$player[0]->{draw} ";
+ $s .= "%9";
+ if ( $player[0]->{nick} eq '' ) {
+ $s .= "you";
+ } else {
+ $s .=$player[0]->{nick};
+ }
+ $s .="%n:$player[0]->{win}";
+ out($s);
+ @player=();
+ }
+ }
+}
+
+sub human_end {
+ my ($result)= @_;
+ out(board(),1);
+ if ($result == -5) {
+ out("draw",1);
+ $player[0]->{draw}++
+ }
+ if ($result == -1) {
+ out("$player[1]->{nick} win",1);
+ $player[1]->{win}++
+ }
+ if ($result == -2) {
+ out("$player[0]->{nick} win",1);
+ $player[0]->{win}++
+ }
+ out("play again (%gy%nes or %gn%no)",1);
+}
+
+sub to_irc_color {
+ my ($str)= @_;
+ $str =~ s/%9/\x{3}2/g;
+ $str =~ s/%g/\x{3}3/g;
+ $str =~ s/%n/\x{3}/g;
+ $str =~ s/%%/%/g;
+ return $str;
+}
+
+sub out {
+ my ($str, $neutral, $ni ) =@_;
+ my @l =split /\n/,$str;
+ $nick= $ni if (defined $ni);
+ foreach my $r (@l) {
+ if ($player[0]->{type} eq 'C') {
+ my $s= $player[0]->{server};
+ my $t= $player[0]->{target};
+ if ( $neutral== 1) {
+ Irssi::command("/msg -$s $t ".to_irc_color($r));
+ } else {
+ Irssi::command("msg -$s $t $nick: ".to_irc_color($r));
+ }
+ } elsif ($player[0]->{type} eq 'Q') {
+ my $s= $player[0]->{server};
+ my $t= $player[0]->{target};
+ if ( $neutral== 1) {
+ Irssi::command("/msg -$s $t ".to_irc_color($r));
+ } else {
+ Irssi::command("msg -$s $t $nick: ".to_irc_color($r));
+ }
+ } elsif (defined $witem) {
+ $witem->print($r, MSGLEVEL_CLIENTCRAP);
+ } else {
+ Irssi::print($r, MSGLEVEL_CLIENTCRAP);
+ }
+ }
+}
+
+sub mynick {
+ my $n;
+ if (defined $server) {
+ $n= $server->{nick};
+ }
+ if (defined $witem) {
+ my $s= $witem->{server};
+ $n= $s->{nick};
+ }
+ return $n;
+}
+
+sub sig_message_public {
+ my ($se, $msg, $ni, $address, $ta)= @_;
+ $type='C';
+ $server=$se;
+ $nick=$ni;
+ $target=$ta;
+ my @args = grep { $_ ne ''} quotewords('\s+', 0, $msg);
+ my $to =shift @args;
+ if ($to =~ m/^\Q$se->{nick}\E[:]?$/ ) {
+ if( $args[0] =~ m/^!(.*)$/ ) {
+ $args[0] = $1;
+ subcmd(@args);
+ }
+ }
+ $type=undef;
+ $server=undef;
+ $nick=undef;
+ $target=undef;
+}
+
+sub sig_message_private {
+ my ($se, $msg, $ni, $address, $ta)= @_;
+ $type='Q';
+ $server=$se;
+ $nick=$ni;
+ $target=$ni;
+ my @args = grep { $_ ne ''} quotewords('\s+', 0, $msg);
+ if ( $args[0] =~ m/^!(.*)$/ ) {
+ $args[0] = $1;
+ subcmd(@args);
+ }
+ $type=undef;
+ $server=undef;
+ $nick=undef;
+ $target=undef;
+}
+
+sub sig_message_own_private {
+ my ($se, $msg, $ta, $orig_target)= @_;
+ $server=$se;
+ $type='Q';
+ $nick=$se->{nick};
+ $target=$ta;
+ my @args = grep { $_ ne ''} quotewords('\s+', 0, $msg);
+ if ( $args[0] =~ m/^!(.*)$/ ) {
+ $args[0] = $1;
+ subcmd(@args);
+ }
+ $type=undef;
+ $server=undef;
+ $nick=undef;
+ $target=undef;
+}
+
+sub sig_message_own_public {
+ my ($se, $msg, $ta)= @_;
+ $server=$se;
+ $type='C';
+ $nick=$se->{nick};
+ $target=$ta;
+ my @args = grep { $_ ne ''} quotewords('\s+', 0, $msg);
+ if ( $args[0] =~ m/^!(.*)$/ ) {
+ $args[0] = $1;
+ subcmd(@args);
+ }
+ $type=undef;
+ $server=undef;
+ $nick=undef;
+ $target=undef;
+}
+
+Irssi::signal_add("message own_public", \&sig_message_own_public);
+Irssi::signal_add("message own_private", \&sig_message_own_private);
+Irssi::signal_add("message public", \&sig_message_public);
+Irssi::signal_add("message private", \&sig_message_private);
+
+Irssi::command_bind($IRSSI{name}, \&cmd);
+Irssi::command_bind('help', \&cmd_help);
+
diff --git a/scripts/timer.pl b/scripts/timer.pl
new file mode 100644
index 0000000..22c4f6f
--- /dev/null
+++ b/scripts/timer.pl
@@ -0,0 +1,177 @@
+# Fixes for multiple servers and window items by dg
+#
+# 2003-08-27 coekie:
+# - use item names and server tags, fixes irssi crash if window item or server is destroyed
+#
+# 2003-08-19
+# - changed timer stop code a bit.
+# should fix the random timer o.O never happened to me before.
+#
+# 2002-12-21 darix:
+# - nearly complete rewrite ;) the old version wasnt "use strict;" capable =)
+# - still some warnings with "use warnings;"
+# - use of command_runsub now :)
+#
+
+use strict;
+use Data::Dumper;
+use warnings;
+use vars qw ($VERSION %IRSSI);
+use Irssi 20020325 qw (command_bind command_runsub command timeout_add timeout_remove signal_add_first);
+
+$VERSION = '0.8';
+%IRSSI = (
+ authors => 'Kimmo Lehto, Marcus Rueckert',
+ contact => 'kimmo@a-men.org, darix@irssi.org' ,
+ name => 'Timer',
+ description => 'Provides /timer command for mIRC/BitchX type timer functionality.',
+ license => 'Public Domain',
+ changed => '2015-02-07'
+);
+
+Irssi::settings_add_bool('timer', 'timer_stop_msgs', 1);
+
+our %timers;
+# my %timer = { repeat => \d+, command => '' , windowitem => NULL , server=> NULL, timer = NULL};
+
+sub timer_command {
+ my ( $name ) = @_;
+ if ( exists ( $timers{$name} ) ) {
+ my ($server, $item);
+ if ($timers{$name}->{'server'}) {
+ $server = Irssi::server_find_tag( $timers{$name}->{'server'} );
+ }
+ if ( $server ) {
+ if ( $timers{$name}->{'windowitem'}) {
+ $item = $server->window_find_item( $timers{$name}->{'windowitem'} );
+ }
+ ($item ? $item : $server)->command( $timers{$name}->{'command'} );
+ } else {
+ command( $timers{$name}->{'command'} );
+ }
+
+ if ( $timers{$name}->{'repeat'} != -1 ) {
+ if ( --$timers{$name}->{'repeat'} == 0) {
+ cmd_timerstop( $name );
+ }
+ }
+ }
+}
+
+sub cmd_timerstop {
+ my ( $name ) = @_;
+
+ my $verbose = Irssi::settings_get_bool('timer_stop_msgs');
+ if ( exists ( $timers{$name} ) ) {
+ timeout_remove($timers{$name}->{'timer'});
+ $timers{$name} = ();
+ delete ( $timers{$name} );
+ print( CRAP "Timer \"$name\" stopped." ) if $verbose;
+ }
+ else {
+ print( CRAP "\cBTimer:\cB No such timer \"$name\"." ) if $verbose;
+ }
+}
+
+sub cmd_timer_help {
+ print ( <<EOF
+
+TIMER LIST
+TIMER ADD <name> <interval in seconds> [<repeat>] <command>
+TIMER STOP <name>
+
+repeat value of 0 means unlimited too
+
+EOF
+ );
+}
+
+command_bind 'timer add' => sub {
+ my ( $data, $server, $item ) = @_;
+ my ( $name, $interval, $times, $command );
+
+ if ( $data =~ /^\s*(\S+)\s+(\d+(?:\.\d+)?)\s+(-?\d+)\s+(.*)$/ ) {
+ ( $name, $interval, $times, $command ) = ( $1, $2, $3, $4 );
+ $times = -1 if ( $times == 0 );
+ }
+ elsif ( $data =~ /^\s*(\S+)\s+(\d+(?:\.\d+)?)\s+(.*)$/ )
+ {
+ ( $name, $interval, $times, $command ) = ( $1, $2, -1, $3 );
+ }
+ else {
+ print( CRAP "\cBTimer:\cB parameters not understood. commandline was: timer add $data");
+ return;
+ };
+
+ if ( $times < -1 ) {
+ print( CRAP "\cBTimer:\cB repeat should be greater or equal to -1" );
+ return;
+ };
+
+ if ( $command eq "" ) {
+ print( CRAP "\cBTimer:\cB command is empty commandline was: timer add $data" );
+ return;
+ };
+
+ if ( exists ( $timers{$name} ) ) {
+ print( CRAP "\cBTimer:\cB Timer \"$name\" already active." );
+ }
+ else {
+ #$timers{$name} = {};
+ $timers{$name}->{'repeat'} = $times;
+ $timers{$name}->{'interval'} = $interval;
+ $timers{$name}->{'command'} = $command;
+ if ($item) {
+ $timers{$name}->{'windowitem'} = $item->{'name'};
+ }
+ if ($server) {
+ $timers{$name}->{'server'} = $server->{'tag'};
+ }
+
+ if ( $times == -1 ) {
+ $times = 'until stopped.';
+ }
+ else {
+ $times .= " times.";
+ }
+
+ print( CRAP "Starting timer \"$name\" repeating \"$command\" every $interval seconds $times" );
+
+ $timers{$name}->{'timer'} = timeout_add( $interval * 1000, \&timer_command, $name );
+ }
+};
+
+command_bind 'timer list' => sub {
+ print( CRAP "Active timers:" );
+ foreach my $name ( keys %timers ) {
+ if ( $timers{$name}->{repeat} == -1 ) {
+ print( CRAP "$name = $timers{$name}->{'command'} (until stopped)");
+ }
+ else {
+ print( CRAP "$name = $timers{$name}->{'command'} ($timers{$name}->{'repeat'} repeats left)" );
+ }
+ }
+ print( CRAP "End of /timer list" );
+};
+
+command_bind 'timer stop' => sub {
+ my ( $data, $server, $item ) = @_;
+ cmd_timerstop ($data);
+};
+
+command_bind 'timer help' => sub { cmd_timer_help() };
+
+command_bind 'timer' => sub {
+ my ( $data, $server, $item ) = @_;
+ $data =~ s/\s+$//g;
+ command_runsub ( 'timer', $data, $server, $item ) ;
+};
+
+
+signal_add_first 'default command timer' => sub {
+#
+# gets triggered if called with unknown subcommand
+#
+ cmd_timer_help()
+}
+
diff --git a/scripts/tinyurl.pl b/scripts/tinyurl.pl
new file mode 100644
index 0000000..30e4b5b
--- /dev/null
+++ b/scripts/tinyurl.pl
@@ -0,0 +1,47 @@
+#
+# by Atoms
+
+use strict;
+use WWW::Shorten::TinyURL;
+use WWW::Shorten 'TinyURL';
+
+use vars qw($VERSION %IRSSI);
+
+use Irssi qw(command_bind active_win);
+$VERSION = '1.1';
+%IRSSI = (
+ authors => 'Atoms',
+ contact => 'atoms@tups.lv',
+ patch => 'spowers@dimins.com',
+ name => 'tinyurl',
+ description => 'create a tinyurl from a long one',
+ license => 'GPL',
+);
+
+command_bind(
+ tinyurl => sub {
+ my ($msg, $server, $witem) = @_;
+ my $answer = tinyurl($msg);
+
+ if ($answer) {
+ print CLIENTCRAP "$answer";
+
+ if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) {
+ $witem->command("MSG " . $witem->{name} ." ". $answer);
+ }
+ }
+ }
+);
+
+sub tinyurl {
+ my $url = shift;
+
+ my $res = makeashorterlink($url);
+
+ if (defined $res) {
+ return $res;
+ } else {
+ print CLIENTCRAP "ERROR: tinyurl: tinyurl is down or not pingable";
+ return "";
+ }
+}
diff --git a/scripts/title.pl b/scripts/title.pl
new file mode 100644
index 0000000..bec0d4f
--- /dev/null
+++ b/scripts/title.pl
@@ -0,0 +1,150 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi 20020120.0250 ();
+$VERSION = "3.2b";
+%IRSSI = (
+ authors => 'Timo Sirainen, David Leadbeater',
+ contact => 'tss@iki.fi, dgl@dgl.cx',
+ name => 'title',
+ description => 'Display configurable title as XTerm title',
+ license => 'GNU GPL',
+ url => 'http://irssi.dgl.cx/',
+);
+
+# Settings:
+# title_string: The string used in the title, see below for explaination
+# title_topic_length: The length to truncate the topic to (some terminals have
+# problems with long titles).
+# title_screen_window: (EXPERIMENTAL), sets the screen window title rather than
+# the Xterm title.
+
+# The $vars are normal Irssi vars (docs/special_vars.txt).
+# $.var does some magic, adds a space at the begining and brackets around
+# the item but only if it produces output.
+
+# Here is some examples:
+# The default:
+# /set title_string Irssi: [$N@$tag]$.C$.winname$.act
+# Quite nice with lots of info:
+# /set title_string $cumode$winname$C$.M$.act$.topic
+# Nickname with usermode
+# /set title_string $N(+$usermode)
+
+# To use this with screen you need some lines in your ~/.screenrc
+# termcap xterm 'hs:ts=\E]2;:fs=\007:ds=\E]2;screen\007'
+# terminfo xterm 'hs:ts=\E]2;:fs=\007:ds=\E]2;screen\007'
+# This probably only works if you have $TERM set to xterm.
+
+my %act;
+use IO::Handle;
+
+sub xterm_topic {
+ my($text) = @_;
+
+ STDERR->autoflush(1);
+ if(Irssi::settings_get_bool('title_screen_window')) {
+ print STDERR "\033k$text\033\\";
+ }else{
+ print STDERR "\033]0;$text\007";
+ }
+}
+
+sub refresh_topic {
+ my $title = Irssi::settings_get_str('title_string');
+ $title =~ s/\$([A-Za-z.,;:]+)/special_var($1)/eg;
+ xterm_topic($title);
+}
+
+sub special_var {
+ my($str) = @_;
+
+ my($begin,$end);
+ if($str =~ s/^\.//) {
+ $begin = ' [';
+ $end = ']';
+ }else{
+ $begin = $end = '';
+ }
+
+ my $result;
+ if($str eq 'topic') {
+ $result = topic_str();
+ }elsif($str eq 'act') {
+ $result = act_str();
+ }else{
+ my $item = ref Irssi::active_win() ? Irssi::active_win()->{active} : '';
+ $item = Irssi::active_server() unless ref $item;
+ return '' unless ref $item;
+
+ $result = $item->parse_special('$' . $str);
+ }
+
+ $begin = '(+', $end = ')' if $str eq 'M' && $begin;
+
+ return $result ? $begin . $result . $end : '';
+}
+
+sub topic_str {
+ my $server = Irssi::active_server();
+ my $item = ref Irssi::active_win() ? Irssi::active_win()->{active} : '';
+
+ if(ref $server && ref $item && $item->{type} eq 'CHANNEL') {
+ my $topic = $item->{topic};
+ # Remove colour and bold from topic...
+ $topic =~ s/\003(\d{1,2})(\,(\d{1,2})|)//g;
+ $topic =~ s/[\x00-\x1f]//g;
+ $topic = substr($topic, 0,Irssi::settings_get_int('title_topic_length'));
+ return $topic if length $topic;
+ }
+ return '';
+}
+
+sub act_str {
+ my @acts;
+ for my $winref(keys %act) {
+ # handle windows with items and not gracefully
+ my $window = Irssi::window_find_refnum($winref);
+ if(defined($window)) {
+ for my $win ($window->items or $window) {
+ if($win->{data_level} >= 3 || $win->{data_lev} >= 3) {
+ push(@acts,$win->{name});
+ } else {
+ delete($act{$winref});
+ }
+ }
+ } else {
+ delete($act{$winref});
+ }
+ }
+ return join(', ',@acts);
+}
+
+sub topic_changed {
+ my($chan) = @_;
+ return unless ref Irssi::active_win() &&
+ Irssi::active_win()->{active}->{type} eq 'CHANNEL';
+ return unless lc $chan->{name} eq lc Irssi::active_win()->{active}->{name};
+
+ refresh_topic();
+}
+
+sub hilight_win {
+ my($win) = @_;
+ return unless ref $win && $win->{data_level} >= 3;
+ $act{$win->{refnum}}++;
+
+ refresh_topic();
+}
+
+Irssi::signal_add_last('window changed', 'refresh_topic');
+Irssi::signal_add_last('window item changed', 'refresh_topic');
+Irssi::signal_add_last('window server changed', 'refresh_topic');
+Irssi::signal_add_last('server nick changed', 'refresh_topic');
+Irssi::signal_add_last('channel topic changed', 'topic_changed');
+Irssi::signal_add_last('window hilight', 'hilight_win');
+Irssi::signal_add_last('setup changed', 'refresh_topic');
+
+Irssi::settings_add_str('misc', 'title_string', 'Irssi: [$N@$tag]$.C$.winname$.act');
+Irssi::settings_add_int('misc', 'title_topic_length', 250);
+Irssi::settings_add_bool('misc', 'title_screen_window', 0);
+
diff --git a/scripts/tlock.pl b/scripts/tlock.pl
new file mode 100644
index 0000000..33a586e
--- /dev/null
+++ b/scripts/tlock.pl
@@ -0,0 +1,81 @@
+use Irssi 20020300;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.1";
+%IRSSI = (
+ authors => "Maciek \'fahren\' Freudenheim",
+ contact => "fahren\@bochnia.pl",
+ name => "Topic Lock",
+ description => "/TLOCK [-d] [channel] [topic] - locks current or specified topic on [channel]",
+ license => "GNU GPLv2 or later",
+ changed => "Fri Mar 15 15:09:42 CET 2002"
+);
+
+my %tlock = ();
+
+sub cmd_tlock {
+ my ($args, $server, $win) = @_;
+
+ my $tag = $server->{tag};
+ my $delete = ($args =~ s/^-d\s//)? 1 : 0;
+ my ($chan) = $args =~ /^([^\s]+)/;
+
+ unless ($chan) {
+ my $i = 0;
+ for my $ch (keys %{$tlock{$tag}}) {
+ if ($tlock{$tag}{$ch}) {
+ $i = 1;
+ Irssi::print("Lock on $tag%W/%n$ch%W:%n $tlock{$tag}{$ch}");
+ }
+ }
+ Irssi::print("%R>>%n You dont have any active topic locks at this moment.") unless $i;
+ return;
+ }
+
+ $chan = lc($chan);
+ if ($delete) {
+ Irssi::print("%W>>%n topic lock on $chan removed") if $tlock{$tag}{$chan};
+ undef $tlock{$tag}{$chan};
+ return;
+ }
+
+ my $channel = $server->channel_find($chan);
+ unless ($channel && $channel->{chanop}) {
+ Irssi::print("%R>>%n You are not channel operator/not on channel on $chan.");
+ return;
+ }
+
+ $args =~ s/^$chan\s?//;
+ my $topic = ($args)? $args : $channel->{topic};
+
+ if ($tlock{$tag}{$chan}) {
+ Irssi::print("Changed tlock on $chan to%W:%n $topic");
+ } else {
+ Irssi::print("Set tlock on $chan to%W:%n $topic");
+ }
+
+ $server->send_raw("TOPIC $chan :$topic") if $channel->{topic} ne $topic;
+
+ $tlock{$tag}{$chan} = $topic;
+
+}
+
+sub sub_tlock {
+ # "event "<cmd>, SERVER_REC, char *args, char *sender_nick, char *sender_address
+ my ($server, $args, $nick, $uh) = @_;
+
+ return if $server->{nick} eq $nick;
+ my ($chan, $topic) = split(/ :/, $args);
+ return unless $server->channel_find($chan)->{chanop};
+ $chan = lc($chan);
+ my $tag = $server->{tag};
+
+ if ($tlock{$tag}{$chan} && $topic ne $tlock{$tag}{$chan}) {
+ Irssi::print("%W>>%n tlock: changing topic back on $chan");
+ $server->send_raw("TOPIC $chan :$tlock{$tag}{$chan}");
+ }
+}
+
+Irssi::signal_add('event topic', 'sub_tlock');
+Irssi::command_bind('tlock', 'cmd_tlock');
diff --git a/scripts/tmux-nicklist-portable.pl b/scripts/tmux-nicklist-portable.pl
new file mode 100644
index 0000000..e0c6920
--- /dev/null
+++ b/scripts/tmux-nicklist-portable.pl
@@ -0,0 +1,432 @@
+# based on the nicklist.pl script
+################################################################################
+# tmux_nicklist.pl
+# This script integrates tmux and irssi to display a list of nicks in a
+# vertical right pane with 20% width. Right now theres no configuration
+# or setup, simply initialize the script with irssi and by default you
+# will get the nicklist for every channel(customize by altering
+# the regex in /set nicklist_channel_re)
+#
+# /set nicklist_channel_re <regex>
+# * only show on channels matching this regular expression
+#
+# /set nicklist_max_users <num>
+# * only show when the channel has so many users or less (0 = always)
+#
+# /set nicklist_smallest_main <num>
+# * only show when main window is larger than this (0 = always)
+#
+# /set nicklist_pane_width <num>
+# * width of the nicklist pane
+#
+# /set nicklist_color <ON|OFF>
+# * colourise the nicks in the nicklist (required nickcolor script
+# with get_nick_color2 and debug_ansicolour functions)
+#
+# /set nicklist_gone_sort <ON|OFF>
+# * sort away people below
+#
+# It supports mouse scrolling and the following keys:
+# k/up arrow: up one line
+# j/down arrow: down one line
+# u/pageup: up 50% lines
+# d/pagedown: down 50% lines
+# gg: go to top
+# G: go to bottom
+#
+# For better integration, unrecognized sequences will be sent to irssi and
+# its pane will be focused.
+#
+# to toggle the nicklist if it is in the way you can make a key binding:
+# /bind meta-Z /script exec Irssi::Script::tmux_nicklist_portable::toggle_nicklist
+################################################################################
+
+use strict;
+use warnings;
+use IO::Handle;
+use IO::Select;
+use POSIX;
+use File::Temp qw/ :mktemp /;
+use File::Basename;
+our $VERSION = '0.1.8';
+our %IRSSI = (
+ authors => 'Thiago de Arruda',
+ contact => 'tpadilha84@gmail.com',
+ name => 'tmux-nicklist',
+ description => 'displays a list of nicks in a separate tmux pane',
+ license => 'WTFPL',
+);
+
+# "other" prefixes by danielg4 <daniel@gimpelevich.san-francisco.ca.us>
+# added 'd' and 'u' navigation as in vim, by @gerardbm (github)
+
+{ package Irssi::Nick }
+
+if ($#ARGV == -1) {
+require Irssi;
+
+my $enabled = 0;
+my $nicklist_toggle = 1;
+my $script_path = __FILE__;
+my $tmpdir;
+my $fifo_path;
+my $fifo;
+my $just_launched;
+my $resize_timer;
+
+sub enable_nicklist {
+ return if ($enabled);
+ $tmpdir = mkdtemp Irssi::get_irssi_dir()."/nicklist-XXXXXXXX";
+ $fifo_path = "$tmpdir/fifo";
+ POSIX::mkfifo($fifo_path, 0600) or die "can't mkfifo $fifo_path: $!";
+ my $cmd = "perl $script_path $fifo_path $ENV{TMUX_PANE}";
+ my $width = Irssi::settings_get_int('nicklist_pane_width');
+ system('tmux', 'split-window', '-dh', '-l', $width, '-t', $ENV{TMUX_PANE}, $cmd);
+ open_fifo();
+ Irssi::timeout_remove($just_launched) if defined $just_launched;
+ $just_launched = Irssi::timeout_add_once(300, sub { $just_launched = undef; }, '');
+}
+
+sub open_fifo {
+ # The next system call will block until the other pane has opened the pipe
+ # for reading, so synchronization is not an issue here.
+ open $fifo, ">", $fifo_path or do {
+ if ($! == 4) {
+ Irssi::timeout_add_once(300, \&open_fifo, '');
+ $enabled = -1 unless $enabled;
+ return;
+ }
+ die "can't open $fifo_path: $!";
+ };
+ $fifo->autoflush(1);
+ if ($enabled < -1) {
+ $enabled = 1;
+ disable_nicklist();
+ } elsif ($enabled == -1) {
+ $enabled = 1;
+ reset_nicklist("enabled");
+ } else {
+ $enabled = 1;
+ }
+}
+
+sub disable_nicklist {
+ return unless ($enabled);
+ if ($enabled > 0) {
+ print $fifo "EXIT\n";
+ close $fifo;
+ $fifo = undef;
+ unlink $fifo_path;
+ rmdir $tmpdir;
+ }
+ $enabled--;
+}
+
+sub reset_nicklist {
+ my $event = shift;
+ my $active = Irssi::active_win();
+ my $channel = $active->{active};
+ return disable_nicklist unless $channel && ref $channel;
+ if ($event =~ /^nick/) {
+ # check if that nick event is for the current channel/nicklist
+ my ($event_channel) = @_;
+ return unless $channel->{_irssi} == $event_channel->{_irssi};
+ }
+ my ($colourer, $ansifier);
+ if (Irssi::settings_get_bool('nicklist_color')) {
+ for my $script (sort map { my $z = $_; $z =~ s/::$//; $z } grep { /^nickcolor|nm/ } keys %Irssi::Script::) {
+ if ($colourer = "Irssi::Script::$script"->can('get_nick_color2')) {
+ $ansifier = "Irssi::Script::$script"->can('debug_ansicolour');
+ last;
+ }
+ }
+ }
+ my $channel_pattern = Irssi::settings_get_str('nicklist_channel_re');
+ { local $@;
+ $channel_pattern = eval { qr/$channel_pattern/ };
+ $channel_pattern = qr/(?!)/ if $@;
+ }
+ my $smallest_main = Irssi::settings_get_int('nicklist_smallest_main');
+ if (!$nicklist_toggle
+ || !$channel || !ref($channel)
+ || !$channel->isa('Irssi::Channel')
+ || !$channel->{'names_got'}
+ || $channel->{'name'} !~ $channel_pattern
+ || ($smallest_main && $channel->window->{width} < $smallest_main)) {
+ disable_nicklist;
+ } else {
+ my %colour;
+ my @nicks = $channel->nicks();
+ my $max_nicks = Irssi::settings_get_int('nicklist_max_users');
+ if ($max_nicks && @nicks > $max_nicks) {
+ disable_nicklist;
+ } else {
+ enable_nicklist;
+ return unless $enabled > 0;
+ foreach my $nick (sort { $a->{_irssi} <=> $b->{_irssi} } @nicks) {
+ $colour{$nick->{nick}} = ($ansifier && $colourer) ? $ansifier->($colourer->($active->{active}{server}{tag}, $channel->{name}, $nick->{nick}, 0)) : '';
+ }
+ print($fifo "BEGIN\n");
+ my $gone_sort = Irssi::settings_get_bool('nicklist_gone_sort');
+ my $prefer_real;
+ if (exists $Irssi::Script::{'realnames::'}) {
+ my $code = "Irssi::Script::realnames"->can('use_realnames');
+ $prefer_real = $code && $code->($channel);
+ }
+ my $_real = sub {
+ my $nick = shift;
+ $prefer_real && length $nick->{'realname'} ? $nick->{'realname'} : $nick->{'nick'}
+ };
+ foreach my $nick (sort {($a->{'op'}?'1':$a->{'halfop'}?'2':$a->{'voice'}?'3':$a->{'other'}>32?'0':'4').($gone_sort?($a->{'gone'}?1:0):'').lc($_real->($a))
+ cmp ($b->{'op'}?'1':$b->{'halfop'}?'2':$b->{'voice'}?'3':$b->{'other'}>32?'0':'4').($gone_sort?($b->{'gone'}?1:0):'').lc($_real->($b))} @nicks) {
+ my $colour = $colour{$nick->{nick}} || "\e[39m";
+ $colour = "\e[37m" if $nick->{'gone'};
+ print($fifo "NICK");
+ if ($nick->{'op'}) {
+ print($fifo "\e[32m\@$colour".$_real->($nick)."\e[39m");
+ } elsif ($nick->{'halfop'}) {
+ print($fifo "\e[34m%$colour".$_real->($nick)."\e[39m");
+ } elsif ($nick->{'voice'}) {
+ print($fifo "\e[33m+$colour".$_real->($nick)."\e[39m");
+ } elsif ($nick->{'other'}>32) {
+ print($fifo "\e[31m".(chr $nick->{'other'})."$colour".$_real->($nick)."\e[39m");
+ } else {
+ print($fifo " $colour".$_real->($nick)."\e[39m");
+ }
+ print($fifo "\n");
+ }
+ print($fifo "END\n");
+ }
+ }
+}
+
+sub toggle_nicklist {
+ if ($enabled) {
+ $nicklist_toggle = undef
+ } else {
+ $nicklist_toggle = 1;
+ }
+ reset_nicklist("toggle");
+}
+
+sub switch_channel {
+ print $fifo "SWITCH_CHANNEL\n" if $fifo;
+ &reset_nicklist;
+}
+
+sub resized_timed {
+ Irssi::timeout_remove($resize_timer) if defined $resize_timer;
+ return if defined $just_launched;
+ $resize_timer = Irssi::timeout_add_once(1100, \&resized, '');
+ #resized();
+}
+sub resized {
+ $resize_timer = undef;
+ return if defined $just_launched;
+ return unless $enabled >= 0;
+ disable_nicklist;
+ Irssi::timeout_add_once(200, sub{reset_nicklist("terminal resized")}, '');
+}
+sub UNLOAD {
+ disable_nicklist;
+}
+
+Irssi::settings_add_str('tmux_nicklist', 'nicklist_channel_re', '.*');
+Irssi::settings_add_int('tmux_nicklist', 'nicklist_max_users', 0);
+Irssi::settings_add_int('tmux_nicklist', 'nicklist_smallest_main', 0);
+Irssi::settings_add_int('tmux_nicklist', 'nicklist_pane_width', 13);
+Irssi::settings_add_bool('tmux_nicklist', 'nicklist_color', 1);
+Irssi::settings_add_bool('tmux_nicklist', 'nicklist_gone_sort', 0);
+Irssi::signal_add_last('window item changed', sub{switch_channel("window item changed",@_)});
+Irssi::signal_add_last('window changed', sub{switch_channel("window changed",@_)});
+Irssi::signal_add_last('channel joined', sub{switch_channel("channel joined",@_)});
+Irssi::signal_add('nicklist new', sub{reset_nicklist("nicklist new",@_)});
+Irssi::signal_add('nicklist remove', sub{reset_nicklist("nicklist remove",@_)});
+Irssi::signal_add('nicklist changed', sub{reset_nicklist("nicklist changed",@_)});
+Irssi::signal_add_first('nick mode changed', sub{reset_nicklist("nick mode changed",@_)});
+Irssi::signal_add('gui exit', \&disable_nicklist);
+Irssi::signal_add_last('terminal resized', \&resized_timed);
+
+} else {
+my $fifo_path = $ARGV[0];
+my $irssi_pane = $ARGV[1];
+# array to store the current channel nicknames
+my @nicknames = ();
+
+# helper functions for manipulating the terminal
+# escape sequences taken from
+# http://www.tldp.org/HOWTO/Bash-Prompt-HOWTO/x361.html
+sub enable_mouse { print "\e[?1000h"; }
+# recognized sequences
+my $MOUSE_SCROLL_DOWN="\e[Ma";
+my $MOUSE_SCROLL_UP="\e[M`";
+my $ARROW_DOWN="\e[B";
+my $ARROW_UP="\e[A";
+my $DOWN="j";
+my $UP="k";
+my $PAGE_DOWN="\e[6~";
+my $PAGE_UP="\e[5~";
+my $PAGE_DOWN_D="d";
+my $PAGE_UP_U="u";
+my $GO_TOP="gg";
+my $GO_BOTTOM="G";
+
+my $current_line = 0;
+my $sequence = '';
+my ($rows, $cols);
+
+sub term_size {
+ split ' ', `stty size`;
+}
+
+sub redraw {
+ my $last_nick_idx = @nicknames;
+ my $last_idx = $current_line + $rows;
+ # normalize last visible index
+ if ($last_idx > ($last_nick_idx)) {
+ $last_idx = $last_nick_idx;
+ }
+ # redraw visible nicks
+ for my $i (reverse 1..$rows) {
+ print "\e[$i;1H\e[K";
+ my $idx = $current_line + $i - 1;
+ if ($idx < $last_idx) {
+ my $z = 0; my $col = $cols;
+ for (split /(\e\[(?:\d|;|:|\?|\s)*.)/, $nicknames[$idx]) {
+ if ($z ^= 1) {
+ print +(substr $_, 0, $col) if $col > 0;
+ $col -= length;
+ } else {
+ print
+ }
+ }
+ }
+ }
+}
+
+sub move_down {
+ $sequence = '';
+ my $count = int $_[0];
+ my $nickcount = $#nicknames;
+ return if ($nickcount <= $rows);
+ if ($count == -1) {
+ $current_line = $nickcount - $rows + 1;
+ redraw;
+ return;
+ }
+ my $visible = $nickcount - $current_line - $count + 1;
+ if ($visible > $rows) {
+ $current_line += $count;
+ redraw;
+ } elsif (($visible + $count) > $rows) {
+ # scroll the maximum we can
+ $current_line = $nickcount - $rows + 1;
+ redraw;
+ }
+}
+
+sub move_up {
+ $sequence = '';
+ my $count = int $_[0];
+ if ($count == -1) {
+ $current_line = 0;
+ redraw;
+ return;
+ }
+ return if ($current_line == 0);
+ $count = 1 if $count == 0;
+ $current_line -= $count;
+ $current_line = 0 if $current_line < 0;
+ redraw;
+}
+
+$SIG{INT} = 'IGNORE';
+
+STDOUT->autoflush(1);
+# setup terminal so we can listen for individual key presses without echo
+`stty -icanon -echo`;
+
+# open named pipe and setup the 'select' wrapper object for listening on both
+# fds(fifo and sdtin)
+open my $fifo, "<", $fifo_path or die "can't open $fifo_path: $!";
+my $select = IO::Select->new();
+my @ready;
+$select->add($fifo);
+$select->add(\*STDIN);
+
+enable_mouse;
+system('tput', 'smcup');
+print "\e[?7l"; #system('tput', 'rmam');
+system('tput', 'civis');
+MAIN: {
+ while (@ready = $select->can_read) {
+ foreach my $fd (@ready) {
+ ($rows, $cols) = term_size;
+ if ($fd == $fifo) {
+ while (<$fifo>) {
+ my $line = $_;
+ if ($line =~ /^BEGIN/) {
+ @nicknames = ();
+ } elsif ($line =~ /^SWITCH_CHANNEL/) {
+ $current_line = 0;
+ } elsif ($line =~ /^NICK(.+)$/) {
+ push @nicknames, $1;
+ } elsif ($line =~ /^END$/) {
+ redraw;
+ last;
+ } elsif ($line =~ /^EXIT$/) {
+ last MAIN;
+ }
+ }
+ } else {
+ my $key = '';
+ sysread(STDIN, $key, 1);
+ $sequence .= $key;
+ if ($MOUSE_SCROLL_DOWN =~ /^\Q$sequence\E/) {
+ if ($MOUSE_SCROLL_DOWN eq $sequence) {
+ move_down 3;
+ # mouse scroll has two more bytes that I dont use here
+ # so consume them now to avoid sending unwanted bytes to
+ # irssi
+ sysread(STDIN, $key, 2);
+ }
+ } elsif ($MOUSE_SCROLL_UP =~ /^\Q$sequence\E/) {
+ if ($MOUSE_SCROLL_UP eq $sequence) {
+ move_up 3;
+ sysread(STDIN, $key, 2);
+ }
+ } elsif ($ARROW_DOWN =~ /^\Q$sequence\E/) {
+ move_down 1 if ($ARROW_DOWN eq $sequence);
+ } elsif ($ARROW_UP =~ /^\Q$sequence\E/) {
+ move_up 1 if ($ARROW_UP eq $sequence);
+ } elsif ($DOWN =~ /^\Q$sequence\E/) {
+ move_down 1 if ($DOWN eq $sequence);
+ } elsif ($UP =~ /^\Q$sequence\E/) {
+ move_up 1 if ($UP eq $sequence);
+ } elsif ($PAGE_DOWN =~ /^\Q$sequence\E/) {
+ move_down $rows/2 if ($PAGE_DOWN eq $sequence);
+ } elsif ($PAGE_UP =~ /^\Q$sequence\E/) {
+ move_up $rows/2 if ($PAGE_UP eq $sequence);
+ } elsif ($PAGE_DOWN_D =~ /^\Q$sequence\E/) {
+ move_down $rows/2 if ($PAGE_DOWN_D eq $sequence);
+ } elsif ($PAGE_UP_U =~ /^\Q$sequence\E/) {
+ move_up $rows/2 if ($PAGE_UP_U eq $sequence);
+ } elsif ($GO_BOTTOM =~ /^\Q$sequence\E/) {
+ move_down -1 if ($GO_BOTTOM eq $sequence);
+ } elsif ($GO_TOP =~ /^\Q$sequence\E/) {
+ move_up -1 if ($GO_TOP eq $sequence);
+ } else {
+ # Unrecognized sequences will be send to irssi and its pane
+ # will be focused
+ system('tmux', 'send-keys', '-t', $irssi_pane, $sequence);
+ system('tmux', 'select-pane', '-t', $irssi_pane);
+ $sequence = '';
+ }
+ }
+ }
+ }
+}
+
+close $fifo;
+
+}
diff --git a/scripts/topic-diff.pl b/scripts/topic-diff.pl
new file mode 100644
index 0000000..6082c81
--- /dev/null
+++ b/scripts/topic-diff.pl
@@ -0,0 +1,86 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+
+$VERSION = '1.00';
+%IRSSI = (
+ authors => 'Pascal Hakim',
+ contact => 'pasc@redellipse.net',
+ name => 'topic-diff',
+ description => 'This script shows you changes in the topic. ',
+ license => 'GPL'
+);
+
+my %topics;
+
+sub new_channel {
+ my ($channel) = @_;
+ $topics{$channel->{server}->{tag}."_".$channel->{name}} = $channel->{topic};
+}
+
+sub new_topic {
+ my ($server, $channel, $topic, $user, $real) = @_;
+ my $i;
+ my $diff;
+ my $i = 0;
+ my $j = 0;
+ my $k = 0;
+
+# $server->print ($channel, $server->{tag});
+
+ if ($topics{$server->{tag}."_".$channel}) {
+ $topics{$server->{tag}."_".$channel} =~ s/^ +| +$//g;
+ $topic =~ s/^ +| +$//g;
+ my @original = split /\s*\|\s*|\s+-\s+/, $topics{$server->{tag}."_".$channel};
+ my @modified = split /\s*\|\s*|\s+-\s+/, $topic;
+
+
+ outer: while( $i <= $#original) {
+ if ($j <= $#modified && $original[$i] eq $modified[$j]) {
+ $modified[$j] = '';
+ $i += 1;
+ $j += 1;
+ next;
+
+ } else {
+ # First two don't match, check the rest of the list
+ for ($k = $j ; $k <= $#modified; $k++) {
+ if ($modified[$k] eq $original[$i])
+ {
+ $modified[$k] = '';
+ $i += 1;
+ next outer;
+ }
+ }
+ $diff = ($diff ? $diff." | " : "").$original[$i];
+ $i += 1;
+ }
+ }
+
+
+ if ($diff ne '') { $server->print ($channel, "Topic: -: ".$diff);}
+
+ $diff = join " | ", (grep {$_ ne ''} @modified);
+
+ if ($diff ne '') { $server->print ($channel, "Topic: +: ".$diff);}
+
+ }
+ $topics{$server->{tag}."_".$channel} = $topic;
+
+}
+
+
+# Start by reading all the channels currently opened, and recording their topic
+
+my @channels = Irssi::channels () ;
+
+foreach my $channel (@channels) {
+ $topics{$channel->{server}->{tag}."_".$channel->{name}} = $channel->{topic};
+}
+
+# Topic has changed
+Irssi::signal_add 'message topic' => \& new_topic;
+
+# We've joined a new channel
+Irssi::signal_add 'channel joined' => \& new_channel;
diff --git a/scripts/topics.pl b/scripts/topics.pl
new file mode 100644
index 0000000..61a672b
--- /dev/null
+++ b/scripts/topics.pl
@@ -0,0 +1,126 @@
+
+# by Stefan 'tommie' Tomanek
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = '2003020801';
+%IRSSI = (
+ authors => 'Stefan \'tommie\' Tomanek',
+ contact => 'stefan@pico.ruhr.de',
+ name => 'topics',
+ description => 'records a topic history and locks the channel topic',
+ license => 'GPLv2',
+ url => 'http://irssi.org/scripts/',
+ changed => $VERSION,
+ commands => 'topics'
+);
+
+use Irssi 20020324;
+use vars qw(%topics);
+
+sub show_help() {
+ my $help = "$IRSSI{name} $VERSION
+/topics
+ List all topics that have been set in the current channel
+/topics <num>
+ Restore topic <num>
+/topics lock
+ Lock the current topic
+/topics unlock
+ Unlock the channeltopic
+";
+ my $text='';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP &draw_box("Topics", $text, "topics help", 1);
+}
+
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub sig_channel_topic_changed ($) {
+ my ($channel) = @_;
+ my $ircnet = $channel->{server}->{tag};
+ my $name = $channel->{name};
+ my $data = {'topic' => $channel->{topic},
+ 'topic_by' => $channel->{topic_by},
+ 'topic_time' => $channel->{topic_time}
+ };
+ push @{$topics{$ircnet}{$name}{list}}, $data;
+ if ($topics{$ircnet}{$name}{lock}) {
+ my $topic = $topics{$ircnet}{$name}{lock}{topic};
+ return if ($topic eq $channel->{topic});
+ $channel->print("%B>>%n Restoring locked topic...", MSGLEVEL_CLIENTCRAP);
+ $channel->command("TOPIC -- ".$topic);
+ }
+}
+
+sub cmd_topics ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @args = split / /, $args;
+ if ($args[0] =~ /^\d+$/) {
+ return unless (ref $witem && $witem->{type} eq 'CHANNEL');
+ my $ircnet = $server->{tag};
+ my $name = $witem->{name};
+ if (defined $topics{$ircnet}{$name}{list}->[$args]) {
+ $witem->print("%B>>%n Restoring Topic ".$args, MSGLEVEL_CLIENTCRAP);
+ my $topic = $topics{$ircnet}{$name}{list}->[$args]->{topic};
+ $witem->command("TOPIC -- ".$topic);
+ }
+ } elsif ($args[0] eq 'lock') {
+ return unless (ref $witem && $witem->{type} eq 'CHANNEL');
+ my $ircnet = $server->{tag};
+ my $name = $witem->{name};
+ my $data = {'topic' => $witem->{topic},
+ 'topic_by' => $witem->{topic_by},
+ 'topic_time' => $witem->{topic_time}
+ };
+ $topics{$ircnet}{$name}{lock} = $data;
+ $witem->print("%B>>%n %ro-m%n Topic locked", MSGLEVEL_CLIENTCRAP);
+ } elsif ($args[0] eq 'unlock') {
+ return unless (ref $witem && $witem->{type} eq 'CHANNEL');
+ my $ircnet = $server->{tag};
+ my $name = $witem->{name};
+ delete $topics{$ircnet}{$name}{lock};
+ $witem->print("%B>>%n %gø-m%n Topic unlocked", MSGLEVEL_CLIENTCRAP);
+ } elsif ($args[0] eq 'help') {
+ show_help();
+ } else {
+ return unless (ref $witem && $witem->{type} eq 'CHANNEL');
+ my $ircnet = $server->{tag};
+ my $name = $witem->{name};
+ my $i = 0;
+ my $text;
+ foreach (@{$topics{$ircnet}{$name}{list}}) {
+ $text .= "%r[".$i."]%n ".$_->{topic_time}." (by ".$_->{topic_by}.")\n";
+ my $topic = $_->{topic};
+ $topic =~ s/%/%%/g;
+ $text .= ' "'.$topic.'"'."\n";
+ $i++;
+ }
+ $witem->print($_, MSGLEVEL_CLIENTCRAP) foreach (split(/\n/, draw_box('Topics', $text, $name, 1)));
+ }
+}
+
+Irssi::signal_add('channel topic changed', \&sig_channel_topic_changed);
+sig_channel_topic_changed($_) foreach (Irssi::channels());
+
+Irssi::command_bind('topics', \&cmd_topics);
+foreach my $cmd ('lock', 'unlock', 'help') {
+ Irssi::command_bind('topics '.$cmd => sub {
+ cmd_topics("$cmd ".$_[0], $_[1], $_[2]); });
+}
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /topics help for help';
diff --git a/scripts/topicsed.pl b/scripts/topicsed.pl
new file mode 100644
index 0000000..58d0143
--- /dev/null
+++ b/scripts/topicsed.pl
@@ -0,0 +1,61 @@
+#
+# Topicsed edits channel topics by perl regexps via the command /topicsed.
+#
+# Thanks to Mikael Magnusson for the idea and patch to implement a
+# preview functionality. ;]
+#
+use strict;
+use Irssi;
+
+use vars qw/%IRSSI $VERSION/;
+$VERSION="0.1";
+%IRSSI = (
+ authors => "Gabor Nyeki",
+ contact => "bigmac\@vim.hu",
+ name => "topicsed",
+ description => "editing channel topics by regexps",
+ license => "public domain",
+ changed => "2017-03-18"
+);
+
+
+sub topicsed {
+ my ($regexp, $server, $winit) = @_;
+
+ my $preview = 0;
+ if ($regexp =~ m/^-p(review|) ?/) {
+ $preview = 1;
+ $regexp =~ s/^-p\w* ?//;
+ }
+
+ unless ($regexp) {
+ Irssi::print("Usage: /topicsed [-p[review]] <regexp>");
+ return;
+ }
+ return if (!$server || !$server->{connected} ||
+ !$winit || $winit->{type} ne 'CHANNEL');
+
+ my $topic = $winit->{topic};
+ my $x = $topic;
+
+ unless (eval "\$x =~ $regexp") {
+ Irssi::print("topicsed:error: An error occured with your regexp.");
+ return;
+ }
+
+ if ($x eq $topic) {
+ Irssi::print("topicsed:error: The topic wouldn't be changed.");
+ return;
+ } elsif ($x eq "") {
+ Irssi::print("topicsed:error: Edited topic is empty; try '/topic -delete' instead.");
+ return;
+ }
+
+ if ($preview) {
+ Irssi::print("topicsed: Edited topic for $winit->{name}: $x");
+ } else {
+ $server->send_raw("TOPIC $winit->{name} :$x");
+ }
+}
+
+Irssi::command_bind('topicsed', 'topicsed');
diff --git a/scripts/track.pl b/scripts/track.pl
new file mode 100644
index 0000000..bc73e08
--- /dev/null
+++ b/scripts/track.pl
@@ -0,0 +1,310 @@
+use Irssi qw(servers);
+use warnings; use strict;
+use File::Glob qw/:bsd_glob/;
+use vars qw($VERSION %IRSSI);
+
+my $quiet = 0;
+my $dupcount = 0;
+$VERSION = "2.2";
+
+%IRSSI = (
+ authors => "Ziddy",
+ contact => "DALnet",
+ name => "track",
+ description => "Keeps track of users by building a database" .
+ "of online, joining and nickchanges. Regex-cabable" .
+ "for the most part, AKA import available. Search by" .
+ "ident, nick or host",
+ license => "Public Domain",
+ url => "none"
+);
+
+my $track_file;
+
+sub whois_signal {
+ my ($server, $data, $txtserver) = @_;
+ my ($me, $nick, $ident, $host) = split(" ", $data);
+ open(my $fh, '>>', $track_file);
+ open(my $fh2, '<', $track_file);
+ my @list = <$fh2>;
+ close($fh2);
+ $nick = conv($nick);
+ ($ident = $ident) =~ s/^~//;
+ $ident = conv($ident);
+
+ if(!grep(/$nick;$ident;$host/, @list)) {
+ print $fh "$nick;$ident;$host\n";
+ if (!$quiet) { Irssi::print("%G$nick has been added to the database"); }
+ } else {
+ if (!$quiet) { Irssi::print("%R$nick exists in the database"); }
+ }
+
+ close($fh);
+}
+
+sub joining {
+ my ($server, $channame, $nick, $host) = @_;
+ open(my $fh, '>>', $track_file);
+ open(my $fh2, '<', $track_file);
+ $nick = conv($nick);
+ my @list = <$fh2>;
+ close($fh2);
+ my @spl = split(/@/, $host);
+ my $ident = $spl[0];
+ my $mask = $spl[1];
+ ($ident = $ident) =~ s/^~//;
+ $ident = conv($ident);
+ $dupcount++;
+
+ if(!grep(/$nick;$ident;$mask/, @list)) {
+ print $fh "$nick;$ident;$mask\n";
+ if (!$quiet) { Irssi::print("%GADDED $nick;$ident;$mask"); }
+ } else {
+ if (!$quiet) { Irssi::print("%REXIST $nick;$ident;$mask"); }
+ }
+
+ close($fh);
+
+ if ($dupcount >= 100) {
+ open(my $fhr, '<', $track_file);
+ my @list = <$fhr>;
+ close($fhr);
+ my @duprem = uniq(@list);
+ open(my $fhw, '>', $track_file);
+ print $fhw @duprem;
+ close($fhw);
+ $dupcount = 0;
+ }
+
+
+}
+
+sub nchange {
+ my ($server, $newnick, $oldnick, $host) = @_;
+ open(my $fh, '>>', $track_file);
+ open(my $fh2, '<', $track_file);
+ $newnick = conv($newnick);
+ my @list = <$fh2>;
+ close($fh2);
+ my @spl = split(/@/, $host);
+ my $ident = $spl[0];
+ my $mask = $spl[1];
+ ($ident = $ident) =~ s/^~//;
+ $ident = conv($ident);
+
+ if(!grep(/$newnick;$ident;$mask/, @list)){
+ print $fh "$newnick;$ident;$mask\n";
+ if (!$quiet) { Irssi::print("%GADDED $newnick;$ident;$mask)"); }
+ } else {
+ if (!$quiet) { Irssi::print("%REXIST $newnick;$ident;$mask"); }
+ }
+
+ close($fh);
+}
+
+sub track {
+ my $input = $_[0];
+ chomp($input);
+ my @spl = split(/\s/, $input);
+ my $type;
+ if (defined $spl[0] ) {
+ $type = $spl[0];
+ } else {
+ $type='';
+ }
+ my $data = $spl[1];
+ $data = conv($data);
+ my $match = 0;
+ open(my $fh, '<', $track_file);
+ my @list = <$fh>;
+ close($fh);
+
+ if ($type eq "count") {
+ Irssi::print("%GDatabase entries%n: " . scalar(@list));
+ return;
+ }
+
+ if ($type eq "quiet") {
+ if ($quiet) { $quiet = 0; } else { $quiet = 1; }
+ Irssi::print("%GQuiet mode set to $quiet");
+ return;
+ }
+
+ if ($type eq "help") {
+ Irssi::print("\n%GHelp%n\n" .
+ " /gather - Join your channels then run this\n" .
+ " to gather nicks already online\n" .
+ " This may take a while on first run\n" .
+ " /track quiet - Toggle quiet. If this is on, it wont\n" .
+ " show when a person is added or already\n" .
+ " exists in the database\n" .
+ "/track count - Print amount of database entries\n" .
+ "/import [file] - This allows you to import AKA data-\n" .
+ " bases. AKA is a popular mIRC script\n" .
+ " which allows you to keep track of people\n" .
+ " by nickname and hostmask. This imports\n" .
+ " all of the nicknames and hosts and fills\n" .
+ " in the ident with AKAImport, since AKA does\n" .
+ " not keep track of idents\n\nCommon usage:\n" .
+ "/track ident <input> - Search for entries by supplied ident\n" .
+ "/track nick <input> - Search for entries by supplied nick\n" .
+ "/track host <input> - Search for entries by supplied " .
+ "IP address\n" . " " x 25 . "or hostmask, IPv4 or IPv6\n" .
+ "\n%RNote%n: Regular expressions are acceptable! Be\n" .
+ "careful though. It has no protection to stop you from \n" .
+ "sucking at regex. If you don't match something, it'll\n" .
+ "crash the script (unmatched quantifiers)\nLove,\n --Ziddy\n");
+ return;
+ }
+
+ foreach my $line (@list) {
+ my ($unick, $ident, $host);
+ if ($type eq "ident" && defined $data) {
+ if ($line =~ m/^(.*?);($data);(.*)$/i) {
+ ($unick, $ident, $host) = (unconv($1), unconv($2), $3);
+ Irssi::print("%GIdent[%n$data%G]%n: $unick used $ident on $host");
+ $match = 1;
+ }
+ } elsif ($type eq "host" && defined $data) {
+ if ($line =~ m/^(.*?);(.*?);($data)$/i) {
+ ($unick, $ident, $host) = (unconv($1), unconv($2), $3);
+ Irssi::print("%GHost[%n$data%G]%n: $unick used $ident on $host");
+ $match = 1;
+ }
+ } elsif ($type eq "nick" && defined $data) {
+ if ($line =~ m/^($data);(.*?);(.*)$/i) {
+ ($unick, $ident, $host) = (unconv($1), unconv($2), $3);
+ Irssi::print("%GNick[%n$data%G]%n: $unick used $ident on $host");
+ $match = 1;
+ }
+ } else {
+ Irssi::print("%RUsage%n: /track [{ident|host|nick} <input>]");
+ last;
+ }
+ }
+
+ if (!$match) {
+ Irssi::print("%RNo data to return");
+ }
+}
+
+sub uniq {
+ my %seen;
+ grep !$seen{$_}++, @_;
+}
+
+sub namechan {
+ my ($null, $cserv) = @_;
+ my $count = 0;
+ $cserv = $cserv->{tag};
+ foreach my $serv (Irssi::channels()) {
+ my $curserv = $serv->{server}->{tag};
+ if ($cserv eq $curserv) {
+ foreach my $nname ($serv->nicks()) {
+ my $nickc = conv($nname->{nick});
+ my $nick = $nname->{nick};
+ open(my $fh, '<', $track_file);
+ my @list = <$fh>;
+ close($fh);
+
+ if(!grep(/$nickc;/, @list)) {
+ Irssi::active_server->send_raw("WHOIS " . $nick);
+ $count++;
+ } else {
+ if (!$quiet) { Irssi::print("%RAlready gathered $nick"); }
+ }
+
+ }
+ }
+ }
+ Irssi::print("%GGathering complete - Added $count new entries");
+}
+
+sub conv {
+ my $data = $_[0];
+ if (!$data) { return; }
+ ($data = $data) =~ s/\]/~~/g;
+ ($data = $data) =~ s/\[/@@/g;
+ ($data = $data) =~ s/\^/##/g;
+ ($data = $data) =~ s/\\/&&/g;
+ return $data;
+}
+
+sub unconv {
+ my $data = $_[0];
+ if (!$data) { return; }
+ ($data = $data) =~ s/~~/\]/g;
+ ($data = $data) =~ s/@@/\[/g;
+ ($data = $data) =~ s/##/\^/g;
+ ($data = $data) =~ s/%%/\\/g;
+ return $data;
+}
+
+#Messy for now
+sub importAKA {
+ my $input = $_[0];
+ if (-e $input) {
+ open(my $fh, '<', $input);
+ my @list = <$fh>;
+ close($fh);
+ my $ip = 0;
+ my ($string, $import);
+ foreach my $line (@list) {
+ chomp($line);
+ my @nicks;
+ if ($line =~ /(.*?)@(.*+)/g) {
+ $ip = $2;
+ } elsif ($line =~ /(.*)~/g) {
+ my @nicksplit = split(/~/, $1);
+ foreach my $ns (@nicksplit) {
+ push(@nicks, $ns);
+ }
+ }
+ foreach my $nick (@nicks) {
+ my $snick = conv($nick);
+ if ($snick and $ip) {
+ if (length($snick) > 1 and length($ip) > 1) {
+ $string .= "$snick;AKAImport;$ip;;;";
+ }
+ }
+ }
+ }
+ my @arrn = split(/;;;/, $string);
+ open(my $fh2, '>>', $track_file);
+ foreach my $out (@arrn) {
+ if (length($out) > 1) {
+ $out =~ s/\r//g;
+ print $fh2 "$out\n";
+ $import++;
+ }
+ }
+ close($fh2);
+ Irssi::print("%GImported $import users into the database%n");
+ }
+}
+
+sub sig_setup_changed {
+ $track_file= Irssi::settings_get_str('track_file');
+ $track_file= bsd_glob($track_file);
+ if (! (-e $track_file)) {
+ open my $fa, '>', $track_file;
+ close $fa;
+ }
+}
+
+Irssi::settings_add_str($IRSSI{name} ,'track_file', Irssi::get_irssi_dir() . "/scripts/track.lst");
+
+Irssi::command_bind('track' => \&track);
+Irssi::command_bind('track nick' => \&track);
+Irssi::command_bind('track ident' => \&track);
+Irssi::command_bind('track host' => \&track);
+Irssi::command_bind('track help' => \&track);
+Irssi::command_bind('track quiet' => \&track);
+Irssi::command_bind('gather' => \&namechan);
+Irssi::command_bind('import' => \&importAKA);
+Irssi::signal_add('message join', 'joining');
+Irssi::signal_add('message nick', 'nchange');
+Irssi::signal_add_first('event 311', 'whois_signal');
+Irssi::signal_add('setup changed', \&sig_setup_changed);
+
+sig_setup_changed();
diff --git a/scripts/trackbar.pl b/scripts/trackbar.pl
new file mode 100644
index 0000000..8814cab
--- /dev/null
+++ b/scripts/trackbar.pl
@@ -0,0 +1,606 @@
+## trackbar.pl
+#
+# This little script will do just one thing: it will draw a line each time you
+# switch away from a window. This way, you always know just upto where you've
+# been reading that window :) It also removes the previous drawn line, so you
+# don't see double lines.
+#
+# redraw trackbar only works on irssi 0.8.17 or higher.
+#
+##
+
+## Usage:
+#
+# The script works right out of the box, but if you want you can change
+# the working by /set'ing the following variables:
+#
+# Setting: trackbar_style
+# Description: This setting will be the color of your trackbar line.
+# By default the value will be '%K', only Irssi color
+# formats are allowed. If you don't know the color formats
+# by heart, you can take a look at the formats documentation.
+# You will find the proper docs on http://www.irssi.org/docs.
+#
+# Setting: trackbar_string
+# Description: This is the string that your line will display. This can
+# be multiple characters or just one. For example: '~-~-'
+# The default setting is '-'.
+# Here are some unicode characters you can try:
+# "───" => U+2500 => a line
+# "â•â•â•" => U+2550 => a double line
+# "â”â”â”" => U+2501 => a wide line
+# "â–­ " => U+25ad => a white rectangle
+#
+# Setting: trackbar_use_status_window
+# Description: If this setting is set to OFF, Irssi won't print a trackbar
+# in the statuswindow
+#
+# Setting: trackbar_ignore_windows
+# Description: A list of windows where no trackbar should be printed
+#
+# Setting: trackbar_print_timestamp
+# Description: If this setting is set to ON, Irssi will print the formatted
+# timestamp in front of the trackbar.
+#
+# Setting: trackbar_require_seen
+# Description: Only clear the trackbar if it has been scrolled to.
+#
+# Setting: trackbar_all_manual
+# Description: Never clear the trackbar until you do /mark.
+#
+# /mark is a command that will redraw the line at the bottom.
+#
+# Command: /trackbar, /trackbar goto
+# Description: Jump to where the trackbar is, to pick up reading
+#
+# Command: /trackbar keep
+# Description: Keep this window's trackbar where it is the next time
+# you switch windows (then this flag is cleared again)
+#
+# Command: /mark, /trackbar mark
+# Description: Remove the old trackbar and mark the bottom of this
+# window with a new trackbar
+#
+# Command: /trackbar markvisible
+# Description: Like mark for all visible windows
+#
+# Command: /trackbar markall
+# Description: Like mark for all windows
+#
+# Command: /trackbar remove
+# Description: Remove this window's trackbar
+#
+# Command: /trackbar removeall
+# Description: Remove all windows' trackbars
+#
+# Command: /trackbar redraw
+# Description: Force redraw of trackbars
+#
+##
+
+##
+#
+# For bugreports and other improvements contact one of the authors.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this script; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+##
+
+use strict;
+use warnings;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "2.9"; # a4c78e85092a271
+
+%IRSSI = (
+ authors => "Peter 'kinlo' Leurs, Uwe Dudenhoeffer, " .
+ "Michiel Holtkamp, Nico R. Wohlgemuth, " .
+ "Geert Hauwaerts",
+ contact => 'peter@pfoe.be',
+ patchers => 'Johan Kiviniemi (UTF-8), Uwe Dudenhoeffer (on-upgrade-remove-line)',
+ name => 'trackbar',
+ description => 'Shows a bar where you have last read a window.',
+ license => 'GNU General Public License',
+ url => 'http://www.pfoe.be/~peter/trackbar/',
+ commands => 'trackbar',
+);
+
+## Comments and remarks.
+#
+# This script uses settings.
+# Use /SET to change the value or /TOGGLE to switch it on or off.
+#
+#
+# Tip: The command 'trackbar' is very useful if you bind that to a key,
+# so you can easily jump to the trackbar. Please see 'help bind' for
+# more information about keybindings in Irssi.
+#
+# Command: /BIND meta2-P key F1
+# /BIND F1 command trackbar
+#
+##
+
+## Bugfixes and new items in this rewrite.
+#
+# * Remove all the trackbars before upgrading.
+# * New setting trackbar_use_status_window to control the statuswindow trackbar.
+# * New setting trackbar_print_timestamp to print a timestamp or not.
+# * New command 'trackbar' to scroll up to the trackbar.
+# * When resizing your terminal, Irssi will update all the trackbars to the new size.
+# * When changing trackbar settings, change all the trackbars to the new settings.
+# * New command 'trackbar mark' to draw a new trackbar (The old '/mark').
+# * New command 'trackbar markall' to draw a new trackbar in each window.
+# * New command 'trackbar remove' to remove the trackbar from the current window.
+# * New command 'trackbar removeall' to remove all the trackbars.
+# * Don't draw a trackbar in empty windows.
+# * Added a version check to prevent Irssi redraw errors.
+# * Fixed a bookmark NULL versus 0 bug.
+# * Fixed a remove-line bug in Uwe Dudenhoeffer his patch.
+# * New command 'help trackbar' to display the trackbar commands.
+# * Fixed an Irssi startup bug, now processing each auto-created window.
+#
+##
+
+## Known bugs and the todolist.
+#
+# Todo: * Instead of drawing a line, invert the line.
+#
+##
+
+## Authors:
+#
+# - Main maintainer & author: Peter 'kinlo' Leurs
+# - Many thanks to Timo 'cras' Sirainen for placing me on my way
+# - on-upgrade-remove-line patch by Uwe Dudenhoeffer
+# - trackbar resizing by Michiel Holtkamp (02 Jul 2012)
+# - scroll to trackbar, window excludes, and timestamp options by Nico R.
+# Wohlgemuth (22 Sep 2012)
+#
+##
+
+## Version history:
+#
+# 2.9: - fix crash on /mark in empty window
+# 2.8: - fix /^join bug
+# 2.7: - add /set trackbar_all_manual option
+# 2.5: - merge back on scripts.irssi.org
+# - fix /trackbar redraw broken in 2.4
+# - fix legacy encodings
+# - add workaround for irssi issue #271
+# 2.4: - add support for horizontal splits
+# 2.3: - add some features for seen tracking using other scripts
+# 2.0: - big rewrite based on 1.4
+# * removed /tb, you can have it with /alias tb trackbar if you want
+# * subcommand and settings changes:
+# /trackbar vmark => /trackbar markvisible
+# /trackbar scroll => /trackbar goto (or just /trackbar)
+# /trackbar help => /help trackbar
+# /set trackbar_hide_windows => /set trackbar_ignore_windows
+# /set trackbar_timestamp => /set trackbar_print_timestamp
+# * magic line strings were removed, just paste the unicode you want!
+# * trackbar_timestamp_styled is not currently supported
+# 1.9: - add version guard
+# 1.8: - sub draw_bar
+# 1.7: - Added /tb scroll, trackbar_hide_windows, trackbar_timestamp_timestamp
+# and trackbar_timestamp_styled
+# 1.6: - Work around Irssi resize bug, please do /upgrade! (see below)
+# 1.5: - Resize trackbars in all windows when terminal is resized
+# 1.4: - Changed our's by my's so the irssi script header is valid
+# - Removed utf-8 support. In theory, the script should work w/o any
+# problems for utf-8, just set trackbar_string to a valid utf-8 character
+# and everything *should* work. However, this script is being plagued by
+# irssi internal bugs. The function Irssi::settings_get_str does NOT handle
+# unicode strings properly, hence you will notice problems when setting the bar
+# to a unicode char. For changing your bar to utf-8 symbols, read the line sub.
+# 1.3: - Upgrade now removes the trackbars.
+# - Some code cleanups, other defaults
+# - /mark sets the line to the bottom
+# 1.2: - Support for utf-8
+# - How the bar looks can now be configured with trackbar_string
+# and trackbar_style
+# 1.1: - Fixed bug when closing window
+# 1.0: - Initial release
+#
+##
+
+use Irssi;
+use Irssi::TextUI;
+use Encode;
+
+use POSIX qw(strftime);
+
+sub cmd_help {
+ my ($args) = @_;
+ if ($args =~ /^trackbar *$/i) {
+ print CLIENTCRAP <<HELP
+%9Syntax:%9
+
+TRACKBAR
+TRACKBAR GOTO
+TRACKBAR KEEP
+TRACKBAR MARK
+TRACKBAR MARKVISIBLE
+TRACKBAR MARKALL
+TRACKBAR REMOVE
+TRACKBAR REMOVEALL
+TRACKBAR REDRAW
+
+%9Parameters:%9
+
+ GOTO: Jump to where the trackbar is, to pick up reading
+ KEEP: Keep this window's trackbar where it is the next time
+ you switch windows (then this flag is cleared again)
+ MARK: Remove the old trackbar and mark the bottom of this
+ window with a new trackbar
+ MARKVISIBLE: Like mark for all visible windows
+ MARKALL: Like mark for all windows
+ REMOVE: Remove this window's trackbar
+ REMOVEALL: Remove all windows' trackbars
+ REDRAW: Force redraw of trackbars
+
+%9Description:%9
+
+ Manage a trackbar. Without arguments, it will scroll up to the trackbar.
+
+%9Examples:%9
+
+ /TRACKBAR MARK
+ /TRACKBAR REMOVE
+HELP
+ }
+}
+
+Irssi::theme_register([
+ 'trackbar_loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.',
+ 'trackbar_wrong_version', '%R>>%n %_Trackbar:%_ Please upgrade your client to 0.8.17 or above if you would like to use this feature of trackbar.',
+ 'trackbar_all_removed', '%R>>%n %_Trackbar:%_ All the trackbars have been removed.',
+ 'trackbar_not_found', '%R>>%n %_Trackbar:%_ No trackbar found in this window.',
+]);
+
+my $old_irssi = Irssi::version < 20140701;
+sub check_version {
+ if ($old_irssi) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'trackbar_wrong_version');
+ return;
+ } else {
+ return 1;
+ }
+}
+
+sub is_utf8 {
+ lc Irssi::settings_get_str('term_charset') eq 'utf-8'
+}
+
+my (%config, %keep_trackbar, %unseen_trackbar);
+
+sub remove_one_trackbar {
+ my $win = shift;
+ my $view = shift || $win->view;
+ my $line = $view->get_bookmark('trackbar');
+ if (defined $line) {
+ my $bottom = $view->{bottom};
+ $view->remove_line($line);
+ $win->command('^scrollback end') if $bottom && !$win->view->{bottom};
+ $view->redraw;
+ }
+}
+
+sub add_one_trackbar_pt1 {
+ my $win = shift;
+ my $view = shift || $win->view;
+
+ my $last_cur_line = ($view->{buffer}{cur_line}||+{})->{_irssi};
+ $win->print(line($win->{width}), MSGLEVEL_NEVER);
+
+ my $cur_line = ($win->view->{buffer}{cur_line}||+{})->{_irssi}; # get a fresh buffer
+
+ ($last_cur_line//'') ne ($cur_line//'') # printing was successful
+}
+
+sub add_one_trackbar_pt2 {
+ my $win = shift;
+ my $view = $win->view;
+
+ $view->set_bookmark_bottom('trackbar');
+ $unseen_trackbar{ $win->{_irssi} } = 1;
+ Irssi::signal_emit("window trackbar added", $win);
+ $view->redraw;
+}
+
+sub update_one_trackbar {
+ my $win = shift;
+ my $view = shift || $win->view;
+ my $force = shift;
+ my $ignored = win_ignored($win, $view);
+ my $success;
+
+ $success = add_one_trackbar_pt1($win, $view) ? 1 : 0
+ if $force || !$ignored;
+
+ remove_one_trackbar($win, $view)
+ if ( $success || !defined $success ) && ( $force || !defined $force || !$ignored );
+
+ add_one_trackbar_pt2($win)
+ if $success;
+}
+
+sub win_ignored {
+ my $win = shift;
+ my $view = shift || $win->view;
+ return 1 unless $view->{buffer}{lines_count};
+ return 1 if $win->{name} eq '(status)' && !$config{use_status_window};
+ no warnings 'uninitialized';
+ return 1 if grep { $win->{name} eq $_ || $win->{refnum} eq $_
+ || $win->get_active_name eq $_ } @{ $config{ignore_windows} };
+ return 0;
+}
+
+sub sig_window_changed {
+ my ($newwindow, $oldwindow) = @_;
+ return unless $oldwindow;
+ redraw_one_trackbar($newwindow) unless $old_irssi;
+ trackbar_update_seen($newwindow);
+ return if delete $keep_trackbar{ $oldwindow->{_irssi} };
+ trackbar_update_seen($oldwindow);
+ return if $config{require_seen} && $unseen_trackbar{ $oldwindow->{_irssi } };
+ return if $config{all_manual};
+ update_one_trackbar($oldwindow, undef, 0);
+}
+
+sub trackbar_update_seen {
+ my $win = shift;
+ return unless $win;
+ return unless $unseen_trackbar{ $win->{_irssi} };
+
+ my $view = $win->view;
+ my $line = $view->get_bookmark('trackbar');
+ unless ($line) {
+ delete $unseen_trackbar{ $win->{_irssi} };
+ Irssi::signal_emit("window trackbar seen", $win);
+ return;
+ }
+ my $startline = $view->{startline};
+ return unless $startline;
+
+ if ($startline->{info}{time} < $line->{info}{time}
+ || $startline->{_irssi} == $line->{_irssi}) {
+ delete $unseen_trackbar{ $win->{_irssi} };
+ Irssi::signal_emit("window trackbar seen", $win);
+ }
+}
+
+sub screen_length;
+{ local $@;
+ eval { require Text::CharWidth; };
+ unless ($@) {
+ *screen_length = sub { Text::CharWidth::mbswidth($_[0]) };
+ }
+ else {
+ *screen_length = sub {
+ my $temp = shift;
+ Encode::_utf8_on($temp) if is_utf8();
+ length($temp)
+ };
+ }
+}
+
+{ my %strip_table = (
+ (map { $_ => '' } (split //, '04261537' . 'kbgcrmyw' . 'KBGCRMYW' . 'U9_8I:|FnN>#[' . 'pP')),
+ (map { $_ => $_ } (split //, '{}%')),
+ );
+ sub c_length {
+ my $o = Irssi::strip_codes($_[0]);
+ $o =~ s/(%(%|Z.{6}|z.{6}|X..|x..|.))/exists $strip_table{$2} ? $strip_table{$2} :
+ $2 =~ m{x(?:0[a-f]|[1-6][0-9a-z]|7[a-x])|z[0-9a-f]{6}}i ? '' : $1/gex;
+ screen_length($o)
+ }
+}
+
+sub line {
+ my ($width, $time) = @_;
+ my $string = $config{string};
+ $string = ' ' unless length $string;
+ $time ||= time;
+
+ Encode::_utf8_on($string) if is_utf8();
+ my $length = c_length($string);
+
+ my $format = '';
+ if ($config{print_timestamp}) {
+ $format = $config{timestamp_str};
+ $format =~ y/%/\01/;
+ $format =~ s/\01\01/%/g;
+ $format = strftime($format, localtime $time);
+ $format =~ y/\01/%/;
+ }
+
+ my $times = $width / $length;
+ $times += 1 if $times != int $times;
+ my $style = "$config{style}";
+ Encode::_utf8_on($style) if is_utf8();
+ $format .= $style;
+ $width -= c_length($format);
+ $string x= $times;
+ chop $string while length $string && c_length($string) > $width;
+ return $format . $string;
+}
+
+sub remove_all_trackbars {
+ for my $window (Irssi::windows) {
+ next unless ref $window;
+ remove_one_trackbar($window);
+ }
+}
+
+sub UNLOAD {
+ remove_all_trackbars();
+}
+
+sub redraw_one_trackbar {
+ my $win = shift;
+ my $view = $win->view;
+ my $line = $view->get_bookmark('trackbar');
+ return unless $line;
+ my $bottom = $view->{bottom};
+ $win->print_after($line, MSGLEVEL_NEVER, line($win->{width}, $line->{info}{time}),
+ $line->{info}{time});
+ $view->set_bookmark('trackbar', $win->last_line_insert);
+ $view->remove_line($line);
+ $win->command('^scrollback end') if $bottom && !$win->view->{bottom};
+ $view->redraw;
+}
+
+sub redraw_trackbars {
+ return unless check_version();
+ for my $win (Irssi::windows) {
+ next unless ref $win;
+ redraw_one_trackbar($win);
+ }
+}
+
+sub goto_trackbar {
+ my $win = Irssi::active_win;
+ my $line = $win->view->get_bookmark('trackbar');
+
+ if ($line) {
+ $win->command("scrollback goto ". strftime("%d %H:%M:%S", localtime($line->{info}{time})));
+ } else {
+ $win->printformat(MSGLEVEL_CLIENTCRAP, 'trackbar_not_found');
+ }
+}
+
+sub cmd_mark {
+ update_one_trackbar(Irssi::active_win, undef, 1);
+}
+
+sub cmd_markall {
+ for my $window (Irssi::windows) {
+ next unless ref $window;
+ update_one_trackbar($window);
+ }
+}
+
+sub signal_stop {
+ Irssi::signal_stop;
+}
+
+sub cmd_markvisible {
+ my @wins = Irssi::windows;
+ my $awin =
+ my $bwin = Irssi::active_win;
+ my $awin_counter = 0;
+ Irssi::signal_add_priority('window changed' => 'signal_stop', -99);
+ do {
+ Irssi::active_win->command('window up');
+ $awin = Irssi::active_win;
+ update_one_trackbar($awin);
+ ++$awin_counter;
+ } until ($awin->{refnum} == $bwin->{refnum} || $awin_counter >= @wins);
+ Irssi::signal_remove('window changed' => 'signal_stop');
+}
+
+sub cmd_trackbar_remove_one {
+ remove_one_trackbar(Irssi::active_win);
+}
+
+sub cmd_remove_all_trackbars {
+ remove_all_trackbars();
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'trackbar_all_removed');
+}
+
+sub cmd_keep_once {
+ $keep_trackbar{ Irssi::active_win->{_irssi} } = 1;
+}
+
+sub trackbar_runsub {
+ my ($data, $server, $item) = @_;
+ $data =~ s/\s+$//g;
+
+ if ($data) {
+ Irssi::command_runsub('trackbar', $data, $server, $item);
+ } else {
+ goto_trackbar();
+ }
+}
+
+sub update_config {
+ my $was_status_window = $config{use_status_window};
+ $config{style} = Irssi::settings_get_str('trackbar_style');
+ $config{string} = Irssi::settings_get_str('trackbar_string');
+ $config{require_seen} = Irssi::settings_get_bool('trackbar_require_seen');
+ $config{all_manual} = Irssi::settings_get_bool('trackbar_all_manual');
+ $config{ignore_windows} = [ split /[,\s]+/, Irssi::settings_get_str('trackbar_ignore_windows') ];
+ $config{use_status_window} = Irssi::settings_get_bool('trackbar_use_status_window');
+ $config{print_timestamp} = Irssi::settings_get_bool('trackbar_print_timestamp');
+ if (defined $was_status_window && $was_status_window != $config{use_status_window}) {
+ if (my $swin = Irssi::window_find_name('(status)')) {
+ if ($config{use_status_window}) {
+ update_one_trackbar($swin);
+ }
+ else {
+ remove_one_trackbar($swin);
+ }
+ }
+ }
+ if ($config{print_timestamp}) {
+ my $ts_format = Irssi::settings_get_str('timestamp_format');
+ my $ts_theme = Irssi::current_theme->get_format('fe-common/core', 'timestamp');
+ my $render_str = Irssi::current_theme->format_expand($ts_theme);
+ (my $ts_escaped = $ts_format) =~ s/([%\$])/$1$1/g;
+ $render_str =~ s/(?|\$(.)(?!\w)|\$\{(\w+)\})/$1 eq 'Z' ? $ts_escaped : $1/ge;
+ $config{timestamp_str} = $render_str;
+ }
+ redraw_trackbars() unless $old_irssi;
+}
+
+Irssi::settings_add_str('trackbar', 'trackbar_string', is_utf8() ? "\x{2500}" : '-');
+Irssi::settings_add_str('trackbar', 'trackbar_style', '%K');
+Irssi::settings_add_str('trackbar', 'trackbar_ignore_windows', '');
+Irssi::settings_add_bool('trackbar', 'trackbar_use_status_window', 1);
+Irssi::settings_add_bool('trackbar', 'trackbar_print_timestamp', 0);
+Irssi::settings_add_bool('trackbar', 'trackbar_require_seen', 0);
+Irssi::settings_add_bool('trackbar', 'trackbar_all_manual', 0);
+
+update_config();
+
+Irssi::signal_add_last( 'mainwindow resized' => 'redraw_trackbars')
+ unless $old_irssi;
+
+Irssi::signal_register({'window trackbar added' => [qw/Irssi::UI::Window/]});
+Irssi::signal_register({'window trackbar seen' => [qw/Irssi::UI::Window/]});
+Irssi::signal_register({'gui page scrolled' => [qw/Irssi::UI::Window/]});
+Irssi::signal_add_last('gui page scrolled' => 'trackbar_update_seen');
+
+Irssi::signal_add('setup changed' => 'update_config');
+Irssi::signal_add_priority('session save' => 'remove_all_trackbars', Irssi::SIGNAL_PRIORITY_HIGH-1);
+
+Irssi::signal_add('window changed' => 'sig_window_changed');
+
+Irssi::command_bind('trackbar goto' => 'goto_trackbar');
+Irssi::command_bind('trackbar keep' => 'cmd_keep_once');
+Irssi::command_bind('trackbar mark' => 'cmd_mark');
+Irssi::command_bind('trackbar markvisible' => 'cmd_markvisible');
+Irssi::command_bind('trackbar markall' => 'cmd_markall');
+Irssi::command_bind('trackbar remove' => 'cmd_trackbar_remove_one');
+Irssi::command_bind('trackbar removeall' => 'cmd_remove_all_trackbars');
+Irssi::command_bind('trackbar redraw' => 'redraw_trackbars');
+Irssi::command_bind('trackbar' => 'trackbar_runsub');
+Irssi::command_bind('mark' => 'cmd_mark');
+Irssi::command_bind_last('help' => 'cmd_help');
+
+Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'trackbar_loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
+
+# workaround for issue #271
+{ package Irssi::Nick }
diff --git a/scripts/tracknick.pl b/scripts/tracknick.pl
new file mode 100644
index 0000000..5354694
--- /dev/null
+++ b/scripts/tracknick.pl
@@ -0,0 +1,201 @@
+# created for irssi 0.7.98, Copyright (c) 2000 Timo Sirainen
+
+# Are you ever tired of those people who keep changing their nicks?
+# Or maybe you just don't like someone's nick?
+# This script lets you see them with the real nick all the time no matter
+# what nick they're currently using.
+
+# Features:
+# - when you first join to channel the nick is detected from real name
+# - when the nick join to channel, it's detected from host mask
+# - keeps track of parts/quits/nick changes
+# - /find[realnick] command for seeing the current "fake nick"
+# - all public messages coming from the nick are displayed as coming from
+# the real nick.
+# - all other people's replies to the fake nick are changed to show the
+# real nick instead ("fakenick: hello" -> "realnick: hello")
+# - if you reply to the real nick, it's automatically changed to the
+# fake nick
+
+# TODO:
+# - ability to detect always from either address or real name (send whois
+# requests after join)
+# - don't force the trackchannel
+# - nick completion should complete to the real nick too (needs changes
+# to irssi code, perl module doesn't recognize "completion word" signal)
+# - support for runtime configuration + multiple nicks
+# - support for /whois and some other commands? private messages?
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.02";
+%IRSSI = (
+ authors => "Timo Sirainen",
+ contact => "tss\@iki.fi",
+ name => "tracknick",
+ description => "Are you ever tired of those people who keep changing their nicks? Or maybe you just don't like someone's nick? This script lets you see them with the real nick all the time no matter what nick they're currently using.",
+ license => "Public Domain",
+ url => "http://irssi.org/",
+ changed => "2019-06-08"
+);
+
+my $trackchannel;
+my $realnick;
+my $address_regexp;
+my $realname_regexp;
+
+my $fakenick = '';
+
+sub event_nick {
+ my ( $server, $newnick, $nick, $address) = @_;
+ $newnick = substr($newnick, 1) if ($newnick =~ /^:/);
+
+ $fakenick = $newnick if ($nick eq $fakenick)
+}
+
+sub event_join {
+ my ( $server, $data, $nick, $address) = @_;
+
+ if (!$fakenick && $data =~ m/$trackchannel/ &&
+ $address =~ /$address_regexp/) {
+ $fakenick = $nick;
+ }
+}
+
+sub event_part {
+ my ($server, $data, $nick, $address) = @_;
+ my ($channel, $reason) = $data =~ /^(\S*)\s:(.*)/;
+
+ $fakenick = '' if ($fakenick eq $nick && $channel eq $trackchannel);
+}
+
+sub event_quit {
+ my ($server, $data, $nick, $address) = @_;
+
+ $fakenick = '' if ($fakenick eq $nick);
+}
+
+sub event_wholist {
+ my ($channel) = @_;
+
+ find_realnick($channel) if ($channel->{name} eq $trackchannel);
+}
+
+sub find_realnick {
+ my ($channel) = @_;
+
+ my @nicks = $channel->nicks();
+ $fakenick = '';
+ foreach my $nick (@nicks) {
+ my $realname = $nick->{realname};
+ if ($realname =~ /$realname_regexp/i) {
+ $fakenick = $nick->{nick};
+ last;
+ }
+ }
+}
+
+sub sig_public {
+ my ($server, $msg, $nick, $address, $target) = @_;
+
+ return if ($target ne $trackchannel || !$fakenick ||
+ $fakenick eq $realnick);
+
+ if ($nick eq $fakenick) {
+ # text sent by fake nick - change it to real nick
+ send_real_public($server, $msg, $nick, $address, $target);
+ return;
+ }
+
+ if ($msg =~ /^$fakenick([:',].*)/) {
+ # someone's message starts with the fake nick,
+ # automatically change it to real nick
+ $msg = $realnick.$1;
+ Irssi::signal_emit("message public", $server, $msg,
+ $nick, $address, $target);
+ Irssi::signal_stop();
+ }
+}
+
+sub send_real_public
+{
+ my ($server, $msg, $nick, $address, $target) = @_;
+
+ my $channel = $server->channel_find($target);
+ return if (!$channel);
+
+ my $nickrec = $channel->nick_find($nick);
+ return if (!$nickrec);
+
+ # create temporarily the nick to the nick list so that
+ # nick mode can be displayed correctly
+ my $newnick = $channel->nick_insert($realnick,
+ $nickrec->{op},
+ $nickrec->{halfop},
+ $nickrec->{voice},
+ 0);
+
+ Irssi::signal_emit("message public", $server, $msg,
+ $realnick, $address, $target);
+ $channel->nick_remove($newnick);
+ Irssi::signal_stop();
+}
+
+sub sig_send_text {
+ my ($data, $server, $item) = @_;
+
+ return if (!$fakenick || !$item ||
+ $item->{name} ne $trackchannel);
+
+ if ($fakenick ne $realnick && $data =~ /^$realnick([:',].*)/) {
+ # sending message to realnick, change it to fakenick
+ $data = $fakenick.$1;
+ Irssi::signal_emit("send text", $data, $server, $item);
+ Irssi::signal_stop();
+ }
+}
+
+sub cmd_realnick {
+ if ($fakenick) {
+ Irssi::print("$realnick is currently with nick: $fakenick");
+ } else {
+ Irssi::print("I can't find $realnick currently.");
+ }
+}
+
+sub sig_setup_changed {
+ $address_regexp = Irssi::settings_get_str($IRSSI{name}.'_'.'address_regexp');
+ $realname_regexp = Irssi::settings_get_str($IRSSI{name}.'_'.'realname_regexp');
+ my $tc = Irssi::settings_get_str($IRSSI{name}.'_'.'trackchannel');
+ if ( $tc ne $trackchannel) {
+ $fakenick = '';
+ $trackchannel= $tc;
+ }
+ my $rn = Irssi::settings_get_str($IRSSI{name}.'_'.'realnick');
+ if ( $rn ne $realnick) {
+ Irssi::command_unbind("find$realnick", 'cmd_realnick');
+ Irssi::command_bind("find$rn", 'cmd_realnick');
+ $fakenick = '';
+ $realnick= $rn;
+ }
+ my $channel = Irssi::channel_find($trackchannel);
+ find_realnick($channel) if ($channel);
+}
+
+Irssi::settings_add_str($IRSSI{name} ,$IRSSI{name}.'_'.'trackchannel', '#channel');
+Irssi::settings_add_str($IRSSI{name} ,$IRSSI{name}.'_'.'realnick', 'nick');
+Irssi::settings_add_str($IRSSI{name} ,$IRSSI{name}.'_'.'address_regexp', 'user@address.fi$');
+Irssi::settings_add_str($IRSSI{name} ,$IRSSI{name}.'_'.'realname_regexp', 'first.*lastname');
+
+Irssi::signal_add('setup changed', \&sig_setup_changed);
+Irssi::signal_add('event nick', 'event_nick');
+Irssi::signal_add('event join', 'event_join');
+Irssi::signal_add('event part', 'event_part');
+Irssi::signal_add('event quit', 'event_quit');
+Irssi::signal_add('message public', 'sig_public');
+Irssi::signal_add('send text', 'sig_send_text');
+Irssi::signal_add('channel wholist', 'event_wholist');
+
+sig_setup_changed();
diff --git a/scripts/trigger.pl b/scripts/trigger.pl
new file mode 100644
index 0000000..348c386
--- /dev/null
+++ b/scripts/trigger.pl
@@ -0,0 +1,1300 @@
+# trigger.pl - execute a command or replace text, triggered by an event in irssi
+# Do /TRIGGER HELP or look at http://wouter.coekaerts.be/irssi/ for help
+
+# Copyright (C) 2002-2010 Wouter Coekaerts <wouter@coekaerts.be>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+use strict;
+use Irssi 20020324 qw(command_bind command_runsub command signal_add_first signal_continue signal_stop signal_remove);
+use Text::ParseWords;
+use IO::File;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.3.1';
+%IRSSI = (
+ authors => 'Wouter Coekaerts',
+ contact => 'wouter@coekaerts.be',
+ name => 'trigger',
+ description => 'execute a command or replace text, triggered by an event in irssi',
+ license => 'GPLv2 or later',
+ url => 'http://wouter.coekaerts.be/irssi/',
+ changed => '2022-12-28',
+);
+
+sub cmd_help {
+ Irssi::print (<<'SCRIPTHELP_EOF', MSGLEVEL_CLIENTCRAP);
+
+TRIGGER LIST
+TRIGGER SAVE
+TRIGGER RELOAD
+TRIGGER MOVE <number> <number>
+TRIGGER DELETE <number>
+TRIGGER CHANGE <number> ...
+TRIGGER ADD ...
+
+%U%_When to match%_%U
+%UOn which types of event to trigger%U
+ These are simply specified by -name_of_the_type
+ The normal IRC event types are:
+ publics, %|privmsgs, (pub|priv)actions, (pub|priv)notices, (pub|priv)ctcps, (pub|priv)ctcpreplies, joins, parts, quits, kicks, topics, invites, nick_changes, dcc_msgs, dcc_actions, dcc_ctcps
+ mode_channel: %|a mode on the (whole) channel (like +t, +i, +b)
+ mode_nick: %|a mode on someone in the channel (like +o, +v)
+ -all is an alias for all of those.
+ Additionally, there is:
+ rawin: %|raw text incoming from the server
+ send_command: %|commands you give to irssi
+ send_text: %|lines you type that aren't commands
+ beep: %|when irssi beeps
+ notify_join: %|someone in you notify list comes online
+ notify_part: %|someone in your notify list goes offline
+ notify_away: %|someone in your notify list goes away
+ notify_unaway: %|someone in your notify list goes unaway
+ notify_unidle: %|someone in your notify list stops idling
+ (pub|priv)flood: %|flood in a channel or in private detected. See /set flood. Be careful, these flood signals can trigger many times for one flood (unless you have autoignore enabled)
+
+%UFilters (conditions) the event has to satisfy%U
+They all take one parameter. If you can give a list, seperate elements by space and use quotes around the list.
+All filters except for -pattern and -regexp can also be inversed by prefixing with -not_.
+ -pattern: %|The message must match the given pattern. ? and * can be used as wildcards
+ -regexp: %|The message must match the given regexp. (see man perlre)
+ %|if -nocase is given as an option, the regexp or pattern is matched case insensitive
+ -tags: %|The servertag must be in the given list of tags
+ -channels: %|The event must be in one of the given list of channels.
+ Examples: %|-channels '#chan1 #chan2' or -channels 'IRCNet/#channel'
+ %|-channels 'EFNet/' means every channel on EFNet and is the same as -tags 'EFNet'
+ -masks: %|The person who triggers it must match one of the given list of masks
+ -hasmode: %|The person who triggers it must have the give mode
+ Examples: %|'-o' means not opped, '+ov' means opped OR voiced, '-o&-v' means not opped AND not voiced
+ -hasflag: %|Only trigger if friends.pl (friends_shasta.pl) or people.pl is loaded and the person who triggers it has the given flag in the script (same syntax as -hasmode)
+ -other_masks
+ -other_hasmode
+ -other_hasflag: %|Same as above but for the victim for kicks or mode_nick.
+ -prefix: %|For publics, match what prefix the message was sent to (eg statusmsg, +z). Space separated list, use '' to match only messages sent to no prefix (ie, plain publics only)
+ Examples: %|-prefix '@' matches messages sent to @#channel
+ %|-prefix '@ +' matches messages sent to @#channel or +#channel, but not @+#channel
+ %|-prefix '' matches only messages sent to #channel, not @#channel or any other
+
+%U%_What to do when it matches%_%U
+ -command: Execute the given Irssi-command
+ %|You are able to use $1, $2 and so on generated by your regexp pattern.
+ %|For multiple commands ; can be used as seperator
+ %|The following variables are also expanded:
+ $T: %|Server tag
+ $C: %|Channel name
+ $O: %|Your nick
+ $N: %|Nickname of the person who triggered this command
+ $A: %|His address (foo@bar.com),
+ $I: %|His ident (foo)
+ $H: %|His hostname (bar.com)
+ $M: %|The complete message
+ ${other}: %|The victim for kicks or mode_nick
+ ${mode_type}: %|The type ('+' or '-') for a mode_channel or mode_nick
+ ${mode_char}: %|The mode char ('o' for ops, 'b' for ban,...)
+ ${mode_arg} : %|The argument to the mode (if there is one)
+ %|$\X, with X being one of the above expands (e.g. $\M), escapes all non-alphanumeric characters, so it can be used with /eval or /exec. Don't use /eval or /exec without this, it's not safe.
+ -replace: %|replaces the matching part with the given replacement in the event (requires a -regexp or -pattern)
+ -once: %|remove the trigger if it is triggered, so it only executes once and then is forgotten.
+ -stop: %|stops the signal. It won't get displayed by Irssi. Like /IGNORE
+ -debug: %|print some debugging info
+ -last: %|Don't process any more triggers for this message
+
+%U%_Other options%_%U
+ -disabled: %|Same as removing it, but keeps it in case you might need it later
+ -name: %|Give the trigger a name. You can refer to the trigger with this name in add/del/change commands
+
+%U%_Examples%_%U
+ Knockout people who do a !list:
+ %#/TRIGGER ADD %|-publics -channels "#channel1 #channel2" -nocase -regexp ^!list -command "KN $N This is not a warez channel!"
+ React to !echo commands from people who are +o in your friends-script:
+ %#/TRIGGER ADD %|-publics -regexp '^!echo (.*)' -hasflag '+o' -command 'say echo: $1'
+ Ignore all non-ops on #channel:
+ %#/TRIGGER ADD %|-publics -actions -channels "#channel" -hasmode '-o' -stop
+ Send a mail to yourself every time a topic is changed:
+ %#/TRIGGER ADD %|-topics -command 'exec echo $\N changed topic of $\C to: $\M | mail you@somewhere.com -s topic'
+
+
+%U%_Examples with -replace%_%U
+ %|Replace every occurence of shit with sh*t, case insensitive:
+ %#/TRIGGER ADD %|-all -nocase -regexp shit -replace sh*t
+ %|Strip all colorcodes from *!lamer@*:
+ %#/TRIGGER ADD %|-all -masks *!lamer@* -regexp '\x03\d?\d?(,\d\d?)?|\x02|\x1f|\x16|\x06' -replace ''
+ %|Never let *!bot1@foo.bar or *!bot2@foo.bar hilight you
+ %|(this works by cutting your nick in 2 different parts, 'myn' and 'ick' here)
+ %|you don't need to understand the -replace argument, just trust that it works if the 2 parts separately don't hilight:
+ %#/TRIGGER ADD %|-all masks '*!bot1@foo.bar *!bot2@foo.bar' -regexp '(myn)(ick)' -nocase -replace '$1\x02\x02$2'
+ %|Avoid being hilighted by !top10 in eggdrops with stats.mod (but show your nick in bold):
+ %#/TRIGGER ADD %|-publics -regexp '(Top.0\(.*\): 1.*)(my)(nick)' -replace '$1\x02$2\x02\x02$3\x02'
+ %|Convert a Windows-1252 Euro to an ISO-8859-15 Euro (same effect as euro.pl):
+ %#/TRIGGER ADD %|-regexp '\x80' -replace '\xA4'
+ %|Show tabs as spaces, not the inverted I (same effect as tab_stop.pl):
+ %#/TRIGGER ADD %|-all -regexp '\t' -replace ' '
+SCRIPTHELP_EOF
+} # /
+
+my @triggers; # array of all triggers
+my %triggers_by_type; # hash mapping types on triggers of that type
+my $recursion_depth = 0;
+my $changed_since_last_save = 0;
+
+###############
+### formats ###
+###############
+
+Irssi::theme_register([
+ 'trigger_header' => 'Triggers:',
+ 'trigger_line' => '%#$[-4]0 $1',
+ 'trigger_added' => 'Trigger $0 added: $1',
+ 'trigger_not_found' => 'Trigger {hilight $0} not found',
+ 'trigger_saved' => 'Triggers saved to $0',
+ 'trigger_loaded' => 'Triggers loaded from $0'
+]);
+
+#########################################
+### catch the signals & do your thing ###
+#########################################
+
+# trigger types with a message and a channel
+my @allchanmsg_types = qw(publics pubactions pubnotices pubctcps pubctcpreplies parts kicks topics);
+# trigger types with a message
+my @allmsg_types = (@allchanmsg_types, qw(privmsgs privactions privnotices privctcps privctcpreplies dcc_msgs dcc_actions dcc_ctcps quits));
+# trigger types with a channel
+my @allchan_types = (@allchanmsg_types, qw(mode_channel mode_nick joins invites pubflood send_text));
+# trigger types in -all
+my @all_types = (@allmsg_types, qw(mode_channel mode_nick joins invites nick_changes));
+# trigger types that can use -masks
+my @mask_types = (@all_types, qw(notify_join notify_part notify_away notify_unaway notify_unidle));
+# trigger types with a server
+my @all_server_types = (@mask_types, qw(rawin pubflood privflood));
+# all trigger types
+my @trigger_types = (@all_server_types, qw(send_command send_text beep));
+#trigger types that are not in -all
+#my @notall_types = grep {my $a=$_; return (!grep {$_ eq $a} @all_types);} @trigger_types;
+my @notall_types = qw(rawin notify_join notify_part notify_away notify_unaway notify_unidle send_command send_text beep pubflood privflood);
+
+my @signals = (
+# "message public", SERVER_REC, char *msg, char *nick, char *address, char *target
+{
+ 'types' => ['publics'],
+ 'signal' => 'message public',
+ 'sub' => sub {check_signal_message(\@_,1,$_[0],$_[4],$_[2],$_[3],'publics');},
+},
+# "message irc op_public", SERVER_REC, char *msg, char *nick, char *address, char *target
+{
+ 'types' => ['publics'],
+ 'signal' => 'message irc op_public',
+ 'sub' => sub {
+ my ($prefix, $channel, $statusmsg);
+ $channel = $_[4];
+ $statusmsg = quotemeta($_[0]->isupport('statusmsg') // '@');
+ $channel =~ s/^([$statusmsg]+)//;
+ $prefix = $1;
+ check_signal_message(\@_,1,$_[0],$channel,$_[2],$_[3],'publics',{'prefix'=>$prefix});
+ },
+},
+# "message private", SERVER_REC, char *msg, char *nick, char *address
+{
+ 'types' => ['privmsgs'],
+ 'signal' => 'message private',
+ 'sub' => sub {check_signal_message(\@_,1,$_[0],undef,$_[2],$_[3],'privmsgs');},
+},
+# "message irc action", SERVER_REC, char *msg, char *nick, char *address, char *target
+{
+ 'types' => ['privactions','pubactions'],
+ 'signal' => 'message irc action',
+ 'sub' => sub {
+ if ($_[4] eq $_[0]->{nick}) {
+ check_signal_message(\@_,1,$_[0],undef,$_[2],$_[3],'privactions');
+ } else {
+ check_signal_message(\@_,1,$_[0],$_[4],$_[2],$_[3],'pubactions');
+ }
+ },
+},
+# "message irc notice", SERVER_REC, char *msg, char *nick, char *address, char *target
+{
+ 'types' => ['privnotices','pubnotices'],
+ 'signal' => 'message irc notice',
+ 'sub' => sub {
+ if ($_[4] eq $_[0]->{nick}) {
+ check_signal_message(\@_,1,$_[0],undef,$_[2],$_[3],'privnotices');
+ } else {
+ check_signal_message(\@_,1,$_[0],$_[4],$_[2],$_[3],'pubnotices');
+ }
+ }
+},
+# "message join", SERVER_REC, char *channel, char *nick, char *address
+{
+ 'types' => ['joins'],
+ 'signal' => 'message join',
+ 'sub' => sub {check_signal_message(\@_,-1,$_[0],$_[1],$_[2],$_[3],'joins');}
+},
+# "message part", SERVER_REC, char *channel, char *nick, char *address, char *reason
+{
+ 'types' => ['parts'],
+ 'signal' => 'message part',
+ 'sub' => sub {check_signal_message(\@_,4,$_[0],$_[1],$_[2],$_[3],'parts');}
+},
+# "message quit", SERVER_REC, char *nick, char *address, char *reason
+{
+ 'types' => ['quits'],
+ 'signal' => 'message quit',
+ 'sub' => sub {check_signal_message(\@_,3,$_[0],undef,$_[1],$_[2],'quits');}
+},
+# "message kick", SERVER_REC, char *channel, char *nick, char *kicker, char *address, char *reason
+{
+ 'types' => ['kicks'],
+ 'signal' => 'message kick',
+ 'sub' => sub {check_signal_message(\@_,5,$_[0],$_[1],$_[3],$_[4],'kicks',{'other'=>$_[2]});}
+},
+# "message topic", SERVER_REC, char *channel, char *topic, char *nick, char *address
+{
+ 'types' => ['topics'],
+ 'signal' => 'message topic',
+ 'sub' => sub {check_signal_message(\@_,2,$_[0],$_[1],$_[3],$_[4],'topics');}
+},
+# "message invite", SERVER_REC, char *channel, char *nick, char *address
+{
+ 'types' => ['invites'],
+ 'signal' => 'message invite',
+ 'sub' => sub {check_signal_message(\@_,-1,$_[0],$_[1],$_[2],$_[3],'invites');}
+},
+# "message nick", SERVER_REC, char *newnick, char *oldnick, char *address
+{
+ 'types' => ['nick_changes'],
+ 'signal' => 'message nick',
+ 'sub' => sub {check_signal_message(\@_,-1,$_[0],undef,$_[1],$_[3],'nick_changes',{'other'=>$_[2]});}
+},
+# "message dcc", DCC_REC *dcc, char *msg
+{
+ 'types' => ['dcc_msgs'],
+ 'signal' => 'message dcc',
+ 'sub' => sub {check_signal_message(\@_,1,$_[0]->{'server'},undef,$_[0]->{'nick'},undef,'dcc_msgs');
+ }
+},
+# "message dcc action", DCC_REC *dcc, char *msg
+{
+ 'types' => ['dcc_actions'],
+ 'signal' => 'message dcc action',
+ 'sub' => sub {check_signal_message(\@_,1,$_[0]->{'server'},undef,$_[0]->{'nick'},undef,'dcc_actions');}
+},
+# "message dcc ctcp", DCC_REC *dcc, char *cmd, char *data
+{
+ 'types' => ['dcc_ctcps'],
+ 'signal' => 'message dcc ctcp',
+ 'sub' => sub {check_signal_message(\@_,1,$_[0]->{'server'},undef,$_[0]->{'nick'},undef,'dcc_ctcps');}
+},
+# "server incoming", SERVER_REC, char *data
+{
+ 'types' => ['rawin'],
+ 'signal' => 'server incoming',
+ 'sub' => sub {check_signal_message(\@_,1,$_[0],undef,undef,undef,'rawin');}
+},
+# "send command", char *args, SERVER_REC, WI_ITEM_REC
+{
+ 'types' => ['send_command'],
+ 'signal' => 'send command',
+ 'sub' => sub {
+ sig_send_text_or_command(\@_,1);
+ }
+},
+# "send text", char *line, SERVER_REC, WI_ITEM_REC
+{
+ 'types' => ['send_text'],
+ 'signal' => 'send text',
+ 'sub' => sub {
+ sig_send_text_or_command(\@_,0);
+ }
+},
+# "beep"
+{
+ 'types' => ['beep'],
+ 'signal' => 'beep',
+ 'sub' => sub {check_signal_message(\@_,-1,undef,undef,undef,undef,'beep');}
+},
+# "event "<cmd>, SERVER_REC, char *args, char *sender_nick, char *sender_address
+{
+ 'types' => ['mode_channel', 'mode_nick'],
+ 'signal' => 'event mode',
+ 'sub' => sub {
+ my ($server, $event_args, $nickname, $address) = @_;
+ my ($target, $modes, $modeargs) = split(/ /, $event_args, 3);
+ return if (!$server->ischannel($target));
+ my (@modeargs) = split(/ /,$modeargs);
+ my ($pos, $type, $event_type, $arg) = (0, '+');
+ foreach my $char (split(//,$modes)) {
+ if ($char eq "+" || $char eq "-") {
+ $type = $char;
+ } else {
+ if ($char =~ /[Oovh]/) { # mode_nick
+ $event_type = 'mode_nick';
+ $arg = $modeargs[$pos++];
+ } elsif ($char =~ /[beIqdk]/ || ( $char =~ /[lfJ]/ && $type eq '+')) { # chan_mode with arg
+ $event_type = 'mode_channel';
+ $arg = $modeargs[$pos++];
+ } else { # chan_mode without arg
+ $event_type = 'mode_channel';
+ $arg = undef;
+ }
+ check_signal_message(\@_,-1,$server,$target,$nickname,$address,$event_type,{
+ 'mode_type' => $type,
+ 'mode_char' => $char,
+ 'mode_arg' => $arg,
+ 'other' => ($event_type eq 'mode_nick') ? $arg : undef
+ });
+ }
+ }
+ }
+},
+# "notifylist joined", SERVER_REC, char *nick, char *user, char *host, char *realname, char *awaymsg
+{
+ 'types' => ['notify_join'],
+ 'signal' => 'notifylist joined',
+ 'sub' => sub {check_signal_message(\@_, 5, $_[0], undef, $_[1], $_[2].'@'.$_[3], 'notify_join', {'realname' => $_[4]});}
+},
+{
+ 'types' => ['notify_part'],
+ 'signal' => 'notifylist left',
+ 'sub' => sub {check_signal_message(\@_, 5, $_[0], undef, $_[1], $_[2].'@'.$_[3], 'notify_left', {'realname' => $_[4]});}
+},
+{
+ 'types' => ['notify_unidle'],
+ 'signal' => 'notifylist unidle',
+ 'sub' => sub {check_signal_message(\@_, 5, $_[0], undef, $_[1], $_[2].'@'.$_[3], 'notify_unidle', {'realname' => $_[4]});}
+},
+{
+ 'types' => ['notify_away', 'notify_unaway'],
+ 'signal' => 'notifylist away changed',
+ 'sub' => sub {check_signal_message(\@_, 5, $_[0], undef, $_[1], $_[2].'@'.$_[3], ($_[5] ? 'notify_away' : 'notify_unaway'), {'realname' => $_[4]});}
+},
+# "ctcp msg", SERVER_REC, char *args, char *nick, char *addr, char *target
+{
+ 'types' => ['pubctcps', 'privctcps'],
+ 'signal' => 'ctcp msg',
+ 'sub' => sub {
+ my ($server, $args, $nick, $addr, $target) = @_;
+ if ($target eq $server->{'nick'}) {
+ check_signal_message(\@_, 1, $server, undef, $nick, $addr, 'privctcps');
+ } else {
+ check_signal_message(\@_, 1, $server, $target, $nick, $addr, 'pubctcps');
+ }
+ }
+},
+# "ctcp reply", SERVER_REC, char *args, char *nick, char *addr, char *target
+{
+ 'types' => ['pubctcpreplies', 'privctcpreplies'],
+ 'signal' => 'ctcp reply',
+ 'sub' => sub {
+ my ($server, $args, $nick, $addr, $target) = @_;
+ if ($target eq $server->{'nick'}) {
+ check_signal_message(\@_, 1, $server, undef, $nick, $addr, 'privctcpreplies');
+ } else {
+ check_signal_message(\@_, 1, $server, $target, $nick, $addr, 'pubctcpreplies');
+ }
+ }
+},
+# "flood", SERVER_REC, char *nick, char *host, int level, char *target
+{
+ 'types' => ['pubflood', 'privflood'],
+ 'signal' => 'flood',
+ 'sub' => sub {
+ my ($server, $nick, $host, $level, $target) = @_;
+ if ($target eq $server->{'nick'}) {
+ check_signal_message(\@_, -1, $server, undef, $nick, $host, 'privflood');
+ } else {
+ check_signal_message(\@_, -1, $server, $target, $nick, $host, 'pubflood');
+ }
+ }
+}
+);
+
+sub sig_send_text_or_command {
+ my ($signal, $iscommand) = @_;
+ my ($line, $server, $item) = @$signal;
+ my ($channelname,$nickname,$address) = (undef,undef,undef);
+ if ($item && (ref($item) eq 'Irssi::Irc::Channel' || ref($item) eq 'Irssi::Silc::Channel')) {
+ $channelname = $item->{'name'};
+ } elsif ($item && ref($item) eq 'Irssi::Irc::Query') { # TODO Silc query ?
+ $nickname = $item->{'name'};
+ $address = $item->{'address'}
+ }
+ # TODO pass context also for non-channels (queries and other stuff)
+ check_signal_message($signal,0,$server,$channelname,$nickname,$address,$iscommand ? 'send_command' : 'send_text');
+
+}
+
+my %filters = (
+'tags' => {
+ 'types' => \@all_server_types,
+ 'sub' => sub {
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
+
+ if (!defined($server)) {
+ return 0;
+ }
+ my $matches = 0;
+ foreach my $tag (split(/ /,$param)) {
+ if (lc($server->{'tag'}) eq lc($tag)) {
+ $matches = 1;
+ last;
+ }
+ }
+ return $matches;
+ }
+},
+'channels' => {
+ 'types' => \@allchan_types,
+ 'sub' => sub {
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
+
+ if (!defined($channelname) || !defined($server)) {
+ return 0;
+ }
+ my $matches = 0;
+ foreach my $trigger_channel (split(/ /,$param)) {
+ if (lc($channelname) eq lc($trigger_channel)
+ || lc($server->{'tag'}.'/'.$channelname) eq lc($trigger_channel)
+ || lc($server->{'tag'}.'/') eq lc($trigger_channel)) {
+ $matches = 1;
+ last; # this channel matches, stop checking channels
+ }
+ }
+ return $matches;
+ }
+},
+'masks' => {
+ 'types' => \@mask_types,
+ 'sub' => sub {
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
+ $address //= '';
+ return (defined($nickname) && defined($server) && $server->masks_match($param, $nickname, $address));
+ }
+},
+'other_masks' => {
+ 'types' => ['kicks', 'mode_nick', 'nick_changes'],
+ 'sub' => sub {
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
+ return 0 unless defined($extra->{'other'});
+ my $other_address = ($condition ne 'nick_changes') ? get_address($extra->{'other'}, $server, $channelname) : $address;
+ return defined($other_address) && $server->masks_match($param, $extra->{'other'}, $other_address);
+ }
+},
+'hasmode' => {
+ 'types' => \@all_types,
+ 'sub' => sub {
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
+ return hasmode($param, $nickname, $server, $channelname);
+ }
+},
+'other_hasmode' => {
+ 'types' => ['kicks', 'mode_nick'],
+ 'sub' => sub {
+ my ($param,$signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
+ return defined($extra->{'other'}) && hasmode($param, $extra->{'other'}, $server, $channelname);
+ }
+},
+'hasflag' => {
+ 'types' => \@all_types,
+ 'sub' => sub {
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
+ return 0 unless defined($nickname) && defined($address) && defined($server);
+ my $flags = get_flags ($server->{'chatnet'},$channelname,$nickname,$address);
+ return defined($flags) && check_modes($flags,$param);
+ }
+},
+'other_hasflag' => {
+ 'types' => ['kicks', 'mode_nick'],
+ 'sub' => sub {
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
+ return 0 unless defined($extra->{'other'});
+ my $other_address = get_address($extra->{'other'}, $server, $channelname);
+ return 0 unless defined($other_address);
+ my $flags = get_flags ($server->{'chatnet'},$channelname,$extra->{'other'},$other_address);
+ return defined($flags) && check_modes($flags,$param);
+ }
+},
+'mode_type' => {
+ 'types' => ['mode_channel', 'mode_nick'],
+ 'sub' => sub {
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
+ return (($param) eq $extra->{'mode_type'});
+ }
+},
+'mode_char' => {
+ 'types' => ['mode_channel', 'mode_nick'],
+ 'sub' => sub {
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
+ return (($param) eq $extra->{'mode_char'});
+ }
+},
+'mode_arg' => {
+ 'types' => ['mode_channel', 'mode_nick'],
+ 'sub' => sub {
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
+ return (($param) eq $extra->{'mode_arg'});
+ }
+},
+'prefix' => {
+ 'types' => ['publics'],
+ 'sub' => sub {
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
+
+ return 0 unless defined($extra->{'prefix'}) || $param eq '';
+ return 1 unless defined($extra->{'prefix'});
+
+ my $matches = 0;
+ foreach my $prefix (split(/ /, $param)) {
+ if ($extra->{'prefix'} eq $prefix) {
+ $matches = 1;
+ last;
+ }
+ }
+
+ return $matches;
+ }
+},
+);
+
+sub get_address {
+ my ($nick, $server, $channel) = @_;
+ my $nickrec = get_nickrec($nick, $server, $channel);
+ return $nickrec ? $nickrec->{'host'} : undef;
+}
+sub get_nickrec {
+ my ($nick, $server, $channel) = @_;
+ return unless defined($server) && defined($channel) && defined($nick);
+ my $chanrec = $server->channel_find($channel);
+ return $chanrec ? $chanrec->nick_find($nick) : undef;
+}
+
+sub hasmode {
+ my ($param, $nickname, $server, $channelname) = @_;
+ my $nickrec = get_nickrec($nickname, $server, $channelname);
+ return 0 unless defined $nickrec;
+ my $modes =
+ ($nickrec->{'op'} ? 'o' : '')
+ . ($nickrec->{'voice'} ? 'v' : '')
+ . ($nickrec->{'halfop'} ? 'h' : '')
+ ;
+ return check_modes($modes, $param);
+}
+
+# list of all switches
+my @trigger_switches = (@trigger_types, qw(all nocase stop once debug disabled last));
+# parameters (with an argument)
+my @trigger_params = qw(pattern regexp command replace name);
+# all options that can be used to set filters, including negative matches (not_<filter>)
+my @trigger_filter_options = map(($_,'not_'.$_), keys(%filters));
+# list of all options (including switches) for /TRIGGER ADD
+my @trigger_add_options = (@trigger_switches, @trigger_params, @trigger_filter_options);
+# same for /TRIGGER CHANGE, this includes the -no<option>'s
+my @trigger_options = map(($_,'no'.$_) ,@trigger_add_options);
+
+# check the triggers on $signal's $parammessage parameter, for triggers with $condition set
+# on $server in $channelname, for $nickname!$address
+# set $parammessage to -1 if the signal doesn't have a message
+# for signal without channel, nick or address, set to undef
+sub check_signal_message {
+ my ($signal, $parammessage, $server, $channelname, $nickname, $address, $condition, $extra) = @_;
+ my ($changed, $stopped, $context, $need_rebuild);
+ my $message = ($parammessage == -1) ? '' : $signal->[$parammessage];
+
+ return if (!$triggers_by_type{$condition});
+
+ if ($recursion_depth > 10) {
+ Irssi::print("Trigger error: Maximum recursion depth reached, aborting trigger.", MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ $recursion_depth++;
+
+TRIGGER:
+ foreach my $trigger (@{$triggers_by_type{$condition}}) {
+ # check filters
+ foreach my $trigfilter (filters_for_trigger($trigger)) {
+ my $filter_sub = $trigfilter->{'filter'}->{'sub'};
+ my $filter_matches = !!(&$filter_sub($trigfilter->{'param'}, $signal, $parammessage, $server, $channelname, $nickname, $address, $condition, $extra));
+ if ($filter_matches != $trigfilter->{'must_match'}) { # if it didn't match, or if it's a -not_* filter and it did match
+ next TRIGGER;
+ }
+ }
+
+ # check regexp (and keep matches in @- and @+, so don't make a this a {block})
+ next if ($trigger->{'compregexp'} && ($parammessage == -1 || $message !~ m/$trigger->{'compregexp'}/));
+
+ # if we got this far, it fully matched, and we need to do the replace/command/stop/once
+ my $expands;
+ if (defined($extra)) {
+ $expands = { %$extra };
+ } else {
+ $expands = { };
+ }
+ $expands->{'M'} = $message,;
+ $expands->{'T'} = (defined($server)) ? $server->{'tag'} : '';
+ $expands->{'C'} = $channelname;
+ $expands->{'O'} = (defined($server)) ? $server->{'nick'} : '';
+ $expands->{'N'} = $nickname;
+ $expands->{'A'} = $address;
+ $expands->{'I'} = ((!defined($address)) ? '' : substr($address,0,index($address,'@')));
+ $expands->{'H'} = ((!defined($address)) ? '' : substr($address,index($address,'@')+1));
+ $expands->{'$'} = '$';
+ $expands->{';'} = ';';
+
+ if (defined($trigger->{'replace'})) { # it's a -replace
+ $message =~ s/$trigger->{'compregexp'}/do_expands(0,$trigger->{'compreplace'},$expands,$message)/ge;
+ $changed = 1;
+ }
+
+ if ($trigger->{'command'}) { # it's a (nonempty) -command
+ my $command = $trigger->{'command'};
+ # $1 = the stuff behind the $ we want to expand: a number, or a character from %expands
+ $command = do_expands(1, $command, $expands, $message);
+
+ if (defined($server)) {
+ if (defined($channelname) && $server->channel_find($channelname)) {
+ $context = $server->channel_find($channelname);
+ } else {
+ $context = $server;
+ }
+ } else {
+ $context = undef;
+ }
+
+ if (defined($context)) {
+ $context->command("eval $command");
+ } else {
+ Irssi::command("eval $command");
+ }
+ }
+
+ if ($trigger->{'debug'}) {
+ print("DEBUG: trigger $condition pmesg=$parammessage message=$message server=$server->{tag} channel=$channelname nick=$nickname address=$address " . join(' ',map {$_ . '=' . $extra->{$_}} keys(%$extra)) . " trigger=" . to_string($trigger));
+ }
+
+ if ($trigger->{'stop'}) {
+ $stopped = 1;
+ }
+
+ if ($trigger->{'once'}) {
+ # find this trigger in the real trigger list, and remove it
+ for (my $realindex=0; $realindex < scalar(@triggers); $realindex++) {
+ if ($triggers[$realindex] == $trigger) {
+ splice (@triggers,$realindex,1);
+ last;
+ }
+ }
+ $need_rebuild = 1;
+ }
+ if ($trigger->{'last'}) {
+ last TRIGGER;
+ }
+ }
+
+ if ($need_rebuild) {
+ rebuild();
+ $changed_since_last_save = 1;
+ }
+ if ($stopped) { # stopped with -stop
+ signal_stop();
+ } elsif ($changed) { # changed with -replace
+ $signal->[$parammessage] = $message;
+ signal_continue(@$signal);
+ }
+ $recursion_depth--;
+}
+
+# return array of filters for the given trigger
+sub filters_for_trigger($) {
+ my ($trigger) = @_;
+ my $href = $trigger->{filters};
+ return @{$href}{ sort keys %$href };
+}
+
+# used in check_signal_message to expand $'s
+# $inthis is a string that can contain $ stuff (like 'foo$1bar$N')
+sub do_expands {
+ my ($escape, $inthis, $expands, $from) = @_;
+ # @+ and @- are copied because there are two s/// nested, and the inner needs the $1 and $2,... of the outer one
+ my @plus = @+;
+ my @min = @-;
+ my $p = \@plus; my $m = \@min;
+ $inthis =~ s/\$(\\*(\d+|[^0-9x{]|x[0-9a-fA-F][0-9a-fA-F]|{.*?}))/expand_and_escape($escape,$1,$expands,$m,$p,$from)/ge;
+ return $inthis;
+}
+
+# \ $ and ; may need extra escaping because we use eval for -command
+sub expand_and_escape {
+ my $escape = shift;
+ my $retval = expand(@_);
+ if ($escape) {
+ $retval =~ s/([\\\$;])/\\\1/g;
+ }
+ return $retval;
+}
+
+# used in do_expands (via expand_and_escape), to_expand is the part after the $
+sub expand {
+ my ($to_expand, $expands, $min, $plus, $from) = @_;
+ if ($to_expand =~ /^\d+$/) { # a number => look up in $vars
+ # from man perlvar:
+ # $3 is the same as "substr $var, $-[3], $+[3] - $-[3])"
+ return ($to_expand > @{$min} ? '' : substr($from,$min->[$to_expand],$plus->[$to_expand]-$min->[$to_expand]));
+ } elsif ($to_expand =~ s/^\\//) { # begins with \, so strip that from to_expand
+ my $exp = expand($to_expand,$expands,$min,$plus,$from); # first expand without \
+ $exp =~ s/([^a-zA-Z0-9])/\\\1/g; # escape non-word chars
+ return $exp;
+ } elsif ($to_expand =~ /^x([0-9a-fA-F]{2})/) { # $xAA
+ return chr(hex($1));
+ } elsif ($to_expand =~ /^{(.*?)}$/) { # ${foo}
+ return expand($1, $expands, $min, $plus, $from);
+ } else { # look up in $expands
+ return $expands->{$to_expand};
+ }
+}
+
+sub check_modes {
+ my ($has_modes, $need_modes) = @_;
+ my $matches;
+ my $switch = 1; # if a '-' if found, will be 0 (meaning the modes should not be set)
+ foreach my $need_mode (split /&/, $need_modes) {
+ $matches = 0;
+ foreach my $char (split //, $need_mode) {
+ if ($char eq '-') {
+ $switch = 0;
+ } elsif ($char eq '+') {
+ $switch = 1;
+ } elsif ((index($has_modes, $char) != -1) == $switch) {
+ $matches = 1;
+ last;
+ }
+ }
+ if (!$matches) {
+ return 0;
+ }
+ }
+ return 1;
+}
+
+# get someones flags from people.pl or friends(_shasta).pl
+sub get_flags {
+ my ($chatnet, $channel, $nick, $address) = @_;
+ my $flags;
+ no strict 'refs';
+ if (%{ 'Irssi::Script::people::' }) {
+ if (defined ($channel)) {
+ $flags = (&{ 'Irssi::Script::people::find_local_flags' }($chatnet,$channel,$nick,$address));
+ } else {
+ $flags = (&{ 'Irssi::Script::people::find_global_flags' }($chatnet,$nick,$address));
+ }
+ $flags = join('',keys(%{$flags}));
+ } else {
+ my $shasta;
+ if (%{ 'Irssi::Script::friends_shasta::' }) {
+ $shasta = 'friends_shasta';
+ } elsif (defined &{ 'Irssi::Script::friends::get_idx' }) {
+ $shasta = 'friends';
+ } else {
+ return undef;
+ }
+ my $idx = (&{ 'Irssi::Script::'.$shasta.'::get_idx' }($nick, $address));
+ if ($idx == -1) {
+ return '';
+ }
+ $flags = (&{ 'Irssi::Script::'.$shasta.'::get_friends_flags' }($idx,undef));
+ if ($channel) {
+ $flags .= (&{ 'Irssi::Script::'.$shasta.'::get_friends_flags' }($idx,$channel));
+ }
+ }
+ return $flags;
+}
+
+########################################################
+### internal stuff called by manage, needed by above ###
+########################################################
+
+my %mask_to_regexp = ();
+foreach my $i (0..255) {
+ my $ch = chr $i;
+ $mask_to_regexp{$ch} = "\Q$ch\E";
+}
+$mask_to_regexp{'?'} = '(.)';
+$mask_to_regexp{'*'} = '(.*)';
+
+sub compile_trigger {
+ my ($trigger) = @_;
+ my $regexp;
+
+ if ($trigger->{'regexp'}) {
+ $regexp = $trigger->{'regexp'};
+ } elsif ($trigger->{'pattern'}) {
+ $regexp = $trigger->{'pattern'};
+ $regexp =~ s/(.)/$mask_to_regexp{$1}/g;
+ } else {
+ delete $trigger->{'compregexp'};
+ return;
+ }
+
+ if ($trigger->{'nocase'}) {
+ $regexp = '(?i)' . $regexp;
+ }
+
+ $trigger->{'compregexp'} = qr/$regexp/;
+
+ if(defined($trigger->{'replace'})) {
+ (my $replace = $trigger->{'replace'}) =~ s/\$/\$\$/g;
+ $trigger->{'compreplace'} = Irssi::parse_special($replace);
+ }
+}
+
+# rebuilds triggers_by_type and updates signal binds
+sub rebuild {
+ %triggers_by_type = ();
+ foreach my $trigger (@triggers) {
+ if (!$trigger->{'disabled'}) {
+ if ($trigger->{'all'}) {
+ # -all is an alias for all types in @all_types for which the filters can apply
+ALLTYPES:
+ foreach my $type (@all_types) {
+ # check if all filters can apply to $type
+ foreach my $trigfilter (filters_for_trigger($trigger)) {
+ if (! grep {$_ eq $type} @{$trigfilter->{'filter'}->{'types'}}) {
+ next ALLTYPES;
+ }
+ }
+ push @{$triggers_by_type{$type}}, ($trigger);
+ }
+ }
+
+ foreach my $type ($trigger->{'all'} ? @notall_types : @trigger_types) {
+ if ($trigger->{$type}) {
+ push @{$triggers_by_type{$type}}, ($trigger);
+ }
+ }
+ }
+ }
+
+ foreach my $signal (@signals) {
+ my $should_bind = 0;
+ foreach my $type (@{$signal->{'types'}}) {
+ if (defined($triggers_by_type{$type})) {
+ $should_bind = 1;
+ }
+ }
+ if ($should_bind && !$signal->{'bind'}) {
+ signal_add_first($signal->{'signal'}, $signal->{'sub'});
+ $signal->{'bind'} = 1;
+ } elsif (!$should_bind && $signal->{'bind'}) {
+ signal_remove($signal->{'signal'}, $signal->{'sub'});
+ $signal->{'bind'} = 0;
+ }
+ }
+}
+
+################################
+### manage the triggers-list ###
+################################
+
+my $trigger_file; # cached setting
+
+sub sig_setup_changed {
+ $trigger_file = Irssi::settings_get_str('trigger_file');
+}
+
+sub autosave {
+ cmd_save() if ($changed_since_last_save);
+}
+
+# TRIGGER SAVE
+sub cmd_save {
+ my $io = new IO::File $trigger_file, "w";
+ if (defined $io) {
+ $io->print("#Triggers file version $VERSION\n");
+ foreach my $trigger (@triggers) {
+ $io->print(to_string($trigger) . "\n");
+ }
+ $io->close;
+ }
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'trigger_saved', $trigger_file);
+ $changed_since_last_save = 0;
+}
+
+# save on unload
+sub UNLOAD {
+ cmd_save();
+}
+
+# TRIGGER LOAD
+sub cmd_load {
+ sig_setup_changed(); # make sure we've read the trigger_file setting
+ my $converted = 0;
+ my $io = new IO::File $trigger_file, "r";
+ if (not defined $io) {
+ if (-e $trigger_file) {
+ Irssi::print("Error opening triggers file", MSGLEVEL_CLIENTERROR);
+ }
+ return;
+ }
+ if (defined $io) {
+ @triggers = ();
+ my $text;
+ $text = $io->getline;
+ my $file_version = '';
+ if ($text =~ /^#Triggers file version (.*)\n/) {
+ $file_version = $1;
+ }
+ if ($file_version lt '0.6.1+2') {
+ no strict 'vars';
+ $text .= $_ foreach ($io->getlines);
+ my $rep = eval "$text";
+ if (! ref $rep) {
+ Irssi::print("Error in triggers file");
+ return;
+ }
+ my @old_triggers = @$rep;
+
+ for (my $index=0;$index < scalar(@old_triggers);$index++) {
+ my $trigger = $old_triggers[$index];
+
+ if ($file_version lt '0.6.1') {
+ # convert old names: notices => pubnotices, actions => pubactions
+ foreach $oldname ('notices','actions') {
+ if ($trigger->{$oldname}) {
+ delete $trigger->{$oldname};
+ $trigger->{'pub'.$oldname} = 1;
+ $converted = 1;
+ }
+ }
+ }
+ if ($file_version lt '0.6.1+1' && $trigger->{'modifiers'}) {
+ if ($trigger->{'modifiers'} =~ /i/) {
+ $trigger->{'nocase'} = 1;
+ Irssi::print("Trigger: trigger ".($index+1)." had 'i' in it's modifiers, it has been converted to -nocase");
+ }
+ if ($trigger->{'modifiers'} !~ /^[ig]*$/) {
+ Irssi::print("Trigger: trigger ".($index+1)." had unrecognised modifier '". $trigger->{'modifiers'} ."', which couldn't be converted.");
+ }
+ delete $trigger->{'modifiers'};
+ $converted = 1;
+ }
+
+ # convert to text with compat, and then to new trigger hash
+ $text = to_string($trigger,1);
+ my @args = &shellwords($text . ' a');
+ my $trigger = parse_options({},@args);
+ if ($trigger) {
+ push @triggers, $trigger;
+ }
+ }
+ } else { # new format
+ while ( $text = $io->getline ) {
+ chop($text);
+ next if ($text =~ /^[ ]*$|^#/);
+ my @args = &shellwords($text . ' a');
+ my $trigger = parse_options({},@args);
+ if ($trigger) {
+ push @triggers, $trigger;
+ }
+ }
+ }
+ }
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'trigger_loaded', $trigger_file);
+ if ($converted) {
+ Irssi::print("Trigger: Triggers file will be in new format next time it's saved.");
+ }
+ rebuild();
+}
+
+# escape for printing with to_string
+# <<abcdef>> => << 'abcdef' >>
+# <<abc'def>> => << "abc'def" >>
+# <<abc'def\x02>> => << 'abc'\''def\x02' >>
+sub param_to_string {
+ my ($text) = @_;
+ # avoid ugly escaping if we can use "-quotes without other escaping (no " or \)
+ if ($text =~ /^[^"\\]*'[^"\\]$/) {
+ return ' "' . $text . '" ';
+ }
+ # "'" signs without a (odd number of) \ in front of them, need be to escaped as '\''
+ # this is ugly :(
+ $text =~ s/(^|[^\\](\\\\)*)'/$1'\\''/g;
+ return " '$text' ";
+}
+
+# converts a trigger back to "-switch -options 'foo'" form
+# if $compat, $trigger is in the old format (used to convert)
+sub to_string {
+ my ($trigger, $compat) = @_;
+ my $string;
+
+ foreach my $switch (@trigger_switches) {
+ if ($trigger->{$switch}) {
+ $string .= '-'.$switch.' ';
+ }
+ }
+
+ if ($compat) {
+ foreach my $filter (sort keys(%filters)) {
+ if ($trigger->{$filter}) {
+ $string .= '-' . $filter . param_to_string($trigger->{$filter});
+ }
+ }
+ } else {
+ foreach my $trigfilter (filters_for_trigger($trigger)) {
+ $string .= '-' . $trigfilter->{'option'} . param_to_string($trigfilter->{'param'});
+ }
+ }
+
+ foreach my $param (@trigger_params) {
+ if ($trigger->{$param} || ($param eq 'replace' && defined($trigger->{'replace'}))) {
+ $string .= '-' . $param . param_to_string($trigger->{$param});
+ }
+ }
+ $string =~ s/\s+$//;
+ return $string;
+}
+
+# find a trigger (for REPLACE and DELETE), returns index of trigger, or -1 if not found
+sub find_trigger {
+ my ($data) = @_;
+ if ($data =~ /^[0-9]*$/ and defined($triggers[$data-1])) {
+ return $data-1;
+ } else {
+ for (my $i=0; $i < scalar(@triggers); $i++) {
+ if ($triggers[$i]->{'name'} eq $data) {
+ return $i;
+ }
+ }
+ }
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'trigger_not_found', $data);
+ return -1; # not found
+}
+
+
+# TRIGGER ADD <options>
+sub cmd_add {
+ my ($data, $server, $item) = @_;
+ my @args = shellwords($data . ' a');
+
+ my $trigger = parse_options({}, @args);
+ if ($trigger) {
+ push @triggers, $trigger;
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'trigger_added', scalar(@triggers), to_string($trigger));
+ rebuild();
+ $changed_since_last_save = 1;
+ }
+}
+
+# TRIGGER CHANGE <nr> <options>
+sub cmd_change {
+ my ($data, $server, $item) = @_;
+ my @args = shellwords($data . ' a');
+ my $index = find_trigger(shift @args);
+ if ($index != -1) {
+ if(parse_options($triggers[$index], @args)) {
+ Irssi::print("Trigger " . ($index+1) ." changed to: ". to_string($triggers[$index]));
+ }
+ rebuild();
+ $changed_since_last_save = 1;
+ }
+}
+
+# parses options for TRIGGER ADD and TRIGGER CHANGE
+# if invalid args returns undef, else changes $thetrigger and returns it
+sub parse_options {
+ my ($thetrigger,@args) = @_;
+ my ($trigger, $option);
+
+ if (pop(@args) ne 'a') {
+ Irssi::print("Syntax error, probably missing a closing quote", MSGLEVEL_CLIENTERROR);
+ return undef;
+ }
+
+ %$trigger = %$thetrigger; # make a copy to prevent changing the given trigger if args doesn't parse
+ARGS: for (my $arg = shift @args; $arg; $arg = shift @args) {
+ # expand abbreviated options, put in $option
+ $arg =~ s/^-//;
+ $option = undef;
+ foreach my $ioption (@trigger_options) {
+ if (index($ioption, $arg) == 0) { # -$opt starts with $arg
+ if ($option) { # another already matched
+ Irssi::print("Ambiguous option: $arg", MSGLEVEL_CLIENTERROR);
+ return undef;
+ }
+ $option = $ioption;
+ last if ($arg eq $ioption); # exact match is unambiguous
+ }
+ }
+ if (!$option) {
+ Irssi::print("Unknown option: $arg", MSGLEVEL_CLIENTERROR);
+ return undef;
+ }
+
+ # -<param> <value> or -no<param>
+ foreach my $param (@trigger_params) {
+ if ($option eq $param) {
+ $trigger->{$param} = shift @args;
+ next ARGS;
+ }
+ if ($option eq 'no'.$param) {
+ $trigger->{$param} = undef;
+ next ARGS;
+ }
+ }
+
+ # -[no]<switch>
+ foreach my $switch (@trigger_switches) {
+ # -<switch>
+ if ($option eq $switch) {
+ $trigger->{$switch} = 1;
+ next ARGS;
+ }
+ # -no<switch>
+ elsif ($option eq 'no'.$switch) {
+ $trigger->{$switch} = undef;
+ next ARGS;
+ }
+ }
+
+ # -[not_]<filter> <value>
+ if ($option =~ /^(not_)?(.*)$/ && $filters{$2}) {
+ $trigger->{'filters'}->{$option} = {
+ option => $option,
+ must_match => ($1 ne 'not_'), # if false, trigger must only be done if filter sub returns false
+ filter_name => $2,
+ filter => $filters{$2},
+ param => shift @args
+ };
+
+ next ARGS;
+ }
+
+ # -no<filter>
+ if ($option =~ /^no((not_)?(.*))$/ && $filters{$3}) {
+ delete $trigger->{'filters'}->{$1};
+ }
+ }
+
+ if (defined($trigger->{'replace'}) && ! $trigger->{'regexp'} && !$trigger->{'pattern'}) {
+ Irssi::print("Trigger error: Can't have -replace without -regexp", MSGLEVEL_CLIENTERROR);
+ return undef;
+ }
+
+ if ($trigger->{'pattern'} && $trigger->{'regexp'}) {
+ Irssi::print("Trigger error: Can't have -pattern and -regexp in same trigger", MSGLEVEL_CLIENTERROR);
+ return undef;
+ }
+
+ # remove types that are implied by -all
+ if ($trigger->{'all'}) {
+ foreach my $type (@all_types) {
+ delete $trigger->{$type};
+ }
+ }
+
+ # remove types for which the filters don't apply
+ foreach my $type (@trigger_types) {
+ if ($trigger->{$type}) {
+ foreach my $trigfilter (filters_for_trigger($trigger)) {
+ if (!grep {$_ eq $type} @{$trigfilter->{'filter'}->{'types'}}) {
+ Irssi::print("Warning: the filter -" . $trigfilter->{'option'} . " can't apply to an event of type -$type, so I'm removing that type from this trigger.");
+ delete $trigger->{$type};
+ }
+ }
+ }
+ }
+
+ # check if it has at least one type
+ my $has_a_type;
+ foreach my $type (@trigger_types) {
+ if ($trigger->{$type}) {
+ $has_a_type = 1;
+ last;
+ }
+ }
+ if (!$has_a_type && !$trigger->{'all'}) {
+ Irssi::print("Warning: this trigger doesn't trigger on any type of message. you probably want to add -publics or -all");
+ }
+
+ compile_trigger($trigger);
+ %$thetrigger = %$trigger; # copy changes to real trigger
+ return $thetrigger;
+}
+
+# TRIGGER DELETE <num>
+sub cmd_del {
+ my ($data, $server, $item) = @_;
+ my @args = shellwords($data);
+ my $index = find_trigger(shift @args);
+ if ($index != -1) {
+ Irssi::print("Deleted ". ($index+1) .": ". to_string($triggers[$index]));
+ splice (@triggers,$index,1);
+ rebuild();
+ $changed_since_last_save = 1;
+ }
+}
+
+# TRIGGER MOVE <num> <num>
+sub cmd_move {
+ my ($data, $server, $item) = @_;
+ my @args = &shellwords($data);
+ my $index = find_trigger(shift @args);
+ if ($index != -1) {
+ my $newindex = find_trigger(shift @args);
+ if ($newindex != -1) {
+ Irssi::print("Moved from " . ($index+1) . " to " . ($newindex+1) . ": " . to_string($triggers[$index]));
+ my $trigger = splice (@triggers,$index,1); # remove from old place
+ splice (@triggers,$newindex,0,($trigger)); # insert at new place
+ rebuild();
+ $changed_since_last_save = 1;
+ }
+ }
+}
+
+# TRIGGER LIST
+sub cmd_list {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'trigger_header');
+ my $i=1;
+ foreach my $trigger (@triggers) {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'trigger_line', $i++, to_string($trigger));
+ }
+}
+
+######################
+### initialisation ###
+######################
+
+command_bind('trigger help',\&cmd_help);
+command_bind('help trigger',\&cmd_help);
+command_bind('trigger add',\&cmd_add);
+command_bind('trigger change',\&cmd_change);
+command_bind('trigger move',\&cmd_move);
+command_bind('trigger list',\&cmd_list);
+command_bind('trigger delete',\&cmd_del);
+command_bind('trigger save',\&cmd_save);
+command_bind('trigger reload',\&cmd_load);
+command_bind 'trigger' => sub {
+ my ( $data, $server, $item ) = @_;
+ $data =~ s/\s+$//g;
+ command_runsub('trigger', $data, $server, $item);
+};
+
+Irssi::signal_add('setup saved', \&autosave);
+Irssi::signal_add('setup changed', \&sig_setup_changed);
+
+# This makes tab completion work
+Irssi::command_set_options('trigger add',join(' ',@trigger_add_options));
+Irssi::command_set_options('trigger change',join(' ',@trigger_options));
+
+Irssi::settings_add_str($IRSSI{'name'}, 'trigger_file', Irssi::get_irssi_dir()."/triggers");
+
+cmd_load();
diff --git a/scripts/trustweb.pl b/scripts/trustweb.pl
new file mode 100644
index 0000000..0fb60ba
--- /dev/null
+++ b/scripts/trustweb.pl
@@ -0,0 +1,374 @@
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "2003020801";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "TrustWeb",
+ description => "Illustrates the trust between ops",
+ license => "GPLv2",
+ modules => "Data::Dumper IO::File POSIX",
+ changed => "$VERSION",
+ commands => "trustweb"
+);
+
+
+use Irssi 20020324;
+use Irssi::TextUI;
+use Data::Dumper;
+use IO::File;
+use POSIX;
+use vars qw(%database);
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ } $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub show_help() {
+ my $help = $IRSSI{name}." ".$VERSION."
+/trustweb help
+ Display this help
+/trustweb save/load
+ Load or save the database
+/trustweb show <nick>
+ Display the trust for <nick>
+/trustweb scan
+ Scan all buffers for modechanges
+/trustweb trace <nick1> <nick2>
+ Search the shortest connection between two nicks
+/trustweb merge <nick1> <nick2>
+ Move all trustdata from nick1 to nick2
+";
+ my $text = "";
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP draw_box($IRSSI{name}, $text, "Help", 1);
+}
+
+
+sub save_db {
+ my $filename = Irssi::settings_get_str('trustweb_db_file');
+ my $io = new IO::File $filename, "w";
+ if (defined $io) {
+ my $dumper = Data::Dumper->new([\%database]);
+ $dumper->Purity(1)->Deepcopy(1);
+ $io->print($dumper->Dump);
+ $io->close;
+ }
+ print CLIENTCRAP "%B>>%n Trustweb database saved to ".$filename;
+}
+
+sub load_db {
+ my $filename = Irssi::settings_get_str('trustweb_db_file');
+ my $io = new IO::File $filename, "r";
+ if (defined $io) {
+ no strict 'vars';
+ my $text;
+ $text .= $_ foreach ($io->getlines);
+ my $database = eval "$text";
+ %database = %$database if ref $database;
+ }
+ print CLIENTCRAP "%B>>%n Trustweb database loaded from ".$filename;
+}
+
+sub scan_buffers {
+ foreach my $channel (Irssi::channels()) {
+ my $win = $channel->window();
+ my $name = $channel->{name};
+ my $server = $channel->{server};
+ my $view = $win->view();
+ my $line = $view->get_lines();
+ my $lines = 0;
+ while (defined $line) {
+ my $text = $line->get_text(0);
+ if ($line->{info}{level} == 2048) {
+ if ($text =~ /\[([\+\-].*?)\] by (.*)/) {
+ sig_message_irc_mode($server, $name, $2, undef, $1);
+ }
+ }
+ $line = $line->next;
+ $lines++;
+ }
+ }
+}
+
+sub sig_message_irc_mode ($$$$$) {
+ my ($server, $channel, $nick, $addr, $mode) = @_;
+ return if ($nick =~ /\./);
+ my $state;
+ my @pipe;
+ my %result;
+ my $tag = lc $server->{tag};
+ my ($modes, $nicks) = split(/ /, $mode, 2);
+ foreach (split(//, $modes)) {
+ if ($_ eq '+' || $_ eq '-') {
+ $state = $_;
+ } else {
+ push @pipe, $state.$_;
+ }
+ }
+
+ foreach (split(/ /, $nicks)) {
+ my $change = shift(@pipe);
+ if ($change eq '+o') {
+ foreach my $active (split /, ?/, $nick) {
+ $database{$tag}{lc $active}{lc $_} = 1;
+ }
+ } elsif ($change eq '-o') {
+ foreach my $active (split /, ?/, $nick) {
+ $database{$tag}{lc $active}{lc $_} = -1;
+ }
+ }
+ }
+}
+
+sub sig_nicklist_changed ($$$) {
+ my ($channel, $nick, $old) = @_;
+ my $server = $channel->{server};
+ my $new = lc $nick->{nick};
+ my $tag = lc $server->{tag};
+ merge_nicks($tag, $old, $new);
+}
+
+sub merge_nicks ($$$) {
+ my ($tag, $old, $new) = @_;
+ $tag = lc $tag;
+ $new = lc $new;
+ $old = lc $old;
+ return if $old eq $new;
+ if (defined $database{$tag}{$old}) {
+ foreach (keys %{ $database{$tag}{$old} }) {
+ $database{$tag}{$new}{$_} = $database{$tag}{$old}{$_};
+ }
+ delete $database{$tag}{$old}
+ }
+ foreach (keys %{ $database{$tag} }) {
+ if (defined $database{$tag}{$_}{$old}) {
+ $database{$tag}{$_}{$new} = $database{$tag}{$_}{$old};
+ delete $database{$tag}{$_}{$old};
+ }
+ }
+}
+
+sub show_trust ($$) {
+ my ($nicks, $tag) = @_;
+ my $text;
+ foreach (@$nicks) {
+ $text .= draw_trust($_, $tag);
+ }
+ print CLIENTCRAP &draw_box('TrustWeb', $text, $tag, 1);
+}
+
+sub draw_trust ($$) {
+ my ($nick, $tag) = @_;
+ my (@opfrom, @opto);
+ my $text;
+ #return unless $database{$nick};
+ my ($maxfrom, $maxto) = (0, 0);
+ my $distrust = Irssi::settings_get_bool('trustweb_show_distrust');
+ foreach (sort keys %{ $database{$tag} }) {
+ next unless defined $database{$tag}{$_}{lc $nick};
+ push @opfrom, [$_,1] if $database{$tag}{$_}{lc $nick} > 0;
+ push @opfrom, [$_,-1] if ($database{$tag}{$_}{lc $nick} < 0 && $distrust);
+ $maxfrom = length($_) if length($_) > $maxfrom;
+ }
+ if (defined $database{$tag}{lc $nick}) {
+ foreach (sort keys %{$database{$tag}{lc $nick}}) {
+ push @opto, [$_,1] if $database{$tag}{lc $nick}{$_} > 0;
+ push @opto, [$_,-1] if ($database{$tag}{lc $nick}{$_} < 0 && $distrust);
+ $maxto = length($_) if length($_) > $maxto;
+ }
+ }
+ my $items = @opfrom > @opto ? @opfrom-1 : @opto-1;
+ my $i = 0;
+ my $center = sprintf("%.0f", $items/2);
+ $center = @opfrom-1 if (@opfrom && not(defined $opfrom[$center]));
+ $center = @opto-1 if (@opto && not(defined $opto[$center]));
+ foreach (0..$items) {
+ my $line;
+ if (defined $opfrom[$_]) {
+ $line .= '<'.$opfrom[$_][0];
+ $line .= ' ' x ($maxfrom - length($opfrom[$_][0]));
+ $line .= '>';
+ $line .= '-' if $opfrom[$_][1] > 0;
+ $line .= '%' if $opfrom[$_][1] < 0;
+ $line .= "," if $_ < $center;
+ $line .= "+" if $_ == $center;
+ $line .= "'" if $_ > $center;
+ } else {
+ $line .= ' ' x ($maxfrom+4) if $maxfrom;
+ }
+ if ($_ == $center) {
+ $line .= '-' if @opfrom;
+ $line .= '(%9'.$nick.'%9)';
+ $line .= '-' if @opto;
+ } else {
+ $line .= ' ' if @opfrom;
+ $line .= ' ' x (length($nick)+2);
+ $line .= ' ' if @opto;
+ }
+ if (defined $opto[$_]) {
+ $line .= "," if $_ < $center;
+ $line .= "+" if $_ == $center;
+ $line .= "'" if $_ > $center;
+ $line .= '-' if $opto[$_][1] > 0;
+ $line .= '%' if $opto[$_][1] < 0;
+ $line .= '<'.$opto[$_][0];
+ $line .= ' ' x ($maxto - length($opto[$_][0]));
+ $line .= '>';
+ } else {
+ $line .= ' ' x ($maxto+4) if $maxto;
+ }
+ $text .= $line."\n";
+ $i++;
+ }
+ return $text;
+}
+
+sub bg_trace ($$$) {
+ my ($tag, $from, $to) = @_;
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ my $pid = fork();
+ if ($pid > 0) {
+ close $wh;
+ Irssi::pidwait_add($pid);
+ my $pipetag;
+ my @args = ($tag, $from, $to, $rh, \$pipetag);
+ $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
+ } else {
+ my $result = walk($from, $to, $database{$tag}, {}, [], [], 0);
+ my $dumper = Data::Dumper->new([$result]);
+ $dumper->Purity(1)->Deepcopy(1);
+ print($wh $dumper->Dump());
+ close $wh;
+ POSIX::_exit(1);
+ }
+}
+
+sub pipe_input ($) {
+ my ($tag, $from, $to, $rh, $pipetag) = @{$_[0]};
+ my $text;
+ $text .= $_ foreach (<$rh>);
+ close($rh);
+ Irssi::input_remove($$pipetag);
+ no strict 'vars';
+ my $result = eval "$text";
+ draw_trace($tag, $from, $to, $result);
+}
+
+sub walk ($$$$$$) {
+ my ($pos, $goal, $data, $visited, $street, $ideal) = @_;
+ my @road = @$street;
+
+ return $ideal if $visited->{$pos};
+ return $ideal if (@$ideal && not(Irssi::settings_get_bool('trustweb_trace_find_shortest_path')));
+ return \@road if ($pos eq $goal);
+ return $ideal if (@$ideal && @$street >= @$ideal);
+ return $ideal if (Irssi::settings_get_int('trustweb_trace_max_depth') && @road > Irssi::settings_get_int('trustweb_trace_max_depth'));
+
+ $visited->{$pos} = 1;
+ my $nodistrust = not Irssi::settings_get_bool('trustweb_trace_distrust');
+ foreach (keys %{ $data->{$pos} }) {
+ next if ($data->{$pos}{$_} < 1 && $nodistrust);
+ push @road, [ $_, 1, $data->{$pos}{$_} ];
+ $ideal = walk($_, $goal, $data, $visited, \@road, $ideal);
+ pop @road;
+ }
+ foreach (keys %$data) {
+ next unless defined $data->{$_}{$pos};
+ next if ($data->{$_}{$_} < 1 && $nodistrust);
+ push @road, [ $_, 0, $data->{$_}{$pos} ];
+ $ideal = walk($_, $goal, $data, $visited, \@road, $ideal);
+ pop @road;
+ }
+ $visited->{$pos} = 0;
+ return $ideal;
+}
+
+
+sub draw_trace ($$$$) {
+ my ($tag, $from, $to, $route) = @_;
+ my $line = "%B<<%n ";
+ if (ref $route && @$route) {
+ $line .= $from;
+ foreach (@$route) {
+ if ($_->[1]) {
+ $line .= ' ';
+ $line .= $_->[2] > 0 ? '=' : '%%';
+ $line .= '> ';
+ } else {
+ $line .= ' <';
+ $line .= $_->[2] > 0 ? '=' : '%';
+ $line .= ' ';
+ }
+ $line .= $_->[0];
+ }
+ } else {
+ $line .= "No connection between ".$from." and ".$to." could be found.";
+ }
+ print $line;
+}
+
+sub pre_unload {
+ save_db();
+}
+
+sub cmd_trustweb ($$$) {
+ my ($args, $server, $witem) = @_;
+ my $tag = ref $server ? lc $server->{tag} : lc Irssi::settings_get_str('trustweb_default_ircnet');
+ my @arg = split(/ +/, $args);
+ if (not(@arg) || $arg[0] eq 'help') {
+ show_help();
+ } elsif ($arg[0] eq 'scan') {
+ scan_buffers();
+ print CLIENTCRAP "%R>>%n All buffers scanned for modes";
+ } elsif ($arg[0] eq 'show' && defined $arg[1]) {
+ shift @arg;
+ show_trust(\@arg, $tag);
+ } elsif ($arg[0] eq 'save') {
+ save_db;
+ } elsif ($arg[0] eq 'load') {
+ load_db;
+ } elsif ($arg[0] eq 'trace' && defined $arg[1] && defined $arg[2]) {
+ bg_trace($tag, lc $arg[1], lc $arg[2]);
+ print CLIENTCRAP "%B>>%n Searching connection between ".$arg[1]." and ".$arg[2]."...";
+ } elsif ($arg[0] eq 'merge' && defined $arg[1] && defined $arg[2]) {
+ return unless ref $server;
+ merge_nicks($server->{tag}, $arg[1], $arg[2]);
+ print CLIENTCRAP "%B>>%n '".$arg[1]."' has been merged with '".$arg[2]."'";
+ }
+}
+
+Irssi::settings_add_str($IRSSI{name}, 'trustweb_default_ircnet', '');
+Irssi::settings_add_str($IRSSI{name}, 'trustweb_db_file', Irssi::get_irssi_dir()."/trustweb_database");
+Irssi::settings_add_bool($IRSSI{name}, 'trustweb_show_distrust' , 1);
+
+Irssi::settings_add_bool($IRSSI{name}, 'trustweb_trace_distrust' , 1);
+Irssi::settings_add_bool($IRSSI{name}, 'trustweb_trace_find_shortest_path' , 1);
+Irssi::settings_add_int($IRSSI{name}, 'trustweb_trace_max_depth' , 0);
+
+Irssi::signal_add('setup saved', 'save_db');
+Irssi::signal_add('message irc mode', \&sig_message_irc_mode);
+Irssi::signal_add_first('nicklist changed', \&sig_nicklist_changed);
+
+Irssi::command_bind('trustweb', \&cmd_trustweb);
+
+foreach my $cmd ('save', 'load', 'scan', 'show', 'help', 'trace', 'merge') {
+ Irssi::command_bind('trustweb '.$cmd =>
+ sub { cmd_trustweb("$cmd ".$_[0], $_[1], $_[2]); } );
+}
+
+load_db();
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /trustweb help for help';
diff --git a/scripts/tvmusor.pl b/scripts/tvmusor.pl
new file mode 100644
index 0000000..42cd342
--- /dev/null
+++ b/scripts/tvmusor.pl
@@ -0,0 +1,143 @@
+#!/usr/pkg/bin/perl
+#
+# $Id: porthu-irssi.pl,v 1.7 2003/06/14 21:14:46 bigmac Exp $
+#
+# Irssi Client for PORT.HU
+# Copyright (C) 2003, Gabor Nyeki (bigmac@home.sirklabs.hu).
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. Neither the name of the author nor the names of its contributors
+# may be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use IO::Socket;
+
+use vars qw($VERSION %IRSSI);
+use vars %IRSSI;
+%IRSSI = (
+ authors => "Gabor Nyeki",
+ contact => "bigmac\@home.sirklabs.hu",
+ name => "tvmusor",
+ description => "asks for the current tv-lineup from http://www.port.hu/",
+ license => "BSDL",
+ changed => "Tue Jun 3 18:48:02 CEST 2003"
+);
+
+my %chans = (
+ m1 => "1",
+ m2 => "2",
+ dunatv => "6",
+ tv2 => "3",
+ rtlklub => "5",
+ viasat3 => "21",
+ fixtv => "96",
+ spektrum => "9",
+ hbo => "8",
+ atv => "15"
+);
+
+
+sub tvmusor {
+ my ($args) = @_;
+
+ split / /, $args;
+ my $chan = @_[0];
+ my $list = @_[1];
+
+ if (!$chan) {
+ Irssi::print "Hasznalat: /tvmusor list|csatorna [lista hossza]";
+ return;
+ }
+ if ($chan eq "list") {
+ Irssi::print "Elerheto csatornak listaja:";
+ foreach my $buf (sort(keys %chans)) {
+ Irssi::print "-> $buf";
+ }
+ return;
+ }
+
+ if (!$chans{$chan}) {
+ Irssi::print "$chan nem letezik!";
+ return;
+ }
+
+ my $num;
+ if (!$list) {
+ $num = 5;
+ } else {
+ $num = $list;
+ }
+
+
+ my $sd = IO::Socket::INET->new(Proto => "tcp",
+ PeerAddr => "www.port.hu",
+ PeerPort => "80") or die;
+ print $sd "GET /pls/tv/tv.prog?i_days=1&i_ch=$chans{$chan}&i_ch_nr=1 HTTP/1.0\n";
+ print $sd "Host: www.port.hu\n";
+ print $sd "User-Agent: Irssi\n";
+ print $sd "\n";
+
+ Irssi::print "$chan:";
+
+ my $i = 0;
+ my ($x, $y);
+ while (<$sd>) {
+ if ($_ =~ /<tr><td align="right" valign="top" bgcolor="/) {
+ split /<strong>/, $_;
+
+ if (@_[1] =~ /<blink>(.*)<\/blink>/) {
+ $i = 1;
+ $x = $1;
+ } else {
+ if ($i) {
+ $i++;
+ }
+ @_[1] =~ /(.*)<\/strong>/;
+ $x = $1;
+ }
+
+ if ($i eq 0) {
+ next;
+ }
+
+ @_[2] =~ /(.*)<\/strong>/;
+ $y = $1;
+
+ Irssi::print "-> [$x] $y";
+ if ($i eq $num) {
+ last;
+ }
+ }
+ }
+
+ close $sd;
+
+ if ($i ne $num) {
+ Irssi::print "-> --- nincs tobb ---";
+ }
+}
+
+Irssi::command_bind('tvmusor', 'tvmusor');
diff --git a/scripts/twirssi.pl b/scripts/twirssi.pl
new file mode 100644
index 0000000..75d8e11
--- /dev/null
+++ b/scripts/twirssi.pl
@@ -0,0 +1,4217 @@
+use strict;
+use Irssi;
+use Irssi::Irc;
+use HTTP::Date;
+use HTML::Entities;
+use File::Temp;
+use LWP::Simple;
+use Data::Dumper;
+use Encode;
+use FileHandle;
+use POSIX qw/:sys_wait_h strftime/;
+use Net::Twitter qw/3.11009/;
+use Twitter::API;
+use JSON::MaybeXS;
+use DateTime;
+use DateTime::Format::Strptime;
+$Data::Dumper::Indent = 1;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = sprintf '%s', q$Version: v2.8.1$ =~ /^\w+:\s+v(\S+)/;
+%IRSSI = (
+ authors => '@zigdon, @gedge',
+ contact => 'gedgey@gmail.com',
+ name => 'twirssi',
+ description => 'Send twitter updates using /tweet. '
+ . 'Can optionally set your bitlbee /away message to same',
+ license => 'GNU GPL v2',
+ url => 'http://twirssi.com',
+ changed => '$Date: 2019-06-29 18:00:00 +0000$',
+);
+
+my $twit; # $twit is current logged-in Net::Twitter or Twitter::API object (usually one of %twits)
+my %twits; # $twits{$username} = logged-in object
+my %oauth;
+my $user; # current $account
+my $defservice; # current $service
+my $poll_event; # timeout_add event object (regular update)
+my %last_poll; # $last_poll{$username}{tweets|friends|blocks|lists} = time of last update
+ # {__interval|__poll} = time
+my %nicks; # $nicks{$screen_name} = last seen/mentioned time (for sorting completions)
+my %friends; # $friends{$username}{$nick} = $epoch_when_refreshed (rhs value used??)
+my %blocks; # $blocks {$username}{$nick} = $epoch_when_refreshed (rhs value used??)
+my %tweet_cache; # $tweet_cache{$tweet_id} = time of tweet (helps keep last hour of IDs, to avoid dups)
+my %state;
+ # $state{__ids} {$lc_nick}[$cache_idx] = $tweet_id
+ # $state{__u} {$lc_nick} = { id=>$user_id }
+ # $state{__i} {$user_id} = $lc_nick
+ # $state{__tweets} {$lc_nick}[$cache_idx] = $tweet_text
+ # $state{__usernames} {$lc_nick}[$cache_idx] = $username_that_polled_tweet
+ # $state{__reply_to_ids} {$lc_nick}[$cache_idx] = $polled_tweet_replies_to_this_id
+ # $state{__reply_to_users} {$lc_nick}[$cache_idx] = $polled_tweet_replies_to_this_user
+ # $state{__created_ats} {$lc_nick}[$cache_idx] = $time_of_tweet
+ # $state{__indexes} {$lc_nick} = $last_cache_idx_used
+ # $state{__last_id} {$username}{timeline|reply|dm} = $id_of_last_tweet
+ # {__sent} = $id_of_last_tweet_from_act
+ # {__extras}{$lc_nick} = $id_of_last_tweet (fix_replies)
+ # {__search}{$topic} = $id_of_last_tweet
+ # $state{__lists} {$username}{$list_name} = { id => $list_id, members=>[$nick,...] }
+ # $state{__channels} {$type}{$tag}{$net_tag} = [ channel,... ]
+ # $state{__windows} {$type}{$tag} = $window_name
+my $failstatus = 0; # last update status: 0=ok, 1=warned, 2=failwhaled
+my $first_call = 1;
+my $child_pid;
+my %fix_replies_index; # $fix_replies_index($username} = 0..100 idx in sort keys $state{__last_id}{$username}{__extras}
+my %search_once;
+my $update_is_running = 0;
+my %logfile;
+my %settings;
+my %last_ymd; # $last_ymd{$chan_or_win} = $last_shown_ymd
+my @datetime_parser;
+my %completion_types = ();
+my %expanded_url = ();
+my $ua;
+my %valid_types = (
+ 'window' => [ qw/ tweet search dm reply sender error default /], # twirssi_set_window
+ 'channel' => [ qw/ tweet search dm reply sender error * / ], # twirssi_set_channel
+);
+
+my $local_tz = DateTime::TimeZone->new( name => 'local' );
+
+my @settings_defn = (
+ [ 'broadcast_users', 'twirssi_broadcast_users', 's', undef, 'list{,}' ],
+ [ 'charset', 'twirssi_charset', 's', 'utf8', ],
+ [ 'default_service', 'twirssi_default_service', 's', 'Twitter', ],
+ [ 'ignored_accounts', 'twirssi_ignored_accounts', 's', '', 'list{,},norm_user' ],
+ [ 'ignored_twits', 'twirssi_ignored_twits', 's', '', 'lc,list{,}' ],
+ [ 'ignored_tags', 'twirssi_ignored_tags', 's', '', 'lc,list{,}' ],
+ [ 'location', 'twirssi_location', 's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.pl" ],
+ [ 'nick_color', 'twirssi_nick_color', 's', '%B', ],
+ [ 'ymd_color', 'twirssi_ymd_color', 's', '%r', ],
+ [ 'oauth_store', 'twirssi_oauth_store', 's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.oauth" ],
+ [ 'replies_store', 'twirssi_replies_store', 's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.json" ],
+ [ 'dump_store', 'twirssi_dump_store', 's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.dump" ],
+ [ 'poll_store', 'twirssi_poll_store', 's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.polls" ],
+ [ 'id_store', 'twirssi_id_store', 's', Irssi::get_irssi_dir . "/scripts/$IRSSI{name}.ids" ],
+ [ 'retweet_format', 'twirssi_retweet_format', 's', 'RT $n: "$t" ${-- $c$}' ],
+ [ 'retweeted_format', 'twirssi_retweeted_format', 's', 'RT $n: $t' ],
+ [ 'stripped_tags', 'twirssi_stripped_tags', 's', '', 'list{,}' ],
+ [ 'topic_color', 'twirssi_topic_color', 's', '%r', ],
+ [ 'timestamp_format', 'twirssi_timestamp_format', 's', '%H:%M:%S', ],
+ [ 'window_priority', 'twirssi_window_priority', 's', 'account', ],
+ [ 'upgrade_branch', 'twirssi_upgrade_branch', 's', 'master', ],
+ [ 'upgrade_dev', 'twirssi_upgrade_dev', 's', 'gedge', ],
+ [ 'bitlbee_server', 'bitlbee_server', 's', 'bitlbee' ],
+ [ 'hilight_color', 'twirssi_hilight_color', 's', '%M' ],
+ [ 'unshorten_color', 'twirssi_unshorten_color', 's', '%b' ],
+ [ 'passwords', 'twitter_passwords', 's', undef, 'list{,}' ],
+ [ 'usernames', 'twitter_usernames', 's', undef, 'list{,}' ],
+ [ 'update_usernames', 'twitter_update_usernames', 's', undef, 'list{,}' ],
+ [ 'url_provider', 'short_url_provider', 's', 'TinyURL' ],
+ [ 'url_unshorten', 'short_url_domains', 's', '', 'lc,list{ }' ],
+ [ 'url_args', 'short_url_args', 's', undef ],
+ [ 'window', 'twitter_window', 's', 'twitter' ],
+ [ 'debug_win_name', 'twirssi_debug_win_name', 's', '' ],
+ [ 'limit_user_tweets', 'twitter_user_results', 's', '20' ],
+
+ [ 'always_shorten', 'twirssi_always_shorten', 'b', 0 ],
+ [ 'rt_to_expand', 'twirssi_retweet_to_expand', 'b', 1 ],
+ [ 'avoid_ssl', 'twirssi_avoid_ssl', 'b', 0 ],
+ [ 'debug', 'twirssi_debug', 'b', 0 ],
+ [ 'notify_timeouts', 'twirssi_notify_timeouts', 'b', 1 ],
+ [ 'logging', 'twirssi_logging', 'b', 0 ],
+ [ 'mini_whale', 'twirssi_mini_whale', 'b', 0 ],
+ [ 'own_tweets', 'show_own_tweets', 'b', 1 ],
+ [ 'to_away', 'tweet_to_away', 'b', 0 ],
+ [ 'upgrade_beta', 'twirssi_upgrade_beta', 'b', 1 ],
+ [ 'use_oauth', 'twirssi_use_oauth', 'b', 1 ],
+ [ 'use_reply_aliases', 'twirssi_use_reply_aliases', 'b', 0 ],
+ [ 'window_input', 'tweet_window_input', 'b', 0 ],
+ [ 'retweet_classic', 'retweet_classic', 'b', 0 ],
+ [ 'retweet_show', 'retweet_show', 'b', 0 ],
+ [ 'force_first', 'twirssi_force_first', 'b', 0 ],
+
+ [ 'friends_poll', 'twitter_friends_poll', 'i', 600 ],
+ [ 'blocks_poll', 'twitter_blocks_poll', 'i', 900 ],
+ [ 'lists_poll', 'twitter_lists_poll', 'i', 900 ],
+ [ 'poll_interval', 'twitter_poll_interval', 'i', 300 ],
+ [ 'poll_schedule', 'twitter_poll_schedule', 's', '', 'list{,}' ],
+ [ 'search_results', 'twitter_search_results', 'i', 5 ],
+ [ 'autosearch_results','twitter_autosearch_results','i', 0 ],
+ [ 'timeout', 'twitter_timeout', 'i', 30 ],
+ [ 'track_replies', 'twirssi_track_replies', 'i', 100 ],
+ [ 'tweet_max_chars', 'twirssi_tweet_max_chars', 'i', 280 ],
+ [ 'dm_max_chars', 'twirssi_dm_max_chars', 'i', 10000 ],
+);
+
+my %meta_to_twit = ( # map file keys to twitter keys
+ 'id' => 'id',
+ 'created_at' => 'created_at',
+ 'reply_to_user' => 'in_reply_to_screen_name',
+ 'reply_to_id' => 'in_reply_to_status_id',
+);
+
+my %irssi_to_mirc_colors = (
+ '%k' => '01',
+ '%r' => '05',
+ '%g' => '03',
+ '%y' => '07',
+ '%b' => '02',
+ '%m' => '06',
+ '%c' => '10',
+ '%w' => '15',
+ '%K' => '14',
+ '%R' => '04',
+ '%G' => '09',
+ '%Y' => '08',
+ '%B' => '12',
+ '%M' => '13',
+ '%C' => '11',
+ '%W' => '00',
+);
+
+sub cmd_direct {
+ my ( $data, $server, $win ) = @_;
+
+ my ( $target, $text ) = split ' ', $data, 2;
+ unless ( $target and $text ) {
+ &notice( ["dm"], "Usage: /dm <nick> <message>" );
+ return;
+ }
+
+ &cmd_direct_as( "$user $data", $server, $win );
+}
+
+sub user_to_id {
+ my $obj = shift;
+ my $user = shift;
+ my $ctx = shift // "u2id";
+ my $fh = shift;
+
+ if (not defined $state{__u}{lc $user} or not defined $state{__u}{lc $user}{id}) {
+ my $r;
+ eval {
+ $r = $obj->lookup_users({screen_name=>$user, include_entities=>0});
+ if (not defined $r) {
+ &error([$ctx, $fh], "Cannot get id for user: $user" );
+ return;
+ }
+ };
+ if ($@) {
+ &error([$ctx, $fh], "Failed to get id for user: $user" );
+ return;
+ }
+ if (not defined $r->[0] or not exists $r->[0]->{id_str}) {
+ &error([$ctx, $fh], "Bad response for id for user: $user" );
+ return;
+ }
+ if (defined $fh) { printf $fh "t:uid id:%s nick:%s\n", $r->[0]->{id_str}, lc $user; }
+ $state{__u}{lc $user}{id} = $r->[0]->{id_str};
+ $state{__i}{$r->[0]->{id_str}} = lc $user;
+ }
+
+ return $state{__u}{lc $user}{id};
+}
+
+sub id_to_user {
+ my $obj = shift;
+ my $u_id = shift;
+ my $ctx = shift // "id2u";
+ my $fh = shift;
+
+ if (not defined $state{__i}{$u_id}) {
+ my $r;
+ eval {
+ $r = $obj->lookup_users({user_id=>$u_id, include_entities=>0});
+ if (not defined $r) {
+ &error([$ctx, $fh], "Cannot get user for id $u_id" );
+ return;
+ }
+ };
+ if ($@) {
+ &error([$ctx, $fh], "Failed to get user for id $u_id" );
+ return;
+ }
+ if (not defined $r->[0] or not exists $r->[0]->{screen_name}) {
+ &error([$ctx, $fh], "Bad response for id for user: $u_id" );
+ return;
+ }
+ if (defined $fh) { printf $fh "t:uid id:%s nick:%s\n", $u_id, lc $r->[0]->{screen_name}; }
+ $state{__i}{$u_id} = lc $r->[0]->{screen_name};
+ $state{__u}{lc $r->[0]->{screen_name}}{id} = $u_id;
+ }
+
+ return $state{__i}{$u_id};
+}
+
+sub cmd_direct_as {
+ my ( $data, $server, $win ) = @_;
+
+ my ( $username, $target, $text ) = split ' ', $data, 3;
+ unless ( $username and $target and $text ) {
+ &notice( ["dm"], "Usage: /dm_as <username> <nick> <message>" );
+ return;
+ }
+
+ return unless $username = &valid_username($username);
+ return unless &logged_in($twits{$username});
+
+ my $target_norm = &normalize_username($target, 1);
+ my $target_id = &user_to_id($twits{$username}, $target, "dm");
+ return unless defined $target_id;
+
+ $text = &shorten($text);
+
+ return if &too_long($text, ['dm', $target_norm]);
+
+ eval {
+ my $r = $twits{$username}->request(post => 'direct_messages/events/new', {
+ -to_json => {
+ event => {
+ type => 'message_create',
+ message_create => {
+ target => { recipient_id => $target_id, },
+ message_data => { text => $text, },
+ },
+ },
+ },
+ });
+ if (not defined $r) {
+ my $error;
+ eval {
+ $error = decode_json( $twits{$username}->get_error() );
+ $error = $error->{error};
+ };
+ die "$error\n" if $error;
+ &notice( [ "dm", $target_norm ], "DM to $target failed" );
+ return;
+ }
+ &notice( [ "dm", $target_norm ], "DM sent to $target: $text" );
+ $nicks{$target} = time;
+ };
+
+ if ($@) {
+ &error( "DM caused an error: $@" );
+ return;
+ }
+}
+
+sub cmd_retweet {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//;
+ unless ($data) {
+ &notice( [ "tweet", $user ], "Usage: /retweet <nick[:num]> [comment]" );
+ return;
+ }
+
+ (my $id, $data ) = split ' ', $data, 2;
+
+ &cmd_retweet_as( "$user $id $data", $server, $win );
+}
+
+sub cmd_retweet_as {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//;
+ ( my $username, my $id, $data ) = split ' ', $data, 3;
+
+ unless ($username) {
+ &notice( ["tweet"],
+ "Usage: /retweet_as <username> <nick[:num]> [comment]" );
+ return;
+ }
+
+ return unless $username = &valid_username($username);
+
+ return unless &logged_in($twits{$username});
+
+ my $nick;
+ $id =~ s/[^\w\d\-:]+//g;
+ ( $nick, $id ) = split /:/, $id;
+ unless ( exists $state{__ids}{ lc $nick } ) {
+ &notice( [ "tweet", $username ],
+ "Can't find a tweet from $nick to retweet!" );
+ return;
+ }
+
+ $id = $state{__indexes}{lc $nick} unless defined $id;
+ unless ( $state{__ids}{ lc $nick }[$id] ) {
+ &notice( [ "tweet", $username ],
+ "Can't find a tweet numbered $id from $nick to retweet!" );
+ return;
+ }
+
+ unless ( $state{__tweets}{ lc $nick }[$id] ) {
+ &notice( [ "tweet", $username ],
+ "The text of this tweet isn't saved, sorry!" );
+ return;
+ }
+
+ my $text = &format_expand(fmt => $settings{retweet_format}, nick => $nick, data => $data,
+ tweet => $state{__tweets}{ lc $nick }[$id]);
+
+ my $modified = $data;
+ $data = &shorten($text);
+
+ return if ($modified or $settings{retweet_classic})
+ and &too_long($data, ['tweet', $username]);
+
+ my $success = 1;
+ my $extra_info = '';
+ eval {
+ if ($modified or $settings{retweet_classic}) {
+ $success = $twits{$username}->update(
+ {
+ status => $data,
+ # in_reply_to_status_id => $state{__ids}{ lc $nick }[$id]
+ }
+ );
+ $extra_info = ' (classic/edited)';
+ } else {
+ $success =
+ $twits{$username}->retweet( { id => $state{__ids}{ lc $nick }[$id] } );
+ # $retweeted_id{$username}{ $state{__ids}{ lc $nick }[$id] } = 1;
+ $extra_info = ' (native)';
+ }
+ };
+ unless ($success) {
+ &notice( [ "tweet", $username ], "Update failed" );
+ return;
+ }
+
+ if ($@) {
+ &error( [ $username ], "Update caused an error: $@. Aborted" );
+ return;
+ }
+
+ $extra_info .= ' id=' . $success->{id} if $settings{debug};
+
+ foreach ( $data =~ /@([-\w]+)/g ) {
+ $nicks{$_} = time;
+ }
+
+ &notice( [ "tweet", $username ], "Retweet of $nick:$id sent" . $extra_info );
+}
+
+
+sub format_expand {
+ my %args = @_;
+ $args{fmt} =~ s/\$n/\@$args{nick}/g;
+ if (defined $args{data} and $args{data} ne '') {
+ $args{fmt} =~ s/\$\{|\$}//g;
+ $args{fmt} =~ s/\$c/$args{data}/g;
+ } else {
+ $args{fmt} =~ s/\$\{.*?\$}//g;
+ }
+ $args{fmt} =~ s/\$t/$args{tweet}/g;
+ return $args{fmt};
+}
+
+
+sub cmd_retweet_to_window {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//;
+
+ ( my $id, $data ) = split ' ', $data, 2;
+ $id =~ s/[^\w\d\-:]+//g;
+ ( my $nick, $id ) = split ':', $id;
+ unless ( exists $state{__ids}{ lc $nick } ) {
+ &notice( [ "tweet" ],
+ "Can't find a tweet from $nick to retweet!" );
+ return;
+ }
+
+ $id = $state{__indexes}{lc $nick} unless defined $id;
+ unless ( $state{__ids}{ lc $nick }[$id] ) {
+ &notice( [ "tweet" ],
+ "Can't find a tweet numbered $id from $nick to retweet!" );
+ return;
+ }
+
+ unless ( $state{__tweets}{ lc $nick }[$id] ) {
+ &notice( [ "tweet" ],
+ "The text of this tweet isn't saved, sorry!" );
+ return;
+ }
+
+ my $target = '';
+ my $got_net = 0;
+ my $got_target = 0;
+ while (not $got_target and $data =~ s/^(\S+)\s*//) {
+ my $arg = $1;
+ if (not $got_net and lc($arg) ne '-channel' and lc($arg) ne '-nick' and $arg =~ /^-/) {
+ $got_net = 1;
+ } else {
+ if (lc($arg) eq '-channel' or lc($arg) eq '-nick') {
+ last if not $data =~ s/^(\S+)\s*//;
+ $arg .= " $1";
+ }
+ $got_target = 1;
+ }
+ $target .= ($target ne '' ? ' ' : '') . $arg;
+ }
+ if (not $got_target) {
+ &notice( [ "tweet" ], "Missing target." );
+ return;
+ }
+
+ my $text = &format_expand(fmt => $settings{retweet_format}, nick => $nick, data => $data,
+ tweet => &post_process_tweet($state{__tweets}{ lc $nick }[$id], not $settings{rt_to_expand}));
+
+ Irssi::command("msg $target $text");
+
+ foreach ( $text =~ /@([-\w]+)/g ) {
+ $nicks{$_} = time;
+ }
+
+ &debug("Retweet of $nick:$id sent to $target");
+}
+
+sub cmd_reload {
+ if ($settings{force_first} and $settings{poll_store}) {
+ &save_state();
+ &save_polls();
+ }
+ Irssi::command("script load $IRSSI{name}");
+}
+
+sub cmd_tweet {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//;
+ unless ($data) {
+ &notice( ["tweet"], "Usage: /tweet <update>" );
+ return;
+ }
+
+ &cmd_tweet_as( "$user\@$defservice $data", $server, $win );
+}
+
+sub cmd_tweet_as {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//;
+ $data =~ s/\s\s+/ /g;
+ ( my $username, $data ) = split ' ', $data, 2;
+
+ unless ( $username and $data ) {
+ &notice( ["tweet"], "Usage: /tweet_as <username> <update>" );
+ return;
+ }
+
+ return unless $username = &valid_username($username);
+
+ return unless &logged_in($twits{$username});
+
+ $data = &shorten($data);
+
+ return if &too_long($data, ['tweet', $username]);
+
+ my $success = 1;
+ my $res;
+ eval {
+ unless ( $res = $twits{$username}->update($data) ) {
+ &notice( [ "tweet", $username ], "Update failed" );
+ $success = 0;
+ }
+ };
+ return unless $success;
+
+ if ($@) {
+ &error( [ $username ], "Update caused an error: $@. Aborted." );
+ return;
+ }
+
+ foreach ( $data =~ /@([-\w]+)/g ) {
+ $nicks{$_} = time;
+ }
+
+ # TODO: What's the official definition of a Hashtag? Let's use #[-\w]+ like above for now.
+ if ( $settings{autosearch_results} > 0 and $data =~ /#[-\w]+/ ) {
+ my @topics;
+ while ( $data =~ /(#[-\w]+)/g ) {
+ push @topics, $1;
+ $search_once{$username}->{$1} = $settings{autosearch_results};
+ }
+ &get_updates([ 0, [
+ [ $username, { up_searches => [ @topics ] } ],
+ ],
+ ]);
+ }
+
+ $state{__last_id}{$username}{__sent} = $res->{id};
+ my $id_info = ' id=' . $res->{id} if $settings{debug};
+
+ my $away_info = '';
+ if ( $username eq "$user\@$defservice"
+ and $settings{to_away}
+ and &update_away($data) ) {
+ $away_info = " (and away msg set)";
+ }
+ &notice( [ "tweet", $username ], "Update sent" . $away_info . $id_info );
+}
+
+sub cmd_broadcast {
+ my ( $data, $server, $win ) = @_;
+
+ my @bcast_users = @{ $settings{broadcast_users} };
+ @bcast_users = keys %twits if not @bcast_users;
+
+ foreach my $buser (@bcast_users) {
+ &cmd_tweet_as( "$buser $data", $server, $win );
+ }
+}
+
+sub cmd_info {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//g;
+ unless ( $data ) {
+ &notice( ["info"], "Usage: /twitter_info <nick[:num]>" );
+ return;
+ }
+
+ $data =~ s/[^\w\-:]+//g;
+ my ( $nick_orig, $id ) = split /:/, $data;
+ my $nick = lc $nick_orig;
+ unless ( exists $state{__ids}{ $nick } ) {
+ &notice( [ "info" ],
+ "Can't find any tweet from $nick_orig!" );
+ return;
+ }
+
+ $id = $state{__indexes}{$nick} unless defined $id;
+ my $statusid = $state{__ids}{$nick}[$id];
+ unless ( $statusid ) {
+ &notice( [ "info" ],
+ "Can't find a tweet numbered $id from $nick_orig!" );
+ return;
+ }
+
+ my $username = $state{__usernames}{$nick}[$id];
+ my $timestamp = $state{__created_ats}{$nick}[$id];
+ my $tweet = $state{__tweets}{$nick}[$id];
+ my $reply_to_id = $state{__reply_to_ids}{$nick}[$id];
+ my $reply_to_user = $state{__reply_to_users}{$nick}[$id];
+ my $exp_tweet = $tweet;
+ if ($tweet) {
+ $tweet = &post_process_tweet($tweet, 1);
+ $exp_tweet = &post_process_tweet($exp_tweet);
+ }
+
+ my $url = '';
+ if ( defined $username ) {
+ if ( $username =~ /\@Twitter/ ) {
+ $url = "http://twitter.com/$nick/statuses/$statusid";
+ } elsif ( $username =~ /\@Identica/ ) {
+ $url = "http://identi.ca/notice/$statusid";
+ }
+ }
+
+ &notice( [ "info" ], ",--------- $nick:$id" );
+ &notice( [ "info" ], "| nick: $nick_orig <http://twitter.com/$nick_orig>" );
+ &notice( [ "info" ], "| id: $statusid" . ($url ? " <$url>" : ''));
+ &notice( [ "info" ], "| time: " . ($timestamp
+ ? DateTime->from_epoch( epoch => $timestamp, time_zone => $local_tz)
+ : '<unknown>') );
+ &notice( [ "info" ], "| account: " . ($username ? $username : '<unknown>' ) );
+ &notice( [ "info" ], "| text: " . ($tweet ? $tweet : '<unknown>' ) );
+ &notice( [ "info" ], "| +url: " . $exp_tweet ) if $exp_tweet ne $tweet;
+
+ if ($reply_to_id and $reply_to_user) {
+ &notice( [ "info" ], "| ReplyTo: $reply_to_user:$reply_to_id" );
+ &notice( [ "info" ], "| thread: http://twitter.theinfo.org/$statusid");
+ }
+ &notice( [ "info" ], "`---------" );
+}
+
+sub cmd_reply {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//;
+ unless ($data) {
+ &notice( ["reply"], "Usage: /reply <nick[:num]> <update>" );
+ return;
+ }
+
+ ( my $id, $data ) = split ' ', $data, 2;
+ unless ( $id and $data ) {
+ &notice( ["reply"], "Usage: /reply <nick[:num]> <update>" );
+ return;
+ }
+
+ &cmd_reply_as( "$user $id $data", $server, $win );
+}
+
+sub cmd_reply_as {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//;
+ ( my $username, my $id, $data ) = split ' ', $data, 3;
+
+ unless ( $username and $data ) {
+ &notice( ["reply"],
+ "Usage: /reply_as <username> <nick[:num]> <update>" );
+ return;
+ }
+
+ return unless $username = &valid_username($username);
+
+ return unless &logged_in($twits{$username});
+
+ my $nick;
+ $id =~ s/[^\w\d\-:]+//g;
+ ( $nick, $id ) = split /:/, $id;
+ unless ( exists $state{__ids}{ lc $nick } ) {
+ &notice( [ "reply", $username ],
+ "Can't find a tweet from $nick to reply to!" );
+ return;
+ }
+
+ $id = $state{__indexes}{lc $nick} unless defined $id;
+ unless ( $state{__ids}{ lc $nick }[$id] ) {
+ &notice( [ "reply", $username ],
+ "Can't find a tweet numbered $id from $nick to reply to!" );
+ return;
+ }
+
+ $data = "\@$nick $data";
+ $data = &shorten($data);
+
+ return if &too_long($data, ['reply', $username]);
+
+ my $success = 1;
+ eval {
+ unless (
+ $twits{$username}->update(
+ {
+ status => $data,
+ in_reply_to_status_id => $state{__ids}{ lc $nick }[$id]
+ }
+ )
+ ) {
+ &notice( [ "reply", $username ], "Update failed" );
+ $success = 0;
+ }
+ };
+ return unless $success;
+
+ if ($@) {
+ &notice( [ "reply", $username ],
+ "Update caused an error: $@. Aborted" );
+ return;
+ }
+
+ foreach ( $data =~ /@([-\w]+)/g ) {
+ $nicks{$_} = time;
+ }
+
+ my $away = $settings{to_away} ? &update_away($data) : 0;
+
+ &notice( [ "reply", $username ],
+ "Update sent" . ( $away ? " (and away msg set)" : "" ) );
+}
+
+sub gen_cmd {
+ my ( $usage_str, $api_name, $post_ref, $data_ref ) = @_;
+
+ return sub {
+ my ( $data, $server, $win ) = @_;
+
+ return unless &logged_in($twit);
+
+ if ($data_ref) {
+ $data = $data_ref->($data);
+ }
+
+ $data =~ s/^\s+|\s+$//;
+ unless ($data) {
+ &notice("Usage: $usage_str");
+ return;
+ }
+
+ my $success = 1;
+ eval {
+ unless ( $twit->$api_name($data) ) {
+ &notice("$api_name failed");
+ $success = 0;
+ }
+ };
+ return unless $success;
+
+ if ($@) {
+ &error("$api_name caused an error. Aborted: $@");
+ return;
+ }
+
+ &$post_ref($data, $server, $win) if $post_ref;
+ }
+}
+
+sub cmd_listinfo {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//g;
+ if ( length $data > 0 ) {
+ my ($list_user, $list_name) = split(' ', lc $data, 2);
+ my $list_account = &normalize_username($list_user, 1);
+ my $list_ac = ($list_account eq "$user\@$defservice" ? '' : "$list_account/");
+ if (defined $list_name) {
+ &notice("Getting list: '$list_ac$list_name'");
+ } else {
+ &notice("Getting all lists for '$list_account'");
+ }
+ &get_updates([ 0, [
+ [ "$user\@$defservice", { up_lists => [ $list_user, $list_name ] } ],
+ ],
+ ]);
+
+ } else {
+ &error( 'Usage: /twitter_listinfo [ <user> [<list name>] ]' );
+ }
+}
+
+sub cmd_search {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//g;
+ if ( length $data > 0 ) {
+ my $username = &normalize_username($user);
+ if ( exists $search_once{$username}->{$data} ) {
+ &notice( [ "search", $data ], "Search is already queued" );
+ return;
+ }
+ $search_once{$username}->{$data} = $settings{search_results};
+ &notice( [ "search", $data ], "Searching for '$data'" );
+ &get_updates([ 0, [
+ [ $username, { up_searches => [ $data ] } ],
+ ],
+ ]);
+ } else {
+ &notice( ["search"], "Usage: /twitter_search <search term>" );
+ }
+}
+
+
+sub cmd_dms_as {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//g;
+ ( my $username, $data ) = split ' ', $data, 2;
+ unless ( $username ) {
+ &notice( ['dm'], 'Usage: /twitter_dms_as <username>' );
+ return;
+ }
+ return unless $username = &valid_username($username);
+ return unless &logged_in($twits{$username});
+
+ if ( length $data > 0 ) {
+ &error( 'Usage: /' . ($username eq "$user\@$defservice"
+ ? 'twitter_dms' : 'twitter_dms_as <username>') );
+ return;
+ }
+ &notice( [ 'dm' ], 'Fetching direct messages' );
+ &get_updates([ 0, [
+ [ $username, { up_dms => 1 } ],
+ ],
+ ]);
+}
+
+
+sub cmd_dms {
+ my ( $data, $server, $win ) = @_;
+ &cmd_dms_as("$user $data", $server, $win);
+}
+
+sub cmd_switch {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//g;
+ $data = &normalize_username($data);
+ if ( exists $twits{$data} ) {
+ &notice( [ "tweet", $data ], "Switching to $data" );
+ $twit = $twits{$data};
+ if ( $data =~ /(.*)\@(.*)/ ) {
+ $user = $1;
+ $defservice = $2;
+ } else {
+ &notice( [ "tweet", $data ],
+ "Couldn't figure out what service '$data' is on" );
+ }
+ } else {
+ &notice( ["tweet"], "Unknown user $data" );
+ }
+}
+
+sub cmd_logout {
+ my ( $data, $server, $win ) = @_;
+
+ $data =~ s/^\s+|\s+$//g;
+ $data = $user unless $data;
+ return unless $data = &valid_username($data);
+
+ &notice( [ "tweet", $data ], "Logging out $data..." );
+ eval { $twits{$data}->end_session(); };
+ delete $twits{$data};
+ delete $last_poll{$data};
+ undef $twit;
+ if ( keys %twits ) {
+ &cmd_switch( ( keys %twits )[0], $server, $win );
+ } else {
+ Irssi::timeout_remove($poll_event) if $poll_event;
+ undef $poll_event;
+ }
+}
+
+sub cmd_login {
+ my ( $data, $server, $win ) = @_;
+ my $username;
+ my $pass;
+ &debug("logging in: $data");
+ if ($data) {
+ ( $username, $pass ) = split ' ', $data, 2;
+ unless ( $settings{use_oauth} or $pass ) {
+ &notice( ["tweet"],
+ "usage: /twitter_login <username>[\@<service>] [<password>*]",
+ " *required if not using OAUTH" );
+ return;
+ }
+ &debug("%G$username%n manual data login");
+
+ } elsif ( $settings{use_oauth} and @{ $settings{usernames} } ) {
+ &debug("oauth autouser login @{ $settings{usernames} }" );
+ %nicks = ();
+ my $some_success = 0;
+ foreach my $user ( @{ $settings{usernames} } ) {
+ $some_success = &cmd_login($user);
+ }
+ return $some_success;
+
+ } elsif ( @{ $settings{usernames} } and @{ $settings{passwords} } ) {
+ &debug("autouser login");
+
+ if ( @{ $settings{usernames} } != @{ $settings{passwords} } ) {
+ &error( "Number of usernames doesn't match "
+ . "the number of passwords - auto-login failed" );
+ return;
+ } else {
+ %nicks = ();
+ my $some_success = 0;
+ for (my $i = 0; $i < @{ $settings{usernames} }; $i++) {
+ $some_success ||= &cmd_login("$settings{usernames}->[$i] $settings{passwords}->[$i]");
+ }
+ return $some_success;
+ }
+
+ } else {
+ &error( "/twitter_login requires either a username/password "
+ . "or twitter_usernames and twitter_passwords to be set. "
+ . "Note that if twirssi_use_oauth is true, passwords are "
+ . "not required" );
+ return;
+ }
+
+ $username = &normalize_username($username, 1);
+ ( $user, $defservice ) = split('@', $username, 2);
+
+ $state{__lists}{$username} = {};
+ $blocks{$username} = {};
+ $friends{$username} = {};
+
+ if ( $settings{use_oauth} ) {
+ &debug("%G$username%n Attempting OAuth to $defservice");
+ eval {
+ if ( $defservice eq 'Identica' ) {
+ $twit = Net::Twitter->new(
+ ($defservice eq 'Identica' ? ( identica => 1 ) : ()),
+ traits => [ 'API::REST', 'API::Search' ],
+ source => "twirssi", # XXX
+ ssl => !$settings{avoid_ssl},
+ );
+ } else {
+ $twit = Twitter::API->new_with_traits(
+ traits => [ qw/ Migration ApiMethods RetryOnError / ],
+ (
+ grep tr/a-zA-Z/n-za-mN-ZA-M/, map $_,
+ pbafhzre_xrl => 'OMINiOzn4TkqvEjKVioaj',
+ pbafhzre_frperg =>
+ '0G5xnujYlo34ipvTMftxN9yfwgTPD05ikIR2NCKZ',
+ ),
+ source => "twirssi", # XXX
+ ssl => !$settings{avoid_ssl},
+ );
+ }
+ };
+
+ if ($@) {
+ &error( "Error when creating object: $@" );
+ }
+
+ if ($twit) {
+ if ( open( my $oa_fh, '<', $settings{oauth_store} ) ) {
+ while (<$oa_fh>) {
+ chomp;
+ next unless /^$username (\S+) (\S+)/i;
+ &debug("%G$username%n Trying cached oauth creds");
+ $twit->access_token($1);
+ $twit->access_token_secret($2);
+ last;
+ }
+ close $oa_fh;
+ }
+
+ # leave undefined if authorized
+ my $authorize_url;
+ my %req_tokes = ();
+ if ( ref($twit) =~ /Twitter::API/
+ and not ($twit->has_access_token and $twit->has_access_token_secret ) ) {
+ my $oauth_ref;
+ eval { $oauth_ref = $twit->oauth_request_token(); };
+ if ($@) {
+ &error( "Failed to get oauth_request_token: $@" );
+ return;
+ }
+ if (not $oauth_ref->{oauth_token} or not $oauth_ref->{oauth_token_secret}) {
+ &error( "Failed to return oauth_token*" );
+ return;
+ }
+
+ $req_tokes{token} = $oauth_ref->{oauth_token};
+ $req_tokes{token_secret} = $oauth_ref->{oauth_token_secret};
+
+ eval { $authorize_url = $twit->oauth_authorization_url({
+ oauth_token => $oauth_ref->{oauth_token},
+ screen_name => $user,
+ });
+ };
+ if ($@) {
+ &error( "Failed to get oauth_authorization_url: $@" );
+ return;
+ }
+ }
+ elsif ( $twit->can('authorized') and not $twit->authorized ) {
+ eval { $authorize_url = $twit->get_authorization_url; };
+ if ($@) {
+ &error( "Failed to get OAuth authorization_url: $@" );
+ return;
+ }
+ }
+
+ if ( $authorize_url ) {
+ &error( "$user: $IRSSI{name} not authorized to access $defservice.",
+ "Please authorize at the following url:",
+ " " . $authorize_url,
+ "then enter the PIN supplied with:",
+ " /twirssi_oauth $username <pin>",
+ );
+
+ $oauth{pending}{$username} = {
+ twit => $twit,
+ %req_tokes,
+ };
+ return;
+ }
+ }
+ } else {
+ $twit = Net::Twitter->new(
+ $defservice eq 'Identica' ? ( identica => 1 ) : (),
+ username => $user,
+ password => $pass,
+ source => "twirssi", # XXX
+ ssl => !$settings{avoid_ssl},
+ );
+ }
+
+ unless ($twit) {
+ &error( "Failed to create object! Aborting." );
+ return;
+ }
+
+ return &verify_twitter_object( $server, $win, $user, $defservice, $twit );
+}
+
+sub cmd_oauth {
+ my ( $data, $server, $win ) = @_;
+ my ( $key, $pin ) = split ' ', $data;
+ my ( $user, $service );
+ $key = &normalize_username($key);
+ if ( $key =~ /^(.*)@(Twitter|Identica)$/ ) {
+ ( $user, $service ) = ( $1, $2 );
+ }
+ $pin =~ s/\D//g;
+ &debug("Applying pin to $key");
+
+ unless ( exists $oauth{pending}{$key} ) {
+ &error( "There isn't a pending oauth request for $key. "
+ . "Try /twitter_login first" );
+ return;
+ }
+
+ my $twit = $oauth{pending}{$key}->{twit};
+ my ( $access_token, $access_token_secret );
+ eval {
+ my $hash_ref = $twit->oauth_access_token({
+ token => $oauth{pending}{$key}->{token},
+ token_secret => $oauth{pending}{$key}->{token_secret},
+ verifier => $pin,
+ });
+ $access_token = $hash_ref->{oauth_token};
+ $access_token_secret = $hash_ref->{oauth_token_secret};
+ };
+
+ if ($@) {
+ &error( "Invalid pin, try again: $@" );
+ return;
+ }
+
+ if (not $access_token or not $access_token_secret) {
+ &error( "Invalid tokens returned, try again" );
+ return;
+ }
+
+ $twit->access_token($access_token);
+ $twit->access_token_secret($access_token_secret);
+
+ delete $oauth{pending}{$key};
+
+ my $store_file = $settings{oauth_store};
+ if ($store_file) {
+ my @store;
+ if ( open( my $oa_fh, '<', $store_file ) ) {
+ while (<$oa_fh>) {
+ chomp;
+ next if /$key/i;
+ push @store, $_;
+ }
+ close $oa_fh;
+
+ }
+
+ push @store, "$key $access_token $access_token_secret";
+
+ if ( open( my $oa_fh, '>', "$store_file.new" ) ) {
+ print $oa_fh "$_\n" foreach @store;
+ close $oa_fh;
+ rename "$store_file.new", $store_file
+ or &error( "Failed to rename $store_file.new: $!" );
+ } else {
+ &error( "Failed to write $store_file.new: $!" );
+ }
+ } else {
+ &error( "No persistant storage set for OAuth. "
+ . "Please /set twirssi_oauth_store to a writable filename." );
+ }
+
+ return &verify_twitter_object( $server, $win, $user, $service, $twit );
+}
+
+sub rate_limited {
+ my $obj = shift;
+ my $username = shift;
+ my $fh = shift;
+
+ my $rate_limit;
+ eval {
+ $rate_limit = $obj->rate_limit_status();
+ };
+ my $res = 0;
+ if ( $rate_limit and $rate_limit->{resources} ) {
+ for my $resource (keys %{ $rate_limit->{resources} }) {
+ for my $uri (keys %{ $rate_limit->{resources}->{$resource} }) {
+ if ( $rate_limit->{resources}->{$resource}->{$uri}->{remaining} < 1 ) {
+ &error([$username, $fh],
+ "Rate limit exceeded for $resource ($uri), try again after " .
+ localtime $rate_limit->{resources}->{$resource}->{$uri}->{reset} );
+ $res = 1;
+ }
+ }
+ }
+ }
+ return $res;
+}
+
+sub verify_twitter_object {
+ my ( $server, $win, $user, $service, $twit ) = @_;
+
+ if ( my $timeout = $settings{timeout} ) {
+ if ( $twit->can('user_agent') ) {
+ $twit->user_agent->timeout($timeout);
+ } elsif ( $twit->can('ua') ) {
+ $twit->ua->timeout($timeout);
+ } else {
+ $timeout = undef;
+ }
+ &notice( ["tweet", "$user\@$service"],
+ "Twitter timeout for $user\@$service set to $timeout" ) if defined $timeout;
+ }
+
+ my $verified = 0;
+ eval { $verified = $twit->verify_credentials(); };
+
+ if ( $@ or not $verified ) {
+ my $msg = $@ // 'Not verified';
+ &notice(
+ [ "tweet", "$user\@$service" ],
+ "Login as $user\@$service failed: $msg"
+ );
+
+ if ( not $settings{avoid_ssl} ) {
+ &notice(
+ [ "tweet", "$user\@$service" ],
+ "It's possible you're missing one of the modules required for "
+ . "SSL logins. Try setting twirssi_avoid_ssl to on. See "
+ . "http://cpansearch.perl.org/src/GAAS/libwww-perl-5.831/README.SSL "
+ . "for the detailed requirements."
+ );
+ }
+
+ $twit = undef;
+ if ( keys %twits ) {
+ &cmd_switch( ( keys %twits )[0], $server, $win );
+ }
+ return;
+ }
+
+ if (&rate_limited($twit, "$user\@$service")) {
+ $twit = undef;
+ return;
+ }
+
+ &debug("%G$user\@$service%n saving object");
+ $twits{"$user\@$service"} = $twit;
+
+ # &get_updates([ 1, [ "$user\@$service", {} ], ]);
+ &ensure_updates();
+
+ foreach my $scr_name (keys %{ $friends{"$user\@$service"} }) {
+ $nicks{$scr_name} = $friends{"$user\@$service"}{$scr_name};
+ }
+ $nicks{$user} = 0;
+ return 1;
+}
+
+sub cmd_add_follow {
+ my ( $data, $server, $win ) = @_;
+
+ unless ($data) {
+ &error( "Usage: /twitter_add_follow_extra <username>" );
+ return;
+ }
+
+ $data =~ s/^\s+|\s+$//g;
+ $data =~ s/^\@//;
+ $data = lc $data;
+
+ if ( exists $state{__last_id}{"$user\@$defservice"}{__extras}{$data} ) {
+ &notice( ["tweet"], "Already following all replies by \@$data" );
+ return;
+ }
+
+ $state{__last_id}{"$user\@$defservice"}{__extras}{$data} = 1;
+ &notice( ["tweet"], "Will now follow all replies by \@$data" );
+}
+
+sub cmd_del_follow {
+ my ( $data, $server, $win ) = @_;
+
+ unless ($data) {
+ &error( "Usage: /twitter_del_follow_extra <username>" );
+ return;
+ }
+
+ $data =~ s/^\s+|\s+$//g;
+ $data =~ s/^\@//;
+ $data = lc $data;
+
+ unless ( exists $state{__last_id}{"$user\@$defservice"}{__extras}{$data} ) {
+ &error( "Wasn't following all replies by \@$data" );
+ return;
+ }
+
+ delete $state{__last_id}{"$user\@$defservice"}{__extras}{$data};
+ &notice( ["tweet"], "Will no longer follow all replies by \@$data" );
+}
+
+sub cmd_list_follow {
+ my ( $data, $server, $win ) = @_;
+
+ my $found = 0;
+ foreach my $suser ( sort keys %{ $state{__last_id} } ) {
+ next unless exists $state{__last_id}{$suser}{__extras};
+ my $frusers = join ', ', sort keys %{ $state{__last_id}{$suser}{__extras} };
+ if ($frusers) {
+ $found = 1;
+ &notice( ["tweet"], "Following all replies as $suser: $frusers" );
+ }
+ }
+
+ unless ($found) {
+ &notice( ["tweet"], "Not following all replies by anyone" );
+ }
+}
+
+sub cmd_add_search {
+ my ( $data, $server, $win ) = @_;
+
+ unless ( $twit and $twit->can('search') ) {
+ my $ref_type = ref($twit);
+ &notice( ["search"],
+ "ERROR: Your version of $ref_type (" . $ref_type->VERSION . ") "
+ . "doesn't support searches." );
+ return;
+ }
+
+ my $want_win = 1 if $data =~ s/^\s*-w\s+//;
+
+ $data =~ s/^\s+|\s+$//g;
+ $data = lc $data;
+
+ unless ($data) {
+ &notice( ["search"], "Usage: /twitter_subscribe [-w] <topic>" );
+ return;
+ }
+
+ if ( exists $state{__last_id}{"$user\@$defservice"}{__search}{$data} ) {
+ &notice( [ "search", $data ],
+ "Already had a subscription for '$data'" );
+ return;
+ }
+
+ $state{__last_id}{"$user\@$defservice"}{__search}{$data} = 1;
+ &notice( [ "search", $data ], "Added subscription for '$data'" );
+ if ($want_win) {
+ my $win_name = $data;
+ $win_name =~ tr/ /+/;
+ &cmd_set_window("search $data $win_name", $server, $win);
+ }
+}
+
+sub cmd_del_search {
+ my ( $data, $server, $win ) = @_;
+
+ unless ( $twit and $twit->can('search') ) {
+ my $ref_type = ref($twit);
+ &notice( ["search"],
+ "ERROR: Your version of $ref_type (" . $ref_type->VERSION . ") "
+ . "doesn't support searches." );
+ return;
+ }
+ $data =~ s/^\s+|\s+$//g;
+ $data = lc $data;
+
+ unless ($data) {
+ &notice( ["search"], "Usage: /twitter_unsubscribe <topic>" );
+ return;
+ }
+
+ unless ( exists $state{__last_id}{"$user\@$defservice"}{__search}{$data} ) {
+ &notice( [ "search", $data ], "No subscription found for '$data'" );
+ return;
+ }
+
+ delete $state{__last_id}{"$user\@$defservice"}{__search}{$data};
+ &notice( [ "search", $data ], "Removed subscription for '$data'" );
+}
+
+sub cmd_list_search {
+ my ( $data, $server, $win ) = @_;
+
+ my $found = 0;
+ foreach my $suser ( sort keys %{ $state{__last_id} } ) {
+ my $topics = '';
+ foreach my $topic ( sort keys %{ $state{__last_id}{$suser}{__search} } ) {
+ $topics .= ($topics ne '' ? ', ' : '') . "'$topic'";
+ }
+ if ($topics ne '') {
+ $found = 1;
+ &notice( ["search"], "Search subscriptions for $suser: $topics" );
+ }
+ }
+
+ unless ($found) {
+ &notice( ["search"], "No search subscriptions set up" );
+ }
+}
+
+sub cmd_upgrade {
+ my ( $data, $server, $win ) = @_;
+
+ my $loc = $settings{location};
+ unless ( -w $loc ) {
+ &error( "$loc isn't writable, can't upgrade."
+ . " Perhaps you need to /set twirssi_location?" );
+ return;
+ }
+
+ my $URL = "https://raw.githubusercontent.com/"
+ . ( $settings{upgrade_beta}
+ ? "$settings{upgrade_dev}/twirssi/$settings{upgrade_branch}"
+ : "$settings{upgrade_dev}/twirssi/master"
+ ) . "/twirssi.pl";
+ &notice( ["notice"], "Downloading twirssi from $URL" );
+ my $new_twirssi = get( $URL );
+
+ my $new_md5;
+ unless ( $data or $settings{upgrade_beta} ) {
+ eval " use Digest::MD5; ";
+
+ if ($@) {
+ &error( "Failed to load Digest::MD5."
+ . " Try '/twirssi_upgrade nomd5' to skip MD5 verification" );
+ return;
+ }
+
+ $new_md5 = Digest::MD5::md5_hex($new_twirssi);
+
+ my $fh;
+ unless ( open( $fh, '<', $loc ) ) {
+ &error( "Failed to read $loc."
+ . " Check that /set twirssi_location is set to the correct location."
+ );
+ return;
+ }
+
+ my $cur_md5 = Digest::MD5::md5_hex(<$fh>);
+ close $fh;
+
+ if ( $cur_md5 eq $new_md5 ) {
+ &error( "Current twirssi seems to be up to date." );
+ return;
+ }
+ }
+
+ open my $fh, '>', "$loc.upgrade"
+ or return &error("Failed to write upgrade to $loc.upgrade $!");
+ print $fh $new_twirssi;
+ close $fh;
+
+ unless ( -s "$loc.upgrade" ) {
+ &error( "Failed to save $loc.upgrade."
+ . " Check that /set twirssi_location is set to the correct location."
+ );
+ return;
+ }
+
+ rename $loc, "$loc.backup"
+ or &error( "Failed to back up $loc: $!. Aborting" )
+ and return;
+ rename "$loc.upgrade", $loc
+ or &error( "Failed to rename $loc.upgrade: $!. Aborting" )
+ and return;
+
+ my ( $dir, $file ) = ( $loc =~ m{(.*)/([^/]+)$} );
+ if ( -e "$dir/autorun/$file" ) {
+ &notice( ["notice"], "Updating $dir/autorun/$file" );
+ unlink "$dir/autorun/$file"
+ or
+ &error( "Failed to remove old $file from autorun: $!" );
+ symlink "../$file", "$dir/autorun/$file"
+ or &error( "Failed to create symlink in autorun directory: $!" );
+ }
+
+ &notice( ["notice"],
+ "Download complete. Reload twirssi with /twirssi_reload" );
+}
+
+sub cmd_list_channels {
+ my ( $data, $server, $win ) = @_;
+
+ &notice("Current output channels:");
+ foreach my $type ( sort keys %{ $state{__channels} } ) {
+ &notice("$type:");
+ foreach my $tag ( sort keys %{ $state{__channels}{$type} } ) {
+ &notice(" $tag:");
+ foreach my $net_tag ( sort keys %{ $state{__channels}{$type}{$tag} } ) {
+ &notice(" $net_tag: "
+ . join ', ', @{ $state{__channels}{$type}{$tag}{$net_tag} });
+ }
+ }
+ }
+ &notice("Add new entries using /twirssi_set_channel "
+ . "[[-]type|*] [account|search_term|*] [net_tag] [channel]" );
+ &notice("Type can be one of: tweet, reply, dm, search, sender, error.",
+ "A '*' for type/tag indicates wild"
+ . " (if type is wild, ensure account qualified: [user]\@[service]).",
+ "Remove settings by negating type, e.g. '-tweet'.");
+}
+
+sub cmd_set_channel {
+ my ( $data, $server, $win ) = @_;
+
+ my @words = split ' ', lc $data;
+ unless (@words == 4) {
+ return &cmd_list_channels(@_);
+ }
+
+ my ($type, $tag, $net_tag, $channame) = @words;
+ my $delete = 1 if $type =~ s/^-//;
+
+ unless ( grep { $type eq $_ } @{ $valid_types{'channel'} } ) {
+ &error( "Invalid message type '$type'.",
+ 'Valid types: ' . join(', ', @{ $valid_types{'channel'} }));
+ return;
+ }
+
+ $tag = &normalize_username($tag) unless grep { $type eq $_ } qw/ search sender * /
+ or $tag eq '*';
+
+ if ($delete) {
+ if (not defined $state{__channels}{$type}
+ or not defined $state{__channels}{$type}{$tag}
+ or not defined $state{__channels}{$type}{$tag}{$net_tag}
+ or not grep { $_ eq $channame } @{ $state{__channels}{$type}{$tag}{$net_tag} }) {
+ &notice("No such channel setting for $type/$tag on $net_tag.");
+ return;
+ }
+ &notice("$type/$tag messages will no longer be sent"
+ . " to the '$channame' channel on $net_tag" );
+ @{ $state{__channels}{$type}{$tag}{$net_tag} } =
+ grep { $_ ne $channame } @{ $state{__channels}{$type}{$tag}{$net_tag} };
+ delete $state{__channels}{$type}{$tag}{$net_tag}
+ unless @{ $state{__channels}{$type}{$tag}{$net_tag} };
+ delete $state{__channels}{$type}{$tag}
+ unless keys %{ $state{__channels}{$type}{$tag} };
+ delete $state{__channels}{$type}
+ unless keys %{ $state{__channels}{$type} };
+
+ } elsif (defined $state{__channels}{$type}{$tag}{$net_tag}
+ and grep { $_ eq $channame }
+ @{ $state{__channels}{$type}{$tag}{$net_tag} }) {
+ &notice("There is already such a channel setting.");
+ return;
+
+ } else {
+ &notice("$type/$tag messages will now be sent"
+ . " to the '$channame' channel on $net_tag" );
+ push @{ $state{__channels}{$type}{$tag}{$net_tag} }, $channame;
+ }
+
+ &save_state();
+ return;
+}
+
+sub cmd_list_windows {
+ my ( $data, $server, $win ) = @_;
+
+ &notice("Current output windows:");
+ foreach my $type ( sort keys %{ $state{__windows} } ) {
+ &notice("$type:");
+ foreach my $tag ( sort keys %{ $state{__windows}{$type} } ) {
+ &notice(" $tag: $state{__windows}{$type}{$tag}");
+ }
+ }
+ &notice( "Default window for all other messages: " . $settings{window} );
+
+ &notice("Add new entries with the /twirssi_set_window "
+ . "[type] [tag] [window] command." );
+ &notice("Remove a setting by setting window name to '-'.");
+}
+
+sub cmd_set_window {
+ my ( $data, $server, $win ) = @_;
+
+ my @words = split ' ', $data;
+
+ unless (@words) {
+ &cmd_list_windows(@_);
+ return;
+ }
+
+ my $winname = pop @words; # the last argument is the window name
+ my $delete = $winname eq '-';
+
+ if ( @words == 0 ) { # just a window name
+ $winname = 'twitter' if $delete;
+ &notice("Changing the default twirssi window to $winname");
+ Irssi::settings_set_str( "twitter_window", $winname );
+ &ensure_logfile($settings{window} = $winname);
+ } elsif ( @words > 2 and $words[0] ne 'search' ) {
+ &notice(
+ "Too many arguments to /twirssi_set_window. '@words'",
+ "Usage: /twirssi_set_window [type] [account|search_term] [window].",
+ 'Valid types: ' . join(', ', @{ $valid_types{'window'} })
+ );
+ return;
+ } elsif ( @words >= 1 ) {
+ my $type = lc $words[0];
+ unless ( grep { $_ eq $type } @{ $valid_types{'window'} } ) {
+ &error("Invalid message type '$type'.",
+ 'Valid types: ' . join(', ', @{ $valid_types{'window'} }));
+ return;
+ }
+
+ my $tag = "default";
+ if ( @words >= 2 ) {
+ $tag = lc $words[1];
+ if ($type eq 'sender') {
+ $tag =~ s/^\@//;
+ $tag =~ s/\@.+//;
+ } elsif ($type ne 'search'
+ and ($type ne 'default' or index($tag, '@') >= 0)
+ and $tag ne 'default') {
+ $tag = &normalize_username($tag);
+ } elsif ($type eq 'search' and @words > 2) {
+ $tag = lc join(' ', @words[1..$#words]);
+ }
+ if (substr($tag, -1, 1) eq '@') {
+ &error("Invalid tag '$tag'.");
+ return;
+ }
+ }
+
+ if ($delete) {
+ if (not defined $state{__windows}{$type}
+ or not defined $state{__windows}{$type}{$tag}) {
+ &notice("No such window setting for $type/$tag.");
+ return;
+ }
+ &notice("$type/$tag messages will no longer be sent to the '"
+ . $state{__windows}{$type}{$tag} . "' window" );
+ delete $state{__windows}{$type}{$tag};
+ delete $state{__windows}{$type}
+ unless keys %{ $state{__windows}{$type} };
+ } else {
+ &notice("$type/$tag messages will now"
+ . " be sent to the '$winname' window" );
+ $state{__windows}{$type}{$tag} = $winname;
+ }
+
+ &save_state();
+ }
+
+ &ensure_window($winname) if $winname ne '-';
+
+ return;
+}
+
+sub get_friends {
+ my $u_twit = shift;
+ my $username = shift;
+ my $fh = shift;
+ my $is_update = shift;
+
+ my $new_friends = &scan_cursor('friends', $u_twit, $username, $fh,
+ { fn=>'friends', cp=>(index($username, '@Twitter') != -1 ? 'c' : 'p'),
+ set_key=>'users', item_key=>'screen_name', });
+ return if not defined $new_friends;
+
+ return $new_friends if not $is_update;
+
+ my ( $added, $removed ) = ( 0, 0 );
+ # &debug($fh, "%G$username%n Scanning for new friends...");
+ foreach ( keys %$new_friends ) {
+ next if exists $friends{$username}{$_};
+ $friends{$username}{$_} = $new_friends->{$_};
+ $added++;
+ }
+
+ # &debug($fh, "%G$username%n Scanning for removed friends...");
+ foreach ( keys %{ $friends{$username} } ) {
+ next if exists $new_friends->{$_};
+ delete $friends{$username}{$_};
+ &debug($fh, "%G$username%n removing friend: $_");
+ $removed++;
+ }
+
+ return ( $added, $removed );
+}
+
+sub scan_cursor {
+ my $type_str = shift;
+ my $u_twit = shift;
+ my $username = shift;
+ my $fh = shift;
+ my $fn_info = shift;
+
+ my $whole_set = ($fn_info->{want_array} ? [] : {});
+ my $fn_args = { (defined $fn_info->{args} ? %{ $fn_info->{args} } : ()) };
+ my $fn_name = $fn_info->{fn};
+ my $pg_type = index($fn_info->{cp}, 'c') >= 0 ? 'cursor' : ($fn_info->{cp} =~ /p(\d*)/ ? 'page' : '');
+ my $max_page = 10;
+ $max_page = $1 if $pg_type eq 'page' and length($1) > 0;
+ eval {
+ for (my($cursor, $page) = (-1, 1); $cursor and $page <= $max_page; $page++) {
+ if ($pg_type eq 'cursor') {
+ $fn_args->{cursor} = $cursor if $cursor > 0;
+ } elsif ($pg_type eq 'page') {
+ $fn_args->{page} = $page;
+ }
+ &debug($fh, "%G$username%n Loading $type_str $pg_type " . ($pg_type eq 'cursor' ? $cursor : $page));
+ my $collection;
+ if ($fn_name =~ /^(get|post|put|delete)$/ and defined $fn_info->{endpoint}) {
+ $collection = $u_twit->$fn_name($fn_info->{endpoint}, $fn_args);
+ } else {
+ $collection = $u_twit->$fn_name($fn_args);
+ }
+ last if not $collection;
+ if ($pg_type eq 'cursor') {
+ $cursor = $collection->{next_cursor};
+ $collection = $collection->{$fn_info->{set_key}} if defined $fn_info->{set_key};
+ }
+ last if 0 == @$collection;
+ if ($fn_info->{want_array}) {
+ push @$whole_set, @$collection;
+ next;
+ }
+ foreach my $coll_item (@$collection) {
+ if ($pg_type eq 'page'
+ and defined $whole_set->{$coll_item->{$fn_info->{item_key}}}) {
+ &debug($fh, "%G$username%n repeated page $page key " . $fn_info->{item_key} .
+ ' val ' . $coll_item->{$fn_info->{item_key}} .
+ ''); #' pre ' . Dumper($whole_set->{$coll_item->{$fn_info->{item_key}}}));
+ next;
+ }
+ $whole_set->{$coll_item->{$fn_info->{item_key}}} = (
+ defined $fn_info->{item_val}
+ ? $coll_item->{$fn_info->{item_val}}
+ : (defined $fn_info->{item_keys}
+ ? (ref($fn_info->{item_keys}) eq 'ARRAY'
+ ? { map { $_ => $coll_item->{$_} } @{ $fn_info->{item_keys} } }
+ : { %$coll_item })
+ : time)
+ );
+ $fn_args->{max_id} = $coll_item->{id_str} if defined $fn_args->{since_id};
+ }
+ }
+ if ($settings{debug}) {
+ foreach my $item (split "\n", Dumper($whole_set)) { &debug($fh, "$pg_type: $item"); } # TODO remove
+ }
+ };
+
+ if ($@) {
+ &error([$username, $fh], "Error updating $type_str. Aborted.");
+ &debug($fh, "%G$username%n Error updating $type_str: $@");
+ return;
+ }
+
+ return $whole_set;
+}
+
+sub get_lists {
+ my $u_twit = shift;
+ my $username = shift;
+ my $fh = shift;
+ my $is_update = shift;
+ my $userid = shift;
+ my $list_name = shift;
+
+ my $list_account = $username;
+ if ($is_update and not defined $userid and $username =~ /(.+)\@/) {
+ $userid = $1;
+ } else {
+ $list_account = &normalize_username($userid, 1);
+ }
+
+ my %stats = (added => 0, deleted => 0);
+
+ # ensure $new_lists->{$list_name} = $id
+ my %more_args = ();
+ my $new_lists = &scan_cursor('lists', $u_twit, $username, $fh,
+ { fn=>'list_ownerships', cp=>'c', set_key=>'lists',
+ args=>{ user=>$userid, %more_args }, item_key=>'name', item_val=>'id', });
+ return if not defined $new_lists;
+
+ # reduce $new_lists if $list_name specified (not $is_update)
+ if (defined $list_name) {
+ if (not defined $new_lists->{$list_name}) {
+ return {}; # not is_update, so return empty
+ }
+ $new_lists = { $list_name => $new_lists->{$list_name} };
+ }
+
+ foreach my $list (keys %$new_lists) {
+ $stats{added}++ if not exists $state{__lists}{$list_account}{$list};
+ $state{__lists}{$list_account}{$list} = { id=>$new_lists->{$list}, members=>[], };
+ }
+
+ if ($is_update) {
+ # remove any newly-missing lists
+ foreach my $old_list (keys %{ $state{__lists}{$list_account} }) {
+ if (not defined $new_lists->{$old_list}) {
+ delete $state{__lists}{$list_account}{$old_list};
+ &debug($fh, "%G$username%n removing list: $list_account / $old_list");
+ $stats{deleted}++;
+ }
+ }
+ }
+
+ foreach my $reget_list (keys %$new_lists) {
+ &debug($fh, "%G$username%n updating list: $list_account / $reget_list id=" .
+ $state{__lists}{$list_account}{$reget_list}{id});
+ my $members = &scan_cursor('list member', $u_twit, $username, $fh,
+ { fn=>'list_members', cp=>'c', set_key=>'users', item_key=>'screen_name', item_val=>'id',
+ args=>{ user=>$userid, list_id=>$state{__lists}{$list_account}{$reget_list}{id} }, });
+ return if not defined $members;
+ $state{__lists}{$list_account}{$reget_list}{members} = [ keys %$members ];
+ }
+
+ return ($stats{added}, $stats{deleted});
+}
+
+sub get_blocks {
+ my $u_twit = shift;
+ my $username = shift;
+ my $fh = shift;
+ my $is_update = shift;
+
+ my $new_blocks = &scan_cursor('blocks', $u_twit, $username, $fh,
+ { fn=>'blocking', cp=>'c', set_key=>'users', item_key=>'screen_name', });
+ return if not defined $new_blocks;
+
+ return $new_blocks if not $is_update;
+
+ my ( $added, $removed ) = ( 0, 0 );
+ # &debug($fh, "%G$username%n Scanning for new blocks...");
+ foreach ( keys %$new_blocks ) {
+ next if exists $blocks{$username}{$_};
+ $blocks{$username}{$_} = time;
+ $added++;
+ }
+
+ # &debug($fh, "%G$username%n Scanning for removed blocks...");
+ foreach ( keys %{ $blocks{$username} } ) {
+ next if exists $new_blocks->{$_};
+ delete $blocks{$username}{$_};
+ &debug($fh, "%G$username%n removing block: $_");
+ $removed++;
+ }
+
+ return ( $added, $removed );
+}
+
+sub get_reply_to {
+ # extract reply-to-information from tweets
+ my $t = shift;
+
+ if ($t->{in_reply_to_screen_name}
+ and $t->{in_reply_to_status_id}) {
+ return sprintf 'reply_to_user:%s reply_to_id:%s ',
+ $t->{in_reply_to_screen_name},
+ $t->{in_reply_to_status_id};
+ } else {
+ return '';
+ }
+}
+
+sub cmd_wipe {
+ my ( $data, $server, $win ) = @_;
+ my @cache_keys = qw/ __tweets __indexes __ids
+ __usernames __reply_to_ids __reply_to_users __created_ats /;
+ my @surplus_nicks = ();
+ if ($data eq '') {
+ for my $nick (keys %{ $state{__tweets} }) {
+ my $followed = 0;
+ for my $acct (keys %twits) {
+ if (grep { lc($_) eq $nick } keys %{ $friends{$acct} }) {
+ $followed = 1;
+ last;
+ }
+ }
+ push @surplus_nicks, $nick if not $followed;
+ }
+ } else {
+ for my $to_wipe (split(/\s+/, $data)) {
+ if (exists $state{$to_wipe}) {
+ &notice("Wiping '$to_wipe' state.");
+ $state{$to_wipe} = {};
+ } elsif ($to_wipe eq '-f') {
+ push @surplus_nicks, keys %{ $state{__tweets} };
+ } elsif ($to_wipe eq '-A') {
+ &notice('Wiping all info/settings.');
+ %state = ();
+ } else {
+ &error("No such twirssi_wipe argument '$to_wipe'.");
+ }
+ }
+ }
+ if (@surplus_nicks) {
+ for my $surplus_nick (@surplus_nicks) {
+ for my $cache_key (@cache_keys) {
+ delete $state{$cache_key}{$surplus_nick};
+ }
+ }
+ &debug('Wiped data for ' . join(',', @surplus_nicks));
+ &notice('Wiped data for ' . (0+@surplus_nicks) . ' nicks.');
+ }
+}
+
+sub cmd_user {
+ my $target = shift;
+ my $server = shift;
+ my $win = shift;
+ $target =~ s/(?::\d+)?\s*$//;
+ &cmd_set_window("sender $target $target", $server, $win)
+ if $target =~ s/^\s*-w\s+// and $target ne '';
+ &get_updates([ 0, [
+ [ "$user\@$defservice", { up_user => $target } ],
+ ],
+ ]);
+}
+
+sub tweet_to_meta {
+ my $obj = shift;
+ my $t = shift;
+ my $username = shift;
+ my $type = shift;
+ my $topic = shift;
+ my %meta = (
+ username => $username,
+ type => $type,
+ nick => ($type eq 'dm' ? $t->{sender_screen_name}
+ : $t->{user}{screen_name}),
+ );
+ ($meta{account}, $meta{service}) = split('@', $username, 2);
+ foreach my $meta_key (keys %meta_to_twit) {
+ $meta{$meta_key} = $t->{$meta_to_twit{$meta_key}} if defined $t->{$meta_to_twit{$meta_key}};
+ }
+ $meta{created_at} = $meta{ts} // &date_to_epoch($meta{created_at});
+ $meta{topic} = $topic if defined $topic;
+ $meta{text} = &get_text($t, $obj);
+ return \%meta;
+}
+
+sub tweet_or_reply {
+ my $obj = shift;
+ my $t = shift;
+ my $username = shift;
+ my $cache = shift;
+ my $fh = shift;
+
+ my $type = 'tweet';
+ if ( $t->{in_reply_to_screen_name}
+ and $username !~ /^\Q$t->{in_reply_to_screen_name}\E\@/i
+ and not exists $friends{$username}{ $t->{in_reply_to_screen_name} } ) {
+ $nicks{ $t->{in_reply_to_screen_name} } = time;
+ unless ( $cache->{ $t->{in_reply_to_status_id} } ) {
+ eval {
+ $cache->{ $t->{in_reply_to_status_id} } =
+ $obj->show_status( $t->{in_reply_to_status_id} );
+ };
+ }
+&debug($fh, "REPLY $username rep2 $@ " . Dumper($cache->{ $t->{in_reply_to_status_id} }));
+ if (my $t_reply = $cache->{ $t->{in_reply_to_status_id} }) {
+ if (defined $fh) {
+ my $ctext = &get_text( $t_reply, $obj );
+ printf $fh "t:tweet id:%s ac:%s %snick:%s ts:%s %s\n",
+ $t_reply->{id}, $username, &get_reply_to($t_reply),
+ $t_reply->{user}{screen_name}, &get_ts($t_reply), $ctext;
+ &get_unshorten_urls($ctext, $fh);
+ }
+ $type = 'reply';
+ }
+ }
+ return $type;
+}
+
+sub background_setup {
+ my $pause_monitor = shift || 5000;
+ my $max_pauses = shift || 24;
+ my $is_update = shift;
+ my $fn_to_call = shift;
+ my $fn_args_ref = shift;
+
+ &debug("bg_setup starting upd=$is_update");
+
+ return unless &logged_in($twit);
+
+ my ( $fh, $filename ) = File::Temp::tempfile('tw_'.$$.'_XXXX', TMPDIR => 1);
+ my $done_filename = "$filename.done";
+ unlink($done_filename) if -f $done_filename;
+ binmode( $fh, ":" . &get_charset() );
+ $child_pid = fork();
+
+ if ($child_pid) { # parent
+ Irssi::timeout_add_once( $pause_monitor, 'monitor_child',
+ [ $done_filename, $max_pauses, $pause_monitor, $is_update, $filename . '.' . $child_pid, 0 ] );
+ Irssi::pidwait_add($child_pid);
+ } elsif ( defined $child_pid ) { # child
+ my $pid_filename = $filename . '.' . $$;
+ rename $filename, $pid_filename;
+ close STDIN;
+ close STDOUT;
+ close STDERR;
+
+ {
+ no strict 'refs';
+ &$fn_to_call($fh, @$fn_args_ref);
+ }
+
+ close $fh;
+ rename $pid_filename, $done_filename;
+ exit;
+ } else {
+ &error("Failed to fork for background call: $!");
+ }
+}
+
+sub ensure_updates {
+ my $adhoc_interval = shift;
+ my $poll_interval = (defined $adhoc_interval ? $adhoc_interval : &get_poll_time) * 1000;
+ if ($poll_interval != $last_poll{__interval} or not $poll_event) {
+ &debug("get_updates every " . int($poll_interval/1000));
+ Irssi::timeout_remove($poll_event) if $poll_event;
+ $poll_event = Irssi::timeout_add( $poll_interval, \&get_updates, [ 1 ] );
+ $last_poll{__interval} = $poll_interval;
+ }
+}
+
+sub get_updates {
+ my $args = shift;
+
+ my $is_regular = 0;
+ my $to_be_updated;
+ if (not ref $args) { # command-line request, so do regular
+ $is_regular = 1;
+ } else {
+ $is_regular = $args->[0];
+ $to_be_updated = $args->[1];
+ }
+
+ &debug("get_updates starting upd=$is_regular");
+
+ return unless &logged_in($twit);
+
+ if ($is_regular) {
+ if ($update_is_running) {
+ &debug("get_updates aborted: already running");
+ return;
+ }
+ $update_is_running = 1;
+ }
+
+ if (not defined $to_be_updated) {
+ $to_be_updated = [];
+ foreach my $pref_user (@{ $settings{update_usernames} }) {
+ next unless $pref_user = &valid_username($pref_user);
+ next if grep { $_ eq $pref_user } @{ $settings{ignored_accounts} };
+ push @$to_be_updated, [ $pref_user, {} ];
+ }
+ foreach my $other_user (keys %twits) {
+ next if grep { $_ eq $other_user } @{ $settings{ignored_accounts} };
+ push @$to_be_updated, [ $other_user, {} ]
+ if not grep { $other_user eq $_->[0] } @$to_be_updated;
+ }
+ }
+ &background_setup(5000, (24*@$to_be_updated), $is_regular, 'get_updates_child', [ $is_regular, $to_be_updated ]);
+
+ if ($is_regular) {
+ &ensure_updates();
+ }
+}
+
+sub get_updates_child {
+ my $fh = shift;
+ my $is_regular = shift;
+ my $to_be_updated = shift;
+
+ my $time_before_update = time;
+
+ my $error = 0;
+ my @error_types = ();
+ my %context_cache;
+
+ foreach my $update_tuple ( @$to_be_updated ) {
+ my $username = shift @$update_tuple;
+ my $what_to_update = shift @$update_tuple;
+ my $errors_beforehand = $error;
+
+ if (0 == keys(%$what_to_update)
+ or defined $what_to_update->{up_tweets}) {
+ unless (&get_tweets( $fh, $username, $twits{$username}, \%context_cache )) {
+ $error++;
+ push @error_types, 'tweets';
+ }
+
+ if ( exists $state{__last_id}{$username}{__extras}
+ and keys %{ $state{__last_id}{$username}{__extras} } ) {
+ my @frusers = sort keys %{ $state{__last_id}{$username}{__extras} };
+
+ unless (&get_timeline( $fh, $frusers[ $fix_replies_index{$username} ],
+ $username, $twits{$username}, \%context_cache, $is_regular )) {
+ $error++;
+ push @error_types, 'replies';
+ }
+
+ $fix_replies_index{$username}++;
+ $fix_replies_index{$username} = 0
+ if $fix_replies_index{$username} >= @frusers;
+ print $fh "t:fix_replies_index idx:$fix_replies_index{$username} ",
+ "ac:$username\n";
+ }
+ }
+ next if $error > $errors_beforehand;
+
+ if (defined $what_to_update->{up_user}) {
+ unless (&get_timeline( $fh, $what_to_update->{up_user},
+ $username, $twits{$username}, \%context_cache, $is_regular )) {
+ $error++;
+ push @error_types, 'tweets';
+ }
+
+ }
+ next if $error > $errors_beforehand;
+
+ if (0 == keys(%$what_to_update)
+ or defined $what_to_update->{up_dms}) {
+ unless (&do_dms( $fh, $username, $twits{$username}, $is_regular )) {
+ $error++;
+ push @error_types, 'dms';
+ }
+ }
+ next if $error > $errors_beforehand;
+
+ if (0 == keys(%$what_to_update)
+ or defined $what_to_update->{up_subs}) {
+ unless (&do_subscriptions( $fh, $username, $twits{$username}, $what_to_update->{up_subs} )) {
+ $error++;
+ push @error_types, 'subs';
+ }
+ }
+ next if $error > $errors_beforehand;
+
+ if (0 == keys(%$what_to_update)
+ or defined $what_to_update->{up_searches}) {
+ unless (&do_searches( $fh, $username, $twits{$username}, $what_to_update->{up_searches} )) {
+ $error++;
+ push @error_types, 'searches';
+ }
+ }
+ next if $error > $errors_beforehand;
+
+ if ( (0 == keys(%$what_to_update)
+ and time - $last_poll{$username}{friends} > $settings{friends_poll})
+ or defined $what_to_update->{up_friends} ) {
+ my $show_friends;
+ if ($is_regular) {
+ my $time_before = time;
+ my ( $added, $removed ) = &get_friends($twits{$username}, $username, $fh, 1);
+ print $fh "t:debug %G$username%n Friends list updated: ",
+ "$added added, $removed removed\n" if $added + $removed;
+ print $fh "t:last_poll ac:$username poll_type:friends epoch:$time_before\n";
+ $show_friends = $friends{$username};
+ } else {
+ $show_friends = &get_friends($twits{$username}, $username, $fh, 0);
+ }
+ foreach ( sort keys %$show_friends ) {
+ print $fh "t:friend ac:$username nick:$_ epoch:$show_friends->{$_}\n";
+ }
+ }
+ next if $error > $errors_beforehand;
+
+ if ( (0 == keys(%$what_to_update)
+ and time - $last_poll{$username}{blocks} > $settings{blocks_poll} )
+ or defined $what_to_update->{up_blocks}) {
+ my $show_blocks;
+ if ($is_regular) {
+ my $time_before = time;
+ my ( $added, $removed ) = &get_blocks($twits{$username}, $username, $fh, 1);
+ print $fh "t:debug %G$username%n Blocks list updated: ",
+ "$added added, $removed removed\n" if $added + $removed;
+ print $fh "t:last_poll ac:$username poll_type:blocks epoch:$time_before\n";
+ $show_blocks = $blocks{$username};
+ } else {
+ $show_blocks = &get_blocks($twits{$username}, $username, $fh, 0);
+ }
+ foreach ( sort keys %$show_blocks ) {
+ print $fh "t:block ac:$username nick:$_ epoch:$show_blocks->{$_}\n";
+ }
+ }
+ next if $error > $errors_beforehand;
+
+ if ( (0 == keys(%$what_to_update)
+ and time - $last_poll{$username}{lists} > $settings{lists_poll} )
+ or defined $what_to_update->{up_lists}) {
+ my $list_account = $username;
+ my $list_name_limit;
+ if ($is_regular) {
+ my $time_before = time;
+ my ( $added, $removed ) = &get_lists($twits{$username}, $username, $fh, 1);
+ print $fh "t:debug %G$username%n Lists list updated: ",
+ "$added added, $removed removed\n" if $added or $removed;
+ print $fh "t:last_poll ac:$username poll_type:lists epoch:$time_before\n";
+ } else {
+ if (defined $what_to_update->{up_lists} and ref $what_to_update->{up_lists}
+ and defined $what_to_update->{up_lists}->[0]) {
+ $list_account = &normalize_username($what_to_update->{up_lists}->[0], 1);
+ if (defined $what_to_update->{up_lists}->[1]) {
+ $list_name_limit = $what_to_update->{up_lists}->[1];
+ }
+ }
+ if (not defined &get_lists($twits{$username}, $username, $fh, 0, @{ $what_to_update->{up_lists} })) {
+ &debug($fh, "%G$username%n Polling for lists failed.");
+ $error++;
+ push @error_types, 'lists';
+ }
+ }
+ if (not defined $state{__lists}{$list_account}) {
+ &notice(['info', undef, $fh], "List owner $list_account does not exist or has no lists.")
+ if not $is_regular;
+ } elsif (defined $list_name_limit and not defined $state{__lists}{$list_account}{$list_name_limit}) {
+ &notice(['info', undef, $fh], "List $list_account/$list_name_limit does not exist.")
+ if not $is_regular;
+ } else {
+ foreach my $list_name (sort keys %{ $state{__lists}{$list_account} }) {
+ next if defined $list_name_limit and $list_name ne $list_name_limit;
+ my $list_id = $state{__lists}{$list_account}{$list_name}{id};
+ foreach my $member ( @{ $state{__lists}{$list_account}{$list_name}{members} } ) {
+ print $fh "t:list ac:$username list:$list_account/$list_name id:$list_id nick:$member\n";
+ }
+ }
+ }
+ }
+ next if $error > $errors_beforehand;
+ }
+
+ &put_unshorten_urls($fh, $time_before_update);
+
+ if ($error) {
+ &error([$fh], "Update encountered errors (@error_types). Aborted");
+ # &error( [$fh], "For recurring DMs errors, please re-auth (delete $settings{oauth_store})") if grep { $_ eq 'dms' } @error_types;
+ } elsif ($is_regular) {
+ print $fh "t:last_poll poll_type:__poll epoch:$time_before_update\n";
+ }
+}
+
+sub is_ignored {
+ my $text = shift;
+ my $twit = shift;
+
+ my $text_no_colors = &remove_colors($text);
+ foreach my $tag (@{ $settings{ignored_tags} }) {
+ return $tag if $text_no_colors =~ /(?:^|\b|\s)\Q$tag\E(?:\b|\s|$)/i;
+ }
+ if (defined $twit and grep { $_ eq lc $twit } @{ $settings{ignored_twits} }) {
+ return $twit;
+ }
+ return undef;
+}
+
+sub remove_tags {
+ my $text = shift;
+
+ foreach my $tag (@{ $settings{stripped_tags} }) {
+ $text =~ s/\cC\d{2}\Q$tag\E\cO//gi; # with then without colors
+ $text =~ s/(^|\b|\s)\Q$tag\E(\b|\s|$)/$1$2/gi;
+ }
+ return $text;
+}
+
+sub get_ts {
+ my $t = shift;
+ return $t->{created_timestamp} / 1000 if defined $t->{created_timestamp};
+ return &date_to_epoch($t->{created_at});
+}
+
+sub get_tweets {
+ my ( $fh, $username, $obj, $cache ) = @_;
+
+ return if &rate_limited($obj, $username, $fh);
+
+ my %call_attribs = (
+ tweet_mode => 'extended',
+ count => 200,
+ );
+ $call_attribs{since_id} = $state{__last_id}{$username}{timeline}
+ if defined $state{__last_id}{$username}{timeline};
+
+ my $tweets = &scan_cursor('home_timeline', $obj, $username, $fh, {
+ fn => 'home_timeline', cp => 'p', args => \%call_attribs,
+ item_key => 'id_str', item_keys => 1,
+ });
+
+ if (not defined $tweets) {
+ print $fh "t:error $username Error during home_timeline call: Aborted.\n";
+ return;
+ }
+ $tweets = [ map { $tweets->{$_} } sort { cmp_id($b, $a) } keys %$tweets ];
+
+ print $fh "t:debug %G$username%n got ", scalar(@$tweets), ' tweets',
+ (@$tweets ? ', first/last: ' . join('/',
+ (sort {$a->{id} <=> $b->{id}} @$tweets)[0]->{id},
+ (sort {$a->{id} <=> $b->{id}} @$tweets)[$#{$tweets}]->{id}
+ )
+ : ''),
+ "\n";
+
+ my $new_poll_id = 0;
+ my @own_ids = ();
+ foreach my $t ( reverse @$tweets ) {
+ my $text = &get_text( $t, $obj );
+ $text = &remove_tags($text);
+ my $ign = &is_ignored($text, $t->{user}{screen_name});
+ $ign = (defined $ign ? 'ign:' . &encode_for_file($ign) . ' ' : '');
+ my $reply = &tweet_or_reply($obj, $t, $username, $cache, $fh);
+ if ($t->{user}{screen_name} eq $username and not $settings{own_tweets}) {
+ push @own_ids, $t->{id};
+ next;
+ }
+ printf $fh "t:%s id:%s ac:%s %s%snick:%s ts:%s %s\n",
+ $reply, $t->{id}, $username, $ign, &get_reply_to($t), $t->{user}{screen_name},
+ &get_ts($t), $text;
+ &get_unshorten_urls($text, $fh);
+
+ $new_poll_id = $t->{id} if $new_poll_id < $t->{id};
+ }
+ &debug($fh, "%G$username%n skip own " . join(', ', @own_ids) . "\n") if @own_ids;
+ printf $fh "t:last_id id:%s ac:%s id_type:timeline\n", $new_poll_id, $username if $new_poll_id;
+
+ &debug($fh, "%G$username%n Polling for replies since " . $state{__last_id}{$username}{reply});
+ my $arg_ref = { tweet_mode => 'extended' };
+ if ( $state{__last_id}{$username}{reply} ) {
+ $arg_ref->{since_id} = $state{__last_id}{$username}{reply};
+ }
+ eval {
+ $tweets = $obj->replies( $arg_ref ) || [];
+ };
+
+ if ($@) {
+ print $fh "t:debug %G$username%n Error during replies call. Aborted.\n";
+ &debug($fh, "%G$username%n Error: " . $@);
+ return;
+ }
+
+ $new_poll_id = 0;
+ foreach my $t ( reverse @$tweets ) {
+ next if exists $friends{$username}{ $t->{user}{screen_name} };
+
+ my $text = &get_text( $t, $obj );
+ $new_poll_id = $t->{id} if $new_poll_id < $t->{id};
+ $text = &remove_tags($text);
+ &get_unshorten_urls($text, $fh);
+ my $ign = &is_ignored($text);
+ $ign = (defined $ign ? 'ign:' . &encode_for_file($ign) . ' ' : '');
+ printf $fh "t:tweet id:%s ac:%s %s%snick:%s ts:%s %s\n",
+ $t->{id}, $username, $ign, &get_reply_to($t), $t->{user}{screen_name},
+ &get_ts($t), $text;
+ }
+ printf $fh "t:last_id id:%s ac:%s id_type:reply\n", $new_poll_id, $username if $new_poll_id;
+ return 1;
+}
+
+
+sub do_dms {
+ my ( $fh, $username, $obj, $is_regular ) = @_;
+
+ my $new_poll_id = 0;
+
+ my $dm_args = { tweet_mode => 'extended' };
+ if ( $is_regular and $state{__last_id}{$username}{dm} ) {
+ $dm_args->{since_id} = $state{__last_id}{$username}{dm};
+ &debug($fh, "%G$username%n Polling for DMs since_id " .
+ $state{__last_id}{$username}{dm});
+ } else {
+ &debug($fh, "%G$username%n Polling for DMs");
+ }
+
+ my $dms;
+ eval {
+ $dms = &scan_cursor('DMs', $obj, $username, $fh, {
+ fn=>'get', endpoint=>'direct_messages/events/list', cp=>'c', args=>{},
+ set_key=>'events', want_array=>1,
+ });
+ return if not defined $dms;
+
+ #$dms = $obj->post('direct_messages/events/list', $dm_args) || {};
+ };
+ if ($@) {
+ &debug($fh, "%G$username%n Error during direct_messages call. Aborted.");
+ &debug($fh, "%G$username%n Error: " . $@);
+ return;
+ }
+ &debug($fh, "%G$username%n got DMs: " . (0+@$dms));
+ return 1 unless 0+@$dms;
+ if ($settings{debug}) {
+ foreach my $item (split "\n", Dumper($dms)) { &debug($fh, "dm: $item"); } # TODO remove
+ }
+
+ foreach my $t ( reverse @$dms ) {
+ # XXX last if $t->{id_str} eq $state{__last_id}{$username}{dm};
+ my $text = decode_entities( get_full_text($t->{message_create}->{message_data}) );
+ $text =~ s/[\n\r]/ /g;
+
+ my $sender_id = $t->{message_create}->{sender_id};
+ my $sender_nick = &id_to_user($obj, $sender_id, "dms", $fh);
+ if (not defined $sender_nick) {
+ &error(['dms', $fh], "update encountered error. Skipping DM for " . $sender_id);
+ next;
+ }
+ next if &normalize_username($sender_nick) eq $username;
+
+ printf $fh "t:dm id:%s ac:%s %snick:%s ts:%s %s\n",
+ $t->{id}, $username, &get_reply_to($t), $sender_nick, &get_ts($t), $text;
+ $new_poll_id = $t->{id} if $new_poll_id < $t->{id};
+ }
+ printf $fh "t:last_id id:%s ac:%s id_type:dm\n", $new_poll_id, $username if $new_poll_id;
+ return 1;
+}
+
+sub do_subscriptions {
+ my ( $fh, $username, $obj, $search_limit ) = @_;
+
+ &debug($fh, "%G$username%n Polling for subscriptions");
+ if ( $obj->can('search') and $state{__last_id}{$username}{__search} ) {
+ my $search;
+ foreach my $topic ( sort keys %{ $state{__last_id}{$username}{__search} } ) {
+ next if defined $search_limit and @$search_limit and not grep { $topic eq $_ } @$search_limit;
+ print $fh "t:debug %G$username%n Search '$topic' id was ",
+ "$state{__last_id}{$username}{__search}{$topic}\n";
+ eval {
+ $search = $obj->search(
+ {
+ tweet_mode => 'extended',
+ q => $topic,
+ since_id => $state{__last_id}{$username}{__search}{$topic} eq '9223372036854775807'
+ ? 0
+ : $state{__last_id}{$username}{__search}{$topic},
+ }
+ );
+ };
+
+ if ($@) {
+ print $fh
+ "t:debug %G$username%n Error during search($topic) call. Aborted.\n";
+ &debug($fh, "%G$username%n Error: " . $@);
+ return;
+ }
+
+ unless ( $search->{search_metadata}->{max_id} ) {
+ print $fh "t:debug %G$username%n Invalid search results when searching",
+ " for '$topic'. Aborted.\n";
+ return;
+ } elsif ( $search->{search_metadata}->{max_id} eq '9223372036854775807' ) {
+ &debug($fh, "%G$username%n Error: search max_id = MAX_INT64");
+ $state{__last_id}{$username}{__search}{$topic} = 0;
+ foreach my $t ( reverse @{ $search->{statuses} } ) {
+ $state{__last_id}{$username}{__search}{$topic} = $t->{id}
+ if cmp_id($t->{id}, $state{__last_id}{$username}{__search}{$topic}) > 0;
+ }
+ } else {
+ $state{__last_id}{$username}{__search}{$topic} = $search->{search_metadata}->{max_id};
+ }
+
+ printf $fh "t:searchid id:%s ac:%s topic:%s\n",
+ $state{__last_id}{$username}{__search}{$topic}, $username, &encode_for_file($topic);
+
+ foreach my $t ( reverse @{ $search->{statuses} } ) {
+ next if exists $blocks{$username}{ $t->{user}->{screen_name} };
+ my $text = &get_text( $t, $obj );
+ $text = &remove_tags($text);
+ my $ign = &is_ignored($text, $t->{user}->{screen_name});
+ &get_unshorten_urls($text, $fh);
+ $ign = (defined $ign ? 'ign:' . &encode_for_file($ign) . ' ' : '');
+ printf $fh "t:search id:%s ac:%s %snick:%s topic:%s ts:%s %s\n",
+ $t->{id}, $username, $ign, $t->{user}->{screen_name}, &encode_for_file($topic),
+ &get_ts($t), $text;
+ }
+ }
+ }
+ return 1;
+}
+
+sub do_searches {
+ my ( $fh, $username, $obj, $search_limit ) = @_;
+
+ &debug($fh, "%G$username%n Polling for one-time searches");
+ if ( $obj->can('search') and exists $search_once{$username} ) {
+ my $search;
+ foreach my $topic ( sort keys %{ $search_once{$username} } ) {
+ next if defined $search_limit and @$search_limit and not grep { $topic eq $_ } @$search_limit;
+ my $max_results = $search_once{$username}->{$topic};
+
+ $topic = &make_utf8($topic);
+
+ print $fh
+ "t:debug %G$username%n search $topic once (max $max_results)\n";
+ eval {
+ $search = $obj->search( {
+ q => $topic,
+ tweet_mode => 'extended',
+ } );
+ };
+
+ if (my $err = $@) {
+ $err = $err->error . ' (' . $err->code . ' ' . $err->message . ')' if ref($err) =~ /(?:Net::Twitter|Twitter::API)::Error/;
+ print $fh "t:debug %G$username%n Error during search_once($topic) call. Aborted.\n";
+ &debug($fh, "%G$username%n Error: $err");
+ return;
+ }
+
+ unless ( $search->{search_metadata}->{max_id} ) {
+ print $fh "t:debug %G$username%n Invalid search results when searching once",
+ " for $topic. Aborted.\n";
+ return;
+ }
+
+ # TODO: consider applying ignore-settings to search results
+ my @results = ();
+ foreach my $res (@{ $search->{statuses} }) {
+ if (exists $blocks{$username}{ $res->{user}->{screen_name} }) {
+ print $fh "t:debug %G$username%n blocked $topic: $res->{user}->{screen_name}\n";
+ next;
+ }
+ push @results, $res;
+ }
+ if ( $max_results > 0 ) {
+ splice @results, $max_results;
+ }
+ foreach my $t ( reverse @results ) {
+ my $text = &get_text( $t, $obj );
+ $text = &remove_tags($text);
+ &get_unshorten_urls($text, $fh);
+ my $ign = &is_ignored($text, $t->{user}->{screen_name});
+ $ign = (defined $ign ? 'ign:' . &encode_for_file($ign) . ' ' : '');
+ printf $fh "t:search_once id:%s ac:%s %s%snick:%s topic:%s ts:%s %s\n",
+ $t->{id}, $username, $ign, &get_reply_to($t), $t->{user}->{screen_name}, &encode_for_file($topic),
+ &get_ts($t), $text;
+ }
+ }
+ }
+
+ return 1;
+}
+
+sub get_timeline {
+ my ( $fh, $target, $username, $obj, $cache, $is_update ) = @_;
+ my $tweets;
+ my $last_id = $state{__last_id}{$username}{__extras}{$target} if $is_update;
+
+ &debug($fh, "%G$username%n get_timeline $target"
+ . ($is_update ? "($fix_replies_index{$username} > $last_id)" : ''));
+ my $arg_ref = {
+ id => $target,
+ tweet_mode => 'extended',
+ };
+ if ($is_update) {
+ $arg_ref->{since_id} = $last_id if $last_id;
+ $arg_ref->{include_rts} = 1 if $settings{retweet_show};
+ } elsif ($settings{limit_user_tweets} and $settings{limit_user_tweets} =~ /\b(\d+)\b/) {
+ $arg_ref->{count} = $1;
+ }
+ eval {
+ $tweets = $obj->user_timeline($arg_ref);
+ };
+
+ if ($@) {
+ print $fh "t:error $username user_timeline($target) call: Aborted.\n";
+ print $fh "t:debug : $_\n" foreach split /\n/, Dumper($@);
+ return;
+ }
+
+ unless ($tweets) {
+ print $fh "t:error $username user_timeline($target) call returned undef! Aborted\n";
+ return 1;
+ }
+
+ my $not_before = time - $1*86400 if not $is_update and $settings{limit_user_tweets} and $settings{limit_user_tweets} =~ /\b(\d+)d\b/;
+ foreach my $t ( reverse @$tweets ) {
+ my $ts = &get_ts($t);
+ next if defined $not_before and $ts < $not_before;
+ my $text = &get_text( $t, $obj );
+ my $reply = &tweet_or_reply($obj, $t, $username, $cache, $fh);
+ printf $fh "t:%s id:%s ac:%s %snick:%s ts:%s %s\n",
+ $reply, $t->{id}, $username, &get_reply_to($t), $t->{user}{screen_name}, $ts, $text;
+ $last_id = $t->{id} if $last_id < $t->{id};
+ &get_unshorten_urls($text, $fh);
+ }
+ if ($is_update) {
+ printf $fh "t:last_id_fixreplies id:%s ac:%s id_type:%s\n",
+ $last_id, $username, $target;
+ }
+
+ return 1;
+}
+
+sub encode_for_file {
+ my $datum = shift;
+ $datum =~ s/\t/%09/g;
+ $datum =~ s/ /%20/g;
+ return $datum;
+}
+
+sub decode_from_file {
+ my $datum = shift;
+ $datum =~ s/%20/ /g;
+ $datum =~ s/%09/\t/g;
+ return $datum;
+}
+
+sub date_to_epoch {
+ # parse created_at style date to epoch time
+ my $date = shift;
+ if (not @datetime_parser) {
+ foreach my $date_fmt (
+ '%a %b %d %T %z %Y', # Fri Nov 05 10:14:05 +0000 2010
+ '%a, %d %b %Y %T %z', # Fri, 05 Nov 2010 16:59:40 +0000
+ ) {
+ my $parser = DateTime::Format::Strptime->new(pattern => $date_fmt);
+ if (not defined $parser) {
+ @datetime_parser = ();
+ return;
+ }
+ push @datetime_parser, $parser;
+ }
+ }
+ # my $orig_date = $date;
+ $date = $datetime_parser[index($date, ',') == -1 ? 0 : 1]->parse_datetime($date);
+ # &debug("date '$orig_date': " . ref($date));
+ return if not defined $date;
+ return $date->epoch();
+}
+
+sub meta_to_line {
+ my $meta = shift;
+ my %line_attribs = (
+ username => $meta->{username}, epoch => $meta->{created_at},
+ type => $meta->{type}, account => $meta->{account},
+ service => $meta->{service}, nick => $meta->{nick},
+ hilight => 0, hi_nick => $meta->{nick},
+ text => $meta->{text}, topic => $meta->{topic},
+ level => MSGLEVEL_PUBLIC,
+ );
+
+ if ($meta->{type} eq 'dm' or $meta->{type} eq 'error' or $meta->{type} eq 'deerror') {
+ $line_attribs{level} = MSGLEVEL_MSGS;
+ }
+
+ my $nick = "\@$meta->{account}";
+ if ( $meta->{text} =~ /\Q$nick\E(?:\W|$)/i ) {
+ my $hilight_color = $irssi_to_mirc_colors{ $settings{hilight_color} };
+ $line_attribs{level} |= MSGLEVEL_HILIGHT;
+ $line_attribs{hi_nick} = "\cC$hilight_color$meta->{nick}\cO";
+ }
+ elsif ($settings{nick_color} eq 'rotate') {
+ my $c = get_nick_color($meta->{nick});
+ $line_attribs{hi_nick} = "\cC$c$meta->{nick}\cO";
+ }
+
+ if (defined $meta->{ign}) {
+ $line_attribs{ignoring} = 1;
+ $line_attribs{marker} = '-' . $meta->{ign}; # must have a marker for tweet theme
+
+ } elsif ( $meta->{type} ne 'dm' and $meta->{nick} and $meta->{id} and not $meta->{ign} ) {
+ ### not ignored, so we probably want it cached and create a :marker...
+ my $marker;
+ my $lc_nick = lc $meta->{nick};
+ for (my $mark_idx = 0;
+ defined $state{__ids}{ $lc_nick } and $mark_idx < @{ $state{__ids}{ $lc_nick } };
+ $mark_idx++) {
+ if ($state{__ids}{ $lc_nick }[$mark_idx] eq $meta->{id}) {
+ $marker = $mark_idx;
+ last;
+ }
+ }
+ if (not defined $marker) {
+ $marker = ( $state{__indexes}{ $lc_nick } + 1 ) % $settings{track_replies};
+ $state{__ids} { $lc_nick }[$marker] = $meta->{id};
+ $state{__indexes}{ $lc_nick } = $marker;
+ $state{__tweets} { $lc_nick }[$marker] = $meta->{text};
+ foreach my $key (qw/username reply_to_id reply_to_user created_at/) {
+ # __usernames __reply_to_ids __reply_to_users __created_ats
+ $state{"__${key}s"}{ $lc_nick }[$marker] = $meta->{$key} if defined $meta->{$key};
+ }
+ }
+ $line_attribs{marker} = ":$marker";
+ }
+ return %line_attribs;
+}
+
+sub cache_to_meta {
+ my $line = shift;
+ my $type = shift;
+ my %meta = ( type => $type );
+ foreach my $key (@{ $_[0] }) {
+ if ($line =~ s/^$key:(\S+)\s*//) {
+ $key = 'account' if $key eq 'ac';
+ $meta{$key} = $1;
+ $meta{$key} = &decode_from_file($meta{$key});
+ if ($key eq 'account') {
+ $meta{username} = &normalize_username($meta{account}); # username is account@Service
+ $meta{account} =~ s/\@(\w+)$//;
+ $meta{service} = $1;
+ } elsif ($key eq 'ts') {
+ $meta{created_at} = $meta{ts};
+ } elsif ($key eq 'created_at') {
+ $meta{created_at} = &date_to_epoch($meta{created_at});
+ }
+ }
+ }
+ $meta{text} = $line;
+ return %meta;
+}
+
+sub monitor_child {
+ my $args = shift;
+
+ my $filename = $args->[0];
+ my $attempts_to_go = $args->[1];
+ my $wait_time = $args->[2];
+ my $is_update = $args->[3];
+ my $filename_tmp = $args->[4];
+ my $prev_mtime = $args->[5];
+
+ my $file_progress = 'no ' . $filename_tmp;
+ my $this_mtime = $prev_mtime;
+ if (-f $filename_tmp) {
+ $this_mtime = (stat(_))[9];
+ $file_progress = 'mtime=' . $this_mtime;
+ }
+ &debug("checking child log at $filename [$file_progress v $prev_mtime] ($attempts_to_go)");
+
+ # reap any random leftover processes - work around a bug in irssi on gentoo
+ waitpid( -1, WNOHANG );
+
+ # first time we run we don't want to print out *everything*, so we just
+ # pretend
+
+ my @lines = ();
+ my %new_cache = ();
+ my %types_per_user = ();
+ my $got_errors = 0;
+ my %show_now = (); # for non-update info
+
+ my $fh;
+ if ( -e $filename and open $fh, '<', $filename ) {
+ binmode $fh, ":" . &get_charset();
+ } else {
+ # file not ready yet
+
+ if ( $attempts_to_go > 0 ) {
+ Irssi::timeout_add_once( $wait_time, 'monitor_child',
+ [ $filename, $attempts_to_go - 1, $wait_time, $is_update, $filename_tmp, $this_mtime ] );
+ } else {
+ &debug("Giving up on polling $filename");
+ Irssi::pidwait_remove($child_pid);
+ waitpid( -1, WNOHANG );
+ unlink $filename unless &debug();
+
+ if (not $is_update) {
+ &error("Failed to get response. Giving up.");
+ return;
+ }
+
+ $update_is_running = 0 if $is_update;
+
+ return unless $settings{notify_timeouts};
+
+ my $since;
+ if ( time - $last_poll{__poll} < 24 * 60 * 60 ) {
+ my @time = localtime($last_poll{__poll});
+ $since = sprintf( "%d:%02d", @time[ 2, 1 ] );
+ } else {
+ $since = scalar localtime($last_poll{__poll});
+ }
+
+ if ( $failstatus < 2 and time - $last_poll{__poll} > 60 * 60 ) {
+ &error( $settings{mini_whale}
+ ? 'FAIL WHALE'
+ : q{ v v v},
+ q{ | | v | v},
+ q{ | .-, | | |},
+ q{ .--./ / | _.---.| },
+ q{ '-. (__..-" \\},
+ q{ \\ a |},
+ q{ ',.__. ,__.-'/},
+ q{ '--/_.'----'`}
+ );
+ $failstatus = 2;
+ }
+
+ if ( $failstatus == 0 and time - $last_poll{__poll} < 600 ) {
+ &error("Haven't been able to get updated tweets since $since");
+ $failstatus = 1;
+ }
+ }
+
+ return;
+ }
+
+ # make sure we're not in slurp mode
+ local $/ = "\n";
+ while (<$fh>) {
+ unless (/\n$/) { # skip partial lines
+ &debug($fh, "Skipping partial line: $_");
+ next;
+ }
+ chomp;
+
+ my $type;
+ if (s/^t:(\w+)\s+//) {
+ $type = $1;
+ } else {
+ &error("invalid: $_");
+ next;
+ }
+
+ if ($type eq 'debug') {
+ &debug($_);
+
+ } elsif ($type =~ /^(error|info|deerror)$/) {
+ $got_errors++ if $type eq 'error';
+ &notice([$type], $_);
+
+ } elsif ($type eq 'uid') {
+ my %meta = &cache_to_meta($_, $type, [ qw/ nick id / ]);
+ $state{__i}{$meta{id}} = $meta{nick};
+ $state{__u}{$meta{nick}}{id} = $meta{id};
+
+ } elsif ($type eq 'url') {
+ my %meta = &cache_to_meta($_, $type, [ qw/epoch https site uri/ ]);
+ $expanded_url{$meta{site}}{$meta{https} ? 1 : 0}{$meta{uri}} = {
+ url => $meta{text},
+ epoch => $meta{epoch},
+ };
+
+ } elsif ($type eq 'last_poll') {
+ my %meta = &cache_to_meta($_, $type, [ qw/ac poll_type epoch/ ]);
+
+ if ( not defined $meta{ac} and $meta{poll_type} eq '__poll' ) {
+ $last_poll{$meta{poll_type}} = $meta{epoch};
+ } elsif ( $meta{epoch} >= $last_poll{$meta{username}}{$meta{poll_type}} ) {
+ $last_poll{$meta{username}}{$meta{poll_type}} = $meta{epoch};
+ &debug("%G$meta{username}%n $meta{poll_type} updated to $meta{epoch}");
+ } else {
+ &debug("%G$meta{username}%n Impossible! $meta{poll_type}: "
+ . "new poll=$meta{epoch} < prev=$last_poll{$meta{username}}{$meta{poll_type}}!");
+ $got_errors++;
+ }
+
+ } elsif ($type eq 'fix_replies_index') {
+ my %meta = &cache_to_meta($_, $type, [ qw/idx ac topic id_type/ ]);
+ $fix_replies_index{ $meta{username} } = $meta{idx};
+ &debug("%G$meta{username}%n fix_replies_index set to $meta{idx}");
+
+ } elsif ($type eq 'searchid' or $type eq 'last_id_fixreplies' or $type eq 'last_id') {
+ my %meta = &cache_to_meta($_, $type, [ qw/id ac topic id_type/ ]);
+ if ( $meta{type} eq 'searchid' ) {
+ &debug("%G$meta{username}%n Search '$meta{topic}' got id $meta{id}");
+ if (not exists $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} }
+ or $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} } eq '9223372036854775807'
+ or cmp_id($meta{id}, $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} }) > 0) {
+ $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} } = $meta{id};
+ } else {
+ &debug("%G$meta{username}%n Search '$meta{topic}' bad id $meta{id}");
+ $got_errors++;
+ }
+ } elsif ( $meta{type} eq 'last_id') {
+ $state{__last_id}{ $meta{username} }{ $meta{id_type} } = $meta{id}
+ if cmp_id($meta{id}, $state{__last_id}{ $meta{username} }{ $meta{id_type} }) > 0;
+ } elsif ( $meta{type} eq 'last_id_fixreplies' ) {
+ $state{__last_id}{ $meta{username} }{__extras}{ $meta{id_type} } = $meta{id}
+ if cmp_id($meta{id}, $state{__last_id}{ $meta{username} }{__extras}{ $meta{id_type} }) > 0;
+ }
+
+ } elsif ($type eq 'tweet' or $type eq 'dm' or $type eq 'reply' or $type eq 'search' or $type eq 'search_once') { # cf theme_register
+ my %meta = &cache_to_meta($_, $type, [ qw/id ac ign reply_to_user reply_to_id nick topic created_at ts / ]);
+
+ if (exists $new_cache{ $meta{id} }) {
+ &debug("SKIP newly-cached $meta{id}");
+ next;
+ }
+ $new_cache{ $meta{id} } = time;
+ if (exists $tweet_cache{ $meta{id} }) {
+ # and (not $retweeted_id{$username} or not $retweeted_id{$username}{ $meta{id} });
+ &debug("SKIP cached $meta{id}");
+ next;
+ }
+
+ my %line_attribs = &meta_to_line(\%meta);
+ push @lines, { %line_attribs };
+
+ if ( $meta{type} eq 'search' ) {
+ if ( exists $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} }
+ and cmp_id($meta{id}, $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} }) > 0) {
+ $state{__last_id}{ $meta{username} }{__search}{ $meta{topic} } = $meta{id};
+ }
+ } elsif ( $meta{type} eq 'search_once' ) {
+ delete $search_once{ $meta{username} }->{ $meta{topic} };
+ }
+
+ } elsif ($type eq 'friend' or $type eq 'block' or $type eq 'list') {
+ my %meta = &cache_to_meta($_, $type, [ qw/ac list id nick epoch/ ]);
+ if ($is_update and not defined $types_per_user{$meta{username}}{$meta{type}}) {
+ if ($meta{type} eq 'friend') {
+ $friends{$meta{username}} = ();
+ } elsif ($meta{type} eq 'block') {
+ $blocks{$meta{username}} = ();
+ } elsif ($meta{type} eq 'list') {
+ my ($list_account, $list_name) = split '/', $meta{list};
+ $state{__lists}{$list_account} = {};
+ }
+ $types_per_user{$meta{username}}{$meta{type}} = 1;
+ }
+ if ($meta{type} eq 'friend') {
+ $nicks{$meta{nick}} = $friends{$meta{username}}{$meta{nick}} = $meta{epoch};
+ } elsif ($meta{type} eq 'block') {
+ $blocks{$meta{username}}{$meta{nick}} = $meta{epoch};
+ } elsif ($meta{type} eq 'list') {
+ my ($list_account, $list_name) = split '/', $meta{list};
+ if (not exists $state{__lists}{$list_account}{$list_name}) {
+ $state{__lists}{$list_account}{$list_name} = { id=>$meta{id}, members=>[] };
+ }
+ $show_now{lists}{$list_account}{$list_name} = $meta{id} if not $is_update;
+ push @{ $state{__lists}{$list_account}{$list_name}{members} }, $meta{nick};
+ }
+
+ } else {
+ &error("invalid type ($type): $_");
+ }
+ }
+
+ # file was opened, so we tried to parse...
+ close $fh;
+
+ # make sure the pid is removed from the waitpid list
+ Irssi::pidwait_remove($child_pid);
+
+ # and that we don't leave any zombies behind, somehow
+ waitpid( -1, WNOHANG );
+
+ &debug("new last_poll = $last_poll{__poll}",
+ "new last_poll_id = " . Dumper( $state{__last_id} )) if $is_update;
+ if ($is_update and $first_call and not $settings{force_first}) {
+ &debug("First call, not printing updates");
+ } else {
+
+ if (exists $show_now{lists}) {
+ for my $list_account (keys %{ $show_now{lists} }) {
+ my $list_ac = ($list_account eq "$user\@$defservice" ? '' : "$list_account/");
+ for my $list_name (keys %{ $show_now{lists}{$list_account} }) {
+ if (0 == @{ $state{__lists}{$list_account}{$list_name}{members} }) {
+ &notice(['info'], "List $list_ac$list_name is empty.");
+ } else {
+ &notice("List $list_ac$list_name members: " .
+ join(', ', @{ $state{__lists}{$list_account}{$list_name}{members} }));
+ }
+ }
+ }
+ }
+
+ &write_lines(\@lines, $is_update);
+ }
+
+ unlink $filename or warn "Failed to remove $filename: $!" unless &debug();
+
+ # commit the pending cache lines to the actual cache, now that
+ # we've printed our output
+ for my $updated_id (keys %new_cache) {
+ $tweet_cache{$updated_id} = $new_cache{$updated_id};
+ }
+
+ # keep enough cached tweets, to make sure we don't show duplicates
+ for my $loop_id ( keys %tweet_cache ) {
+ next if $tweet_cache{$loop_id} >= $last_poll{__poll} - 3600;
+ delete $tweet_cache{$loop_id};
+ }
+
+ if (not $got_errors) {
+ &save_state();
+ }
+
+ if ($is_update) {
+ if ($failstatus and not $got_errors) {
+ &notice([ 'deerror' ], "Update succeeded.");
+ $failstatus = 0;
+ }
+ $first_call = 0;
+ $update_is_running = 0;
+ }
+}
+
+sub cmp_id {
+ my $id1 = shift;
+ my $id2 = shift;
+ return -1 if length $id1 < length $id2;
+ return 1 if length $id1 > length $id2;
+ return $id1 cmp $id2;
+}
+
+sub write_lines {
+ my $lines_ref = shift;
+ my $is_update = shift;
+ my $ymd_color = $irssi_to_mirc_colors{ $settings{ymd_color} };
+ my @date_now = localtime();
+ my $ymd_now = sprintf('%04d-%02d-%02d', $date_now[5]+1900, $date_now[4]+1, $date_now[3]);
+ my $old_tf;
+ # &debug("line: " . Dumper $lines_ref);
+ foreach my $line (@$lines_ref) {
+ my $line_want_extras = $is_update;
+ my $win_name = &window( $line->{type}, $line->{username}, $line->{nick}, $line->{topic} );
+ my $ac_tag = '';
+ if ( lc $line->{service} ne lc $settings{default_service} ) {
+ $ac_tag = "$line->{username}: ";
+ } elsif ( $line->{username} ne "$user\@$defservice"
+ and lc $line->{account} ne lc $win_name ) {
+ $ac_tag = $line->{account} . ': ';
+ }
+
+ my @print_opts = (
+ $line->{level},
+ "twirssi_" . $line->{type}, # theme
+ $ac_tag,
+ );
+ push @print_opts, (lc $line->{topic} ne lc $win_name ? $line->{topic} . ':' : '')
+ if $line->{type} =~ /search/;
+ push @print_opts, $line->{hi_nick} if $line->{type} ne 'error' and $line->{type} ne 'deerror';
+ push @print_opts, $line->{marker} if defined $line->{marker};
+
+ # set timestamp
+ if (not defined $line->{epoch}) {
+ Irssi::window_find_name($settings{debug_win_name})->printformat(
+ @print_opts, &hilight( $line->{text} ) . " \cC${ymd_color}BAD DATE\cO"
+ );
+ next;
+ }
+ my @date = localtime($line->{epoch});
+ my $ymd = sprintf('%04d-%02d-%02d', $date[5]+1900, $date[4]+1, $date[3]);
+ my $ymd_suffix = '';
+ if (defined $line->{ignoring}) {
+ next if not $settings{debug};
+ $line->{text} = "\cC$irssi_to_mirc_colors{'%b'}IGNORED\cO " . $line->{text};
+ if ($settings{debug_win_name} ne '' ) {
+ $win_name = $settings{debug_win_name};
+ } else {
+ $win_name = '(status)';
+ $line->{text} = "%g[$IRSSI{name}] %n " . $line->{text};
+ }
+ $line_want_extras = 0;
+ } elsif (not $is_update) {
+ $ymd_suffix = " \cC$ymd_color$ymd\cO" if $ymd_now ne $ymd;
+ } elsif (not defined $last_ymd{wins}{$win_name}
+ or $last_ymd{wins}{$win_name}->{ymd} ne $ymd) {
+ Irssi::window_find_name($win_name)->printformat(MSGLEVEL_PUBLIC, 'twirssi_new_day', $ymd, '');
+ $last_ymd{wins}{$win_name}->{ymd} = $ymd;
+ }
+ my $ts = DateTime->from_epoch( epoch => $line->{epoch}, time_zone => $local_tz
+ )->strftime($settings{timestamp_format});
+ if (not defined $old_tf) {
+ $old_tf = Irssi::settings_get_str('timestamp_format');
+ }
+ $line->{text} = &post_process_tweet($line->{text});
+ Irssi::command("^set timestamp_format $ts");
+ Irssi::window_find_name($win_name)->printformat(
+ @print_opts, &hilight( $line->{text} ) . $ymd_suffix
+ );
+ if ($line_want_extras) {
+ &write_log($line, $win_name, \@date);
+ &write_channels($line, \@date);
+ }
+ }
+ # recall timestamp format
+ if (defined $old_tf) {
+ Irssi::command("^set timestamp_format $old_tf");
+ }
+}
+
+sub write_channels {
+ my $line = shift;
+ my $date_ref = shift;
+ my %msg_seen;
+ for my $type ($line->{type}, 'sender', '*') {
+ next unless defined $state{__channels}{$type};
+ for my $tag (($type eq 'sender' ? $line->{nick}
+ : ($line->{type} =~ /search/ ? $line->{topic}
+ : $line->{username})),
+ '*') {
+ next unless defined $state{__channels}{$type}{$tag};
+ for my $net_tag (keys %{ $state{__channels}{$type}{$tag} }) {
+ for my $channame (@{ $state{__channels}{$type}{$tag}{$net_tag} }) {
+ next if defined $msg_seen{$net_tag}{$channame};
+ my $server = Irssi::server_find_tag($net_tag);
+ $last_ymd{chans}{$channame} = {} if not defined $last_ymd{chans}{$channame};
+ for my $log_line (&log_format($line, $channame, $last_ymd{chans}{$channame}, $date_ref)) {
+ if (defined $server) {
+ $server->command("msg -$net_tag $channame $log_line");
+ $msg_seen{$net_tag}{$channame} = 1;
+ } else {
+ &notice("no server for $net_tag/$channame: $log_line");
+ }
+ }
+ }
+ }
+ }
+ }
+}
+
+sub write_log {
+ my $line = shift;
+ my $win_name = shift;
+ my $date_ref = shift;
+ return unless my $logfile_obj = &ensure_logfile($win_name);
+ my $fh = $logfile_obj->{fh};
+ for my $log_line (&log_format($line, $logfile_obj->{filename}, $logfile_obj, $date_ref, 1)) {
+ print $fh $log_line, "\n";
+ }
+}
+
+sub log_format {
+ my $line = shift;
+ my $target_name = shift;
+ my $ymd_obj = shift; # can be $last_ymd{chans}{$chan} or $logfile_obj (both need to have ->{ymd})
+ my $date_ref = shift;
+ my $to_file = shift;
+
+ my @logs = ();
+
+ my $ymd = sprintf('%04d-%02d-%02d', $date_ref->[5]+1900, $date_ref->[4]+1, $date_ref->[3]);
+ if ($ymd_obj->{ymd} ne $ymd) {
+ push @logs, "Day changed to $ymd (was ".$ymd_obj->{ymd}.")" if $ymd ne '';
+ $ymd_obj->{ymd} = $ymd;
+ }
+
+ my $out = '';
+ $out .= sprintf('%02d:%02d:%02d ', $date_ref->[2], $date_ref->[1], $date_ref->[0]) if $to_file;
+ if ( $line->{type} eq 'dm' ) {
+ $out .= 'DM @' . $line->{hi_nick} . ':';
+ } elsif ( $line->{type} eq 'search' or $line->{type} eq 'search_once' ) {
+ $out .= '[' . ($target_name =~ /$line->{topic}/ ? '' : "$line->{topic}:")
+ . '@' . $line->{hi_nick} . ']';
+ } elsif ( $line->{type} eq 'tweet' or $line->{type} eq 'reply' ) {
+ $out .= '<' . ($target_name =~ /$line->{account}/ ? '' : "$line->{account}:")
+ . '@' . $line->{hi_nick} . '>';
+ } else {
+ $out .= 'ERR:';
+ }
+ push @logs, $out . ' ' . ($to_file ? &remove_colors($line->{text}) : $line->{text});
+ return @logs;
+}
+
+sub remove_colors {
+ my $txt = shift;
+ $txt =~ s/\cC\d{2}(.*?)\cO/$1/g;
+ return $txt;
+}
+
+sub save_state {
+ # save state hash
+ if ( keys %state and my $file = $settings{replies_store} ) {
+ if ( open my $fh, '>', $file ) {
+ print $fh encode_json( \%state );
+ close $fh;
+ } else {
+ &error("Failed to write state to $file: $!");
+ }
+ }
+ # save id hash
+ if ( my $file = $settings{id_store} ) {
+ if ( open my $fh, '>', $file ) {
+ print $fh encode_json( \%tweet_cache );
+ close $fh;
+ } else {
+ &error("Failed to write IDs to $file: $!");
+ }
+ }
+}
+
+sub save_polls {
+ # save last_poll hash
+ if ( keys %last_poll and my $file = $settings{poll_store} ) {
+ if ( open my $fh, '>', $file ) {
+ print $fh encode_json( \%last_poll );
+ close $fh;
+ } else {
+ &error("Failed to write polls to $file: $!");
+ }
+ }
+}
+
+sub debug {
+ return if not $settings{debug};
+ my $fh;
+ $fh = shift if ref($_[0]) eq 'GLOB';
+ while (@_) {
+ my $line = shift;
+ next if not defined $line;
+ chomp $line;
+ for my $sub_line (split("\n", $line)) {
+ next if $sub_line eq '';
+ if ($fh) {
+ print $fh 't:debug +', substr(time, -3), ' ', $sub_line, "\n";
+ } elsif ($settings{debug_win_name} ne '') {
+ my $dbg_win = $settings{debug_win_name};
+ $dbg_win = $settings{window} if not &ensure_window($dbg_win);
+ Irssi::window_find_name($dbg_win)->print(
+ $sub_line, MSGLEVEL_PUBLIC );
+ } else {
+ print "[$IRSSI{name}] ", $sub_line;
+ }
+ }
+ }
+ return 1;
+}
+
+sub error {
+ my $ref = $_[0];
+ if (ref $ref) {
+ shift;
+ unshift @$ref, undef if 1 == @$ref and ref($ref->[0]) eq 'GLOB'; # [$fh] so add null tag
+ } else {
+ $ref = [];
+ }
+ &notice([ 'error', @$ref ], @_);
+}
+
+sub notice {
+ my ( $type, $tag, $fh, $theme );
+ if ( ref $_[0] ) {
+ ( $type, $tag, $fh ) = @{ shift @_ };
+ $theme = 'twirssi_' . $type;
+ }
+ foreach my $msg (@_) {
+ if (defined $fh) {
+ for my $sub_line (split("\n", $msg)) {
+ print $fh "t:$type ", ($tag ? "$tag " : '') . $sub_line, "\n" if $sub_line ne '';
+ }
+ } else {
+ my $col = '%G';
+ my $win_level = MSGLEVEL_PUBLIC;
+ my $win;
+ if ($tag eq '_tw_in_Win') {
+ $win = Irssi::active_win();
+ } elsif ($type eq 'crap') {
+ $win = Irssi::window_find_name(&window());
+ $col = '%R';
+ $win_level = MSGLEVEL_CLIENTCRAP;
+ } else {
+ $win = Irssi::window_find_name(&window( $type, $tag ));
+ }
+
+ if ($type =~ /^(error|info|deerror)$/) {
+ $win->printformat(MSGLEVEL_PUBLIC, $theme, $msg); # theme
+ } else {
+ $win->print("${col}***%n $msg", $win_level );
+ }
+ }
+ }
+}
+
+sub update_away {
+ my $data = shift;
+
+ if ( $data !~ /\@\w/ and $data !~ /^[dD] / ) {
+ my $server = Irssi::server_find_tag( $settings{bitlbee_server} );
+ if ($server) {
+ $server->send_raw("away :$data");
+ return 1;
+ } else {
+ &error("Can't find bitlbee server.",
+ "Update bitlbee_server or disable tweet_to_away" );
+ return 0;
+ }
+ }
+
+ return 0;
+}
+
+sub too_long {
+ my $data = shift;
+ my $alert_to = shift;
+
+ my $doing = 'Tweet';
+ my $max_len = $settings{tweet_max_chars};
+ if ($alert_to and $alert_to->[0] eq 'dm') {
+ # Twitter removed (more or less) the DM limit:
+ # https://blog.twitter.com/official/en_us/a/2015/removing-the-140-character-limit-from-direct-messages.html
+ $max_len = $settings{dm_max_chars};
+ $doing = 'DM';
+ }
+
+ if ( length $data > $max_len ) {
+ &notice( $alert_to,
+ "$doing is " . ( length $data - $max_len ) .
+ " characters too long (max is " . $max_len .
+ " chars, attempt was " . length($data) . " chars) - aborted" )
+ if defined $alert_to;
+ return 1;
+ }
+
+ return 0;
+}
+
+sub make_utf8 {
+ my $data = shift;
+ if ( !utf8::is_utf8($data) ) {
+ return decode &get_charset(), $data;
+ } else {
+ return $data;
+ }
+}
+
+sub valid_username {
+ my $username = shift;
+ my $orig_username = $username;
+
+ $username = &normalize_username($username);
+
+ unless ( exists $twits{$username} ) {
+ &error( [$username], "Unknown username '$username' from '$orig_username'" );
+ return;
+ }
+
+ return $username;
+}
+
+sub logged_in {
+ my $obj = shift;
+ unless ($obj) {
+ &error( "Not logged in! Use /twitter_login username" );
+ return 0;
+ }
+
+ return 1;
+}
+
+sub sig_complete {
+ my ( $complist, $window, $word, $linestart, $want_space ) = @_;
+
+ my $cmdchars = quotemeta Irssi::settings_get_str('cmdchars');
+ my $comp_type = '';
+ my $keep_at = 0;
+ my $lc_stag = '';
+
+ my $cmd = '';
+ my @args = ();
+ my $want_account = 0;
+ if ($linestart =~ m@^ [$cmdchars] (\S+?)(_as)? ((?: \s+ \S+ )*) \s* $@xi) {
+ $cmd = lc $1;
+ my $cmd_as = $2;
+ my $args = $3;
+ $args =~ s/^\s+//;
+ @args = split(/\s+/, $args);
+ if ($cmd_as) {
+ if (@args) {
+ # act as if "_as ac" is not there
+ shift @args;
+ } elsif ($cmd =~ /^(?:twitter|twirssi|tweet|dm|retweet)/) {
+ $want_account = 1;
+ }
+ }
+ }
+
+ if (not @args) {
+ if ($want_account or grep { $cmd eq $_ } @{ $completion_types{'account'} }) {
+ # '*_as' and 'account' types expect account as first arg
+ $word =~ s/^@//;
+ @$complist = grep /^\Q$word/i, map { s/\@.*// and $_ } keys %twits;
+ return;
+ }
+ if (grep { $cmd eq $_ } @{ $completion_types{'tweet'} }) {
+ # 'tweet' expects nick:num (we offer last num for each nick)
+ $word =~ s/^@//;
+ @$complist = map { "$_:$state{__indexes}{lc $_}" }
+ sort { $nicks{$b} <=> $nicks{$a} }
+ grep /^\Q$word/i, keys %{ $state{__indexes} };
+ return;
+ }
+ if (grep { $cmd eq $_ } @{ $completion_types{'nick'} }) {
+ # 'nick' expects a nick
+ $comp_type = 'nick';
+ }
+ }
+
+ # retweet_to non-first args
+ if ($cmd eq 'retweet_to') {
+ if (@args == 1) {
+ @$complist = grep /^\Q$word/i, map { "-$_->{tag}" } Irssi::servers();
+ return;
+ } elsif (@args == 2) {
+ @$complist = grep /^\Q$word/i, qw/ -channel -nick /;
+ return;
+ } elsif (@args == 3 and $args[2] =~ m{^ -(channel|nick) $}x) {
+ $lc_stag = lc $args[1];
+ $lc_stag = substr($lc_stag, 1) if substr($lc_stag, 0, 1) eq '-';
+ $comp_type = $1;
+ }
+ }
+
+ # twirssi_set_window twirssi_set_channel
+ if ($cmd eq 'twirssi_set_window' or $cmd eq 'twirssi_set_channel') {
+ my $set_type = substr($cmd, 12);
+ if (@args == 0) {
+ @$complist = grep /^\Q$word/i, @{ $valid_types{$set_type} };
+ return;
+ } elsif (@args == 1) {
+ $comp_type = 'nick';
+ } elsif (@args == 2) {
+ if ($set_type eq 'window') {
+ @$complist = map { $_->{name} || $_->{active}->{name} }
+ grep { my $n = $_->{name} || $_->{active}->{name}; $n =~ /^\Q$word\E/i } Irssi::windows();
+ return;
+ } elsif ($set_type eq 'channel') {
+ $comp_type = $set_type;
+ }
+ }
+ }
+
+ # anywhere in line...
+ if (not $comp_type and grep { $cmd eq $_ } @{ $completion_types{'re_nick'} }) {
+ # 're_nick' can have @nick anywhere
+ $comp_type = 'nick';
+ $keep_at = 1;
+ }
+
+ if ($comp_type eq 'channel') {
+ @$complist = map { $_->{name} }
+ grep { $_->{name} =~ /^\Q$word\E/i and ($lc_stag eq '' or lc($_->{server}->{tag}) eq $lc_stag) }
+ Irssi::channels();
+ return;
+ } elsif ($comp_type eq 'nick') {
+ my $prefix = $1 if $word =~ s/^(@)//;
+ @$complist = map { ($prefix and $keep_at) ? "$prefix$_" : $_ }
+ grep /^\Q$word/i, sort { $nicks{$b} <=> $nicks{$a} } keys %nicks;
+ return;
+ }
+}
+
+sub event_send_text {
+ my ( $line, $server, $win ) = @_;
+ my $awin = Irssi::active_win();
+
+ # if the window where we got our text was the twitter window, and the user
+ # wants to be lazy, tweet away!
+ my $acc = &window_to_account( $awin->get_active_name() );
+ if ( $acc and $settings{window_input} ) {
+ &cmd_tweet_as( "$acc $line", $server, $win );
+ }
+}
+
+sub event_setup_changed {
+ my $do_add = shift; # first run, want to add, too
+ my @changed_stgs = ();
+
+ foreach my $setting (@settings_defn) {
+ my $setting_changed = 0;
+ my $stg_type .= '_' . ($setting->[2] eq 'b' ? 'bool'
+ : $setting->[2] eq 'i' ? 'int'
+ : $setting->[2] eq 's' ? 'str' : '');
+ if ($stg_type eq '_') {
+ if ($do_add) {
+ print "ERROR: Bad opt '$setting->[2]' for $setting->[0]";
+ } else {
+ &error( "Bad opt '$setting->[2]' for $setting->[0]" );
+ }
+ next;
+ }
+
+ my $stg_type_fn;
+ if ($do_add) {
+ $stg_type_fn = 'Irssi::settings_add' . $stg_type; # settings_add_str, settings_add_int, settings_add_bool
+ no strict 'refs';
+ $settings{ $setting->[0] } = &$stg_type_fn( $IRSSI{name}, $setting->[1], $setting->[3] );
+ }
+
+ my $prev_stg;
+ {
+ $prev_stg = $settings{ $setting->[0] };
+ $stg_type_fn = 'Irssi::settings_get' . $stg_type; # settings_get_str, settings_get_int, settings_get_bool
+ no strict 'refs';
+ $settings{ $setting->[0] } = &$stg_type_fn( $setting->[1] );
+ }
+ if ($setting->[2] eq 's') {
+ my $pre_proc = $setting->[4];
+ my $trim = 1;
+ my $norm_user = 0;
+ my $is_list = 0;
+ while (defined $pre_proc and $pre_proc ne '') {
+ if ($pre_proc =~ s/^lc(?:,|$)//) {
+ $settings{$setting->[0]} = lc $settings{$setting->[0]};
+ } elsif ($pre_proc =~ s/^list\{(.)}(?:,|$)//) {
+ my $re = $1;
+ $re = qr/\s*$re\s*/ if $trim;
+ if ($settings{$setting->[0]} eq '') {
+ $settings{$setting->[0]} = [ ];
+ } else {
+ $settings{$setting->[0]} = [ split($re, $settings{$setting->[0]}) ];
+ if (grep { $_ eq $setting->[0] } ('passwords')) {
+ # ends '\', unescape separator: concatenate with next
+ for (my $i = 0; $i+1 < @{ $settings{$setting->[0]} }; $i++) {
+ while ( $settings{$setting->[0]}->[$i] =~ /\\$/ ) {
+ $settings{$setting->[0]}->[$i] .= "," . delete $settings{$setting->[0]}->[$i+1];
+ }
+ }
+ }
+ }
+ $is_list = 1;
+ } elsif ($pre_proc =~ s/^norm_user(?:,|$)//) {
+ $norm_user = 1;
+ } elsif ($do_add) {
+ print "ERROR: Bad opt pre-proc '$pre_proc' for $setting->[0]";
+ } else {
+ &error( "Bad opt pre-proc '$pre_proc' for $setting->[0]" );
+ }
+ if ($norm_user) {
+ my @normed = ();
+ for my $to_norm ($is_list ? @{ $settings{$setting->[0]} } : $settings{$setting->[0]} ) {
+ next if $to_norm eq '';
+ &debug($setting->[0] . ' to_norm {' . $to_norm . '}');
+ push @normed, &normalize_username($to_norm, 1);
+ }
+ $is_list = 1;
+ $settings{$setting->[0]} = ($is_list ? \@normed : $normed[0]);
+ }
+ }
+ if (Dumper($prev_stg) ne Dumper($settings{ $setting->[0] })) {
+ $setting_changed = 1;
+ }
+ } elsif ($prev_stg != $settings{ $setting->[0] }) {
+ $setting_changed = 1;
+ }
+ push @changed_stgs, $setting->[0] if $setting_changed and not $do_add;
+ if ($setting_changed or $do_add) {
+ if ($setting->[0] eq 'poll_interval'
+ or $setting->[0] eq 'poll_schedule' ) {
+ &ensure_updates();
+ }
+ }
+ }
+ &debug('changed settings: ' . join(', ', @changed_stgs)) if @changed_stgs;
+
+ &ensure_logfile($settings{window});
+
+ if ($do_add or grep 'url_unshorten', @changed_stgs) {
+ # want to load this in the parent to allow child to use it expediently
+ &load_ua();
+ }
+ &debug("Settings changed ($do_add):" . Dumper \%settings);
+}
+
+sub ensure_logfile() {
+ my $win_name = shift;
+ return unless $settings{logging};
+ my $new_logfile = Irssi::settings_get_str('autolog_path');
+ return if $new_logfile eq '';
+ $new_logfile =~ s/^~/$ENV{HOME}/;
+ $new_logfile = strftime($new_logfile, localtime());
+ $new_logfile =~ s/\$(tag\b|\{tag\})/$IRSSI{name}/g;
+ if ($new_logfile !~ s/\$(0\b|\{0\})/$win_name/g) {
+ # not per-window logging, so use default window name as key
+ $win_name = $settings{window};
+ }
+ return $logfile{$win_name} if defined $logfile{$win_name} and $new_logfile eq $logfile{$win_name}->{filename};
+ return if not &ensure_dir_for($new_logfile);
+ my $old_umask = umask(0177);
+ &debug("Logging to $new_logfile");
+ my $res;
+ if ( my $fh = FileHandle->new( $new_logfile, '>>' ) ) {
+ umask($old_umask);
+ binmode $fh, ':utf8';
+ $fh->autoflush(1);
+ $res = $logfile{$win_name} = {
+ 'fh' => $fh,
+ 'filename' => $new_logfile,
+ 'ymd' => '',
+ };
+ } else {
+ &error( "Failed to append to $new_logfile: $!" );
+ }
+ umask($old_umask);
+ return $res;
+}
+
+sub ensure_dir_for {
+ my $path = shift;
+ if (not $path =~ s@/[^/]+$@@) {
+ &debug("Cannot cd up $path");
+ return;
+ }
+ return 1 if $path eq '' or -d $path or $path eq '/';
+ return if not &ensure_dir_for($path);
+ if (not mkdir($path, 0700)) {
+ &debug("Cannot make $path: $!");
+ return;
+ }
+ return 1;
+}
+
+sub get_poll_time {
+ my $poll = $settings{poll_interval};
+
+ my $hhmm;
+ foreach my $tuple ( @{ $settings{poll_schedule} } ) {
+ if ( $tuple =~ /^(\d{4})-(\d{4}):(\d+)$/ ) {
+ $hhmm = sprintf('%02d%02d', (localtime())[2,1]) if not defined $hhmm;
+ my($range_from, $range_to, $poll_val) = ($1, $2, $3);
+ if ( ( $hhmm ge $range_from and $hhmm lt $range_to )
+ or ( $range_from gt $range_to
+ and ( $hhmm ge $range_from or $hhmm lt $range_to ) )
+ ) {
+ $poll = $poll_val;
+ }
+ }
+ }
+ return $poll if $poll >= 60;
+ return 60;
+}
+
+sub get_charset {
+ my $charset = $settings{charset};
+ return "utf8" if $charset =~ /^\s*$/;
+ return $charset;
+}
+
+my @available_nick_colors =(
+ 0, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
+ '0,2', '0,3', '0,5', '0,6',
+ '1,0', '1,3', '1,5', '1,6', '1,7', '1,10', '1,15',
+ '2,3', '2,7', '2,10', '2,15',
+ '3,2', '3,5', '3,10',
+ '4,2', '4,7',
+ '5,2', '5,3', '5,7', '5,10', '5,15',
+ '6,2', '6,7', '6,10', '6,15',
+ '8,2', '8,5', '8,6',
+ '9,2', '9,5', '9,6',
+ '10,2', '10,5', '10,6',
+ '11,2', '11,5', '11,6',
+ '12,2', '12,5',
+ '13,2', '13,15',
+ '14,2', '14,5', '14,6',
+ '15,2', '15,5', '15,6'
+);
+my %nick_colors;
+
+sub get_nick_color {
+ if ($settings{nick_color} eq 'rotate') {
+ my $nick = shift;
+
+ if (!defined $nick_colors{$nick}) {
+ my @chars = split //, lc $nick;
+ my $value = 0;
+ foreach my $char (@chars) {
+ $value += ord $char;
+ }
+ $nick_colors{$nick} = $available_nick_colors[$value % @available_nick_colors];
+ }
+ return $nick_colors{$nick};
+ } else {
+ return $irssi_to_mirc_colors{$settings{nick_color}};
+ }
+}
+
+sub hilight {
+ my $text = shift;
+
+ if ( $settings{nick_color} ) {
+ $text =~ s[(^|\W)\@(\w+)] {
+ my $c = get_nick_color($2);
+ qq[$1\cC$c\@$2\cO];
+ }eg;
+ }
+ if ( $settings{topic_color} ) {
+ my $c = $settings{topic_color};
+ $c = $irssi_to_mirc_colors{$c};
+ $text =~ s/(^|\W)(\#|\!)([-\w]+)/$1\cC$c$2$3\cO/g if $c;
+ }
+ $text =~ s/[\n\r]/ /g;
+
+ return $text;
+}
+
+sub shorten {
+ my $data = shift;
+
+ my $provider = $settings{url_provider};
+ if ( ( $settings{always_shorten} or &too_long($data) ) and $provider ) {
+ my @args;
+ if ( $provider eq 'Bitly' ) {
+ @args[ 1, 2 ] = split ',', $settings{url_args}, 2;
+ unless ( @args == 3 ) {
+ &notice([ 'crap' ],
+ "WWW::Shorten::Bitly requires a username and API key.",
+ "Set short_url_args to username,API_key or change your",
+ "short_url_provider."
+ );
+ return &make_utf8($data);
+ }
+ }
+
+ foreach my $url ( $data =~ /(https?:\/\/\S+[\w\/])/g ) {
+ eval {
+ $args[0] = $url;
+ my $short = makeashorterlink(@args);
+ if ($short) {
+ $data =~ s/\Q$url/$short/g;
+ } else {
+ &error( "Failed to shorten $url!" );
+ }
+ };
+ }
+ }
+
+ return &make_utf8($data);
+}
+
+
+sub load_ua {
+ return if defined $ua or not @{ $settings{url_unshorten} };
+ &notice("Loading LWP and ua...");
+ eval "use LWP;";
+ $ua = LWP::UserAgent->new(
+ env_proxy => 1,
+ timeout => 10,
+ agent => "$IRSSI{name}/$VERSION",
+ requests_redirectable => [],
+ );
+}
+
+
+sub is_url_from_shortener {
+ my $url = shift;
+ return unless @{ $settings{url_unshorten} }
+ and $url =~ s@^https?://([\w.]+)/.*@lc $1@e;
+ return grep { $url eq $_ } @{ $settings{url_unshorten} };
+}
+
+
+sub get_url_parts {
+ my $url = shift;
+ my @parts = ($url =~ m@^(https?)://([^/]+)/(.+)@i);
+ $parts[0] = lc $parts[0];
+ $parts[1] = lc $parts[1];
+ return @parts;
+}
+
+
+sub get_unshorten_urls {
+ my $text = shift;
+ my $fh = shift;
+ return unless @{ $settings{url_unshorten} };
+ foreach my $url ( $text =~ m@\b(https?://\S+[\w/])@g ) {
+ my @orig_url_parts;
+ my @url_parts;
+ my $new_url = $url;
+ my $max_redir = 4;
+ my $resp;
+ while ($max_redir-- > 0
+ and @url_parts = &get_url_parts($new_url)
+ and grep { $url_parts[1] eq $_ } @{ $settings{url_unshorten} }
+ and not defined $expanded_url{$url_parts[1]}{$url_parts[0] eq 'https' ? 1 : 0}{$url_parts[2]}
+ and $resp = $ua->head($new_url)
+ and (defined $resp->header('Location')
+ or (&debug($fh, "cut_short $new_url => " . $resp->header('Host')) and 0)
+ )) {
+ &debug($fh, "deshort $new_url => " . $resp->header('Location'));
+ @orig_url_parts = @url_parts if not @orig_url_parts;
+ $new_url = $resp->header('Location');
+ }
+ if (@orig_url_parts) {
+ $expanded_url{$orig_url_parts[1]}{$orig_url_parts[0] eq 'https' ? 1 : 0}{$orig_url_parts[2]} = {
+ url => $new_url,
+ epoch => time,
+ };
+ }
+ }
+}
+
+
+sub put_unshorten_urls {
+ my $fh = shift;
+ my $epoch = shift;
+ for my $site (keys %expanded_url) {
+ for my $https (keys %{ $expanded_url{$site} }) {
+ for my $uri (keys %{ $expanded_url{$site}{$https} }) {
+ next if $expanded_url{$site}{$https}{$uri}{epoch} < $epoch;
+ print $fh "t:url epoch:$expanded_url{$site}{$https}{$uri}{epoch} ",
+ ($https ? 'https:1 ' : ''),
+ "site:$site uri:$uri $expanded_url{$site}{$https}{$uri}{url}\n";
+ }
+ }
+ }
+}
+
+
+sub post_process_tweet {
+ my $data = shift;
+ my $skip_unshorten = shift;
+ if (@{ $settings{url_unshorten} } and not $skip_unshorten) {
+ for my $site (keys %expanded_url) {
+ for my $https (keys %{ $expanded_url{$site} }) {
+ my $url = ($https ? 'https' : 'http') . '://' . $site . '/';
+ next if -1 == index($data, $url);
+ for my $uri (keys %{ $expanded_url{$site}{$https} }) {
+ $data =~ s/\Q$url$uri\E/$& \cC$irssi_to_mirc_colors{$settings{unshorten_color}}<$expanded_url{$site}{$https}{$uri}{url}>\cO/g;
+ }
+ }
+ }
+ }
+ return &make_utf8($data);
+}
+
+
+sub normalize_username {
+ my $user = shift;
+ my $non_login = shift;
+ return '' if $user eq '';
+
+ my ( $username, $service ) = split /\@/, lc($user), 2;
+ if ($service) {
+ $service = ucfirst $service;
+ } else {
+ $service = ucfirst lc $settings{default_service};
+ unless ( $non_login or exists $twits{"$username\@$service"} ) {
+ $service = undef;
+ foreach my $t ( sort keys %twits ) {
+ next unless $t =~ /^\Q$username\E\@(Twitter|Identica)/;
+ $service = $1;
+ last;
+ }
+
+ unless ($service) {
+ &error( "Can't find a logged in user '$user'" );
+ return "$username\@$settings{default_service}";
+ }
+ }
+ }
+
+ return "$username\@$service";
+}
+
+sub get_text {
+ my $tweet = shift;
+ my $object = shift;
+ my $text = decode_entities( get_full_text($tweet) );
+ if ( exists $tweet->{retweeted_status} ) {
+ $text = &format_expand(
+ fmt => $settings{retweeted_format} || $settings{retweet_format},
+ nick => $tweet->{retweeted_status}{user}{screen_name}, data => '',
+ tweet => decode_entities( get_full_text($tweet->{retweeted_status}) ),
+ );
+ } elsif ( $tweet->{truncated} and ( $object->isa('Net::Twitter') or $object->isa('Twitter::API') ) ) {
+ $text .= " -- http://twitter.com/$tweet->{user}{screen_name}"
+ . "/status/$tweet->{id}";
+ }
+
+ $text =~ s/[\n\r]/ /g;
+
+ return $text;
+}
+
+sub get_full_text {
+ my $t = shift;
+ return defined($t->{full_text}) ? $t->{full_text} : $t->{text};
+}
+
+sub window {
+ my $type = shift || "default";
+ my $uname = shift || "default";
+ my $sname = lc(shift);
+ my $topic = lc(shift || '');
+
+ $type = "search" if $type eq 'search_once';
+ $type = "error" if $type eq 'deerror';
+
+ my $win;
+ my @all_priorities = qw/ account sender list /;
+ my @win_priorities = split ',', $settings{window_priority};
+ my $done_rest = 0;
+ while (@win_priorities and not defined $win) {
+ my $win_priority = shift @win_priorities;
+ if ($win_priority eq 'account') {
+ for my $type_iter ($type, 'default') {
+ next unless exists $state{__windows}{$type_iter};
+ $win =
+ $state{__windows}{$type_iter}{$uname}
+ || $state{__windows}{$type_iter}{$topic}
+ || $state{__windows}{$type_iter}{$user}
+ || $state{__windows}{$type_iter}{default};
+ last if defined $win or $type_iter eq 'default';
+ }
+ } elsif ($win_priority eq 'sender') {
+ if (defined $sname
+ and defined $state{__windows}{$win_priority}{$sname}) {
+ $win = $state{__windows}{$win_priority}{$sname};
+ }
+ } elsif ($win_priority eq 'list') {
+ if (defined $sname
+ and defined $state{__windows}{$win_priority}{$sname}) {
+ $win = $state{__windows}{$win_priority}{$sname};
+ }
+ }
+ if (not defined $win and not @win_priorities and not $done_rest) {
+ $done_rest = 1;
+ for my $check_priority (@all_priorities) {
+ if (not grep { $check_priority eq $_ } split ',', $settings{window_priority}) {
+ push @win_priorities, $check_priority;
+ }
+ }
+ }
+ }
+ $win = $settings{window} if not defined $win;
+ if (not &ensure_window($win, '_tw_in_Win')) {
+ $win = $settings{window};
+ }
+
+ # &debug("window($type, $uname, $sname, $topic) -> $win");
+ return $win;
+}
+
+sub ensure_window {
+ my $win = shift;
+ my $using_win = shift;
+ return $win if Irssi::window_find_name($win);
+ &notice([ 'crap', $using_win ], "Creating window '$win'.");
+ my $newwin = Irssi::Windowitem::window_create( $win, 1 );
+ if (not $newwin) {
+ &error([ $using_win ], "Failed to create window $win!");
+ return;
+ }
+ $newwin->set_name($win);
+ return $win;
+}
+
+sub window_to_account {
+ my $name = shift;
+
+ foreach my $type ( keys %{ $state{__windows} } ) {
+ foreach my $uname ( keys %{ $state{__windows}{$type} } ) {
+ if ( lc $state{__windows}{$type}{$uname} eq lc $name ) {
+ return $uname;
+ }
+ }
+ }
+
+ if ( lc $name eq $settings{window} ) {
+ return $user;
+ }
+
+ return;
+}
+
+sub read_json {
+ my $file = shift;
+ my $store = shift;
+ my $desc = shift;
+ if ( $file and -r $file ) {
+ if ( open( my $fh, '<', $file ) ) {
+ my $json;
+ do { local $/; $json = <$fh>; };
+ close $fh;
+ eval {
+ my $ref = decode_json($json);
+ %$store = %$ref;
+ };
+ } else {
+ &error( "Failed to load $desc from $file: $!" );
+ }
+ }
+}
+
+Irssi::signal_add( "send text", "event_send_text" );
+Irssi::signal_add( "setup changed", "event_setup_changed" );
+
+Irssi::theme_register( # theme
+ [
+ 'twirssi_tweet', '[$0%B@$1%n$2] $3',
+ 'twirssi_search', '[$0%r$1%n%B@$2%n$3] $4',
+ 'twirssi_search_once', '[$0%r$1%n%B@$2%n$3] $4',
+ 'twirssi_reply', '[$0\--> %B@$1%n$2] $3',
+ 'twirssi_dm', '[$0%r@$1%n (%WDM%n)] $2',
+ 'twirssi_error', '%RERROR%n: $0',
+ 'twirssi_deerror', '%RUPDATE%n: $0',
+ 'twirssi_info', '%CINFO:%N $0',
+ 'twirssi_new_day', '%CDay changed to $0%N',
+ ]
+);
+
+$last_poll{__poll} = time - &get_poll_time;
+
+&event_setup_changed(1);
+if ( Irssi::window_find_name(window()) ) {
+ Irssi::command_bind( "dm", "cmd_direct" );
+ Irssi::command_bind( "dm_as", "cmd_direct_as" );
+ Irssi::command_bind( "tweet", "cmd_tweet" );
+ Irssi::command_bind( "tweet_as", "cmd_tweet_as" );
+ Irssi::command_bind( "retweet", "cmd_retweet" );
+ Irssi::command_bind( "retweet_as", "cmd_retweet_as" );
+ Irssi::command_bind( "retweet_to", "cmd_retweet_to_window" );
+ Irssi::command_bind( "twitter_broadcast", "cmd_broadcast" );
+ Irssi::command_bind( "twitter_info", "cmd_info" );
+ Irssi::command_bind( "twitter_user", "cmd_user" );
+ Irssi::command_bind( "twitter_reply", "cmd_reply" );
+ Irssi::command_bind( "twitter_reply_as", "cmd_reply_as" );
+ Irssi::command_bind( "twitter_login", "cmd_login" );
+ Irssi::command_bind( "twitter_logout", "cmd_logout" );
+ Irssi::command_bind( "twitter_search", "cmd_search" );
+ Irssi::command_bind( "twitter_listinfo", "cmd_listinfo" );
+ Irssi::command_bind( "twitter_dms", "cmd_dms" );
+ Irssi::command_bind( "twitter_dms_as", "cmd_dms_as" );
+ Irssi::command_bind( "twitter_switch", "cmd_switch" );
+ Irssi::command_bind( "twitter_subscribe", "cmd_add_search" );
+ Irssi::command_bind( "twitter_unsubscribe", "cmd_del_search" );
+ Irssi::command_bind( "twitter_list_subscriptions", "cmd_list_search" );
+ Irssi::command_bind( "twirssi_upgrade", "cmd_upgrade" );
+ Irssi::command_bind( "twirssi_reload", "cmd_reload" );
+ Irssi::command_bind( "twirssi_oauth", "cmd_oauth" );
+ Irssi::command_bind( "twitter_updates", "get_updates" );
+ Irssi::command_bind( "twitter_add_follow_extra", "cmd_add_follow" );
+ Irssi::command_bind( "twitter_del_follow_extra", "cmd_del_follow" );
+ Irssi::command_bind( "twitter_list_follow_extra", "cmd_list_follow" );
+ Irssi::command_bind( "twirssi_set_channel", "cmd_set_channel" );
+ Irssi::command_bind( "twirssi_list_channels", "cmd_list_channels" );
+ Irssi::command_bind( "twirssi_set_window", "cmd_set_window" );
+ Irssi::command_bind( "twirssi_list_windows", "cmd_list_windows" );
+ Irssi::command_bind( "twirssi_wipe", "cmd_wipe" );
+ Irssi::command_bind( "bitlbee_away", "update_away" );
+ if ( $settings{use_reply_aliases} ) {
+ Irssi::command_bind( "reply", "cmd_reply" );
+ Irssi::command_bind( "reply_as", "cmd_reply_as" );
+ }
+ Irssi::command_bind(
+ "twirssi_dump",
+ sub {
+ &debug( "twits: ", join ", ",
+ map { "u: $_\@" . ref($twits{$_}) } keys %twits );
+ &debug( "selected: $user\@$defservice" );
+ &debug( "friends: ", Dumper \%friends );
+ &debug( "blocks: ", Dumper \%blocks );
+ &debug( "nicks: ", join ", ", sort keys %nicks );
+ &debug( "searches: ", join('; ', map { $state{__last_id}{$_}{__search} and "$_ : " . join(', ', keys %{ $state{__last_id}{$_}{__search} }) } keys %{ $state{__last_id} } ));
+ &debug( "windows: ", Dumper \%{ $state{__windows} } );
+ &debug( "channels: ", Dumper \%{ $state{__channels} } );
+ &debug( "u_info ", Dumper \%{ $state{__u} } );
+ &debug( "id_info ", Dumper \%{ $state{__i} } );
+ &debug( "lists: ", Dumper \%{ $state{__lists} } );
+ &debug( "settings: ", Dumper \%settings );
+ &debug( "last poll: ", Dumper \%last_poll );
+ if ( open my $fh, '>', "/tmp/$IRSSI{name}.cache.txt" ) {
+ print $fh Dumper \%tweet_cache;
+ close $fh;
+ &notice([ 'crap' ], "cache written out to /tmp/$IRSSI{name}.cache.txt");
+ }
+ if ( open my $fh, '>', "$settings{dump_store}" ) {
+ print $fh Dumper \%state;
+ close $fh;
+ &notice([ 'crap' ], "state written out to $settings{dump_store}");
+ }
+ }
+ );
+ Irssi::command_bind(
+ "twirssi_version",
+ sub {
+ &notice(
+ "$IRSSI{name} v$VERSION; "
+ . (
+ $Twitter::API::VERSION
+ ? "Twitter::API v$Twitter::API::VERSION. "
+ : ""
+ )
+ . (
+ $Net::Twitter::VERSION
+ ? "Net::Twitter v$Net::Twitter::VERSION. "
+ : ""
+ )
+ . (
+ $Net::Identica::VERSION
+ ? "Net::Identica v$Net::Identica::VERSION. "
+ : ""
+ )
+ . "JSON in use: "
+ . ref(JSON::MaybeXS->new())
+ . ". See details at http://twirssi.com/"
+ );
+ }
+ );
+ Irssi::command_bind(
+ "twitter_delete",
+ &gen_cmd(
+ "/twitter_delete <username:id>",
+ "destroy_status",
+ sub { &notice( ["tweet"], "Tweet deleted." ); },
+ sub {
+ my ( $nick, $num ) = split /:/, lc $_[0], 2;
+ return $state{__last_id}{ &normalize_username($nick) }{__sent} unless defined $num;
+ return $state{__ids}{$nick}[$num];
+ }
+ )
+ );
+ Irssi::command_bind(
+ "twitter_fav",
+ &gen_cmd(
+ "/twitter_fav <username:id>",
+ "create_favorite",
+ sub { &notice( ["tweet"], "Tweet favorited." ); },
+ sub {
+ my ( $nick, $num ) = split ':', lc $_[0], 2;
+ return $state{__last_id}{ &normalize_username($nick) }{__sent} unless defined $num;
+ return $state{__ids}{$nick}[$num];
+ }
+ )
+ );
+ Irssi::command_bind(
+ "twitter_unfav",
+ &gen_cmd(
+ "/twitter_unfav <username:id>",
+ "destroy_favorite",
+ sub { &notice( ["tweet"], "Tweet un-favorited." ); },
+ sub {
+ my ( $nick, $num ) = split ':', lc $_[0], 2;
+ return $state{__last_id}{ &normalize_username($nick) }{__sent} unless defined $num;
+ return $state{__ids}{$nick}[$num];
+ }
+ )
+ );
+ Irssi::command_bind(
+ "twitter_follow",
+ &gen_cmd(
+ "/twitter_follow [-w] <username>",
+ "create_friend",
+ sub {
+ &notice( ["tweet", "$user\@$defservice"],
+ "Following $_[0]" );
+ $nicks{ $_[0] } = time;
+ &cmd_user(@_);
+ },
+ sub {
+ &cmd_set_window("sender $_[0] $_[0]", $_[1], $_[2])
+ if $_[0] =~ s/^\s*-w\s+// and $_[0] ne '';
+ return $_[0];
+ }
+ )
+ );
+ Irssi::command_bind(
+ "twitter_unfollow",
+ &gen_cmd(
+ "/twitter_unfollow <username>",
+ "destroy_friend",
+ sub {
+ &notice( ["tweet"], "Stopped following $_[0]" );
+ delete $nicks{ $_[0] };
+ }
+ )
+ );
+ Irssi::command_bind(
+ "twitter_device_updates",
+ &gen_cmd(
+ "/twitter_device_updates none|im|sms",
+ "update_delivery_device",
+ sub { &notice( ["tweet"], "Device updated to $_[0]" ); }
+ )
+ );
+ Irssi::command_bind(
+ "twitter_block",
+ &gen_cmd(
+ "/twitter_block <username>",
+ "create_block",
+ sub { &notice( ["tweet"], "Blocked $_[0]" ); }
+ )
+ );
+ Irssi::command_bind(
+ "twitter_unblock",
+ &gen_cmd(
+ "/twitter_unblock <username>",
+ "destroy_block",
+ sub { &notice( ["tweet"], "Unblock $_[0]" ); }
+ )
+ );
+ Irssi::command_bind(
+ "twitter_spam",
+ &gen_cmd(
+ "/twitter_spam <username>",
+ "report_spam",
+ sub { &notice( ["tweet"], "Reported $_[0] for spam" ); }
+ )
+ );
+
+ %completion_types = (
+ 'account' => [
+ 'twitter_switch',
+ ],
+ 'tweet' => [
+ 'retweet',
+ 'retweet_to',
+ 'twitter_delete',
+ 'twitter_fav',
+ 'twitter_info',
+ 'twitter_reply',
+ 'twitter_unfav',
+ ],
+ 'nick' => [
+ 'dm',
+ 'twitter_block',
+ 'twitter_add_follow_extra',
+ 'twitter_del_follow_extra',
+ 'twitter_follow',
+ 'twitter_spam',
+ 'twitter_unblock',
+ 'twitter_unfollow',
+ 'twitter_user',
+ 'twitter_dms', # here for twitter_dms_as
+ ],
+ 're_nick' => [
+ 'dm',
+ 'retweet',
+ 'tweet',
+ ],
+ );
+ push @{ $completion_types{'tweet'} }, 'reply' if $settings{use_reply_aliases};
+
+ Irssi::signal_add_last( 'complete word' => \&sig_complete );
+
+ &notice(
+ " %Y<%C(%B^%C)%N TWIRSSI v%R$VERSION%N",
+ " %C(_(\\%N http://twirssi.com/ for full docs",
+ " %Y||%C `%N Log in with /twitter_login, send updates with /tweet"
+ );
+
+ my $file = $settings{replies_store};
+ if ( $file and -r $file ) {
+ if ( open( my $fh, '<', $file ) ) {
+ my $json;
+ do { local $/; $json = <$fh>; };
+ close $fh;
+ eval {
+ my $ref = decode_json($json);
+ %state = %$ref;
+ # fix legacy vulnerable ids
+ for (grep !/^__\w+$/, keys %state) { $state{__ids}{$_} = $state{$_}; delete $state{$_}; }
+ # # remove legacy broken searches (without service name)
+ # map { /\@/ or delete $state{__searches}{$_} } keys %{$state{__searches}};
+ # convert legacy/broken window tags (without @service, or unnormalized)
+ for my $type (keys %{$state{__windows}}) {
+ next if $type eq 'search' or $type eq 'sender';
+ for my $tag (keys %{$state{__windows}{$type}}) {
+ next if $tag eq 'default';
+ my $new_tag = &normalize_username($tag);
+ next if -1 == index($new_tag, '@') or $new_tag eq $tag;
+ $state{__windows}{$type}{$new_tag} = $state{__windows}{$type}{$tag};
+ delete $state{__windows}{$type}{$tag};
+ }
+ }
+ my $num = keys %{ $state{__indexes} };
+ &notice( sprintf "Loaded old replies from %d contact%s.",
+ $num, ( $num == 1 ? "" : "s" ) );
+ &cmd_list_search;
+ &cmd_list_follow;
+ };
+ } else {
+ &error( "Failed to load old replies from $file: $!" );
+ }
+ }
+
+ &read_json($settings{poll_store}, \%last_poll, "prev. poll times");
+ &read_json($settings{id_store}, \%tweet_cache, "cached IDs");
+
+ if ( my $provider = $settings{url_provider} ) {
+ &notice("Loading WWW::Shorten::$provider...");
+ eval "use WWW::Shorten::$provider;";
+
+ if ($@) {
+ &error( "Failed to load WWW::Shorten::$provider - either clear",
+ "short_url_provider or install the CPAN module");
+ }
+ }
+
+ if ( @{ $settings{usernames} } ) {
+ &cmd_login();
+ &ensure_updates(15) if keys %twits;
+ }
+
+} else {
+ Irssi::active_win()
+ ->print( "Create a window named "
+ . $settings{window}
+ . " or change the value of twitter_window. Then, reload $IRSSI{name}." );
+}
+
+# vim: set sts=4 expandtab:
diff --git a/scripts/twprompt.pl b/scripts/twprompt.pl
new file mode 100644
index 0000000..30e6e35
--- /dev/null
+++ b/scripts/twprompt.pl
@@ -0,0 +1,100 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi;
+use Irssi::Irc;
+use Irssi::TextUI;
+
+my $instrut =
+ ".--------------------------------------------------.\n".
+ "| 1.) shell> mkdir ~/.irssi/scripts |\n".
+ "| 2.) shell> cp twprompt.pl ~/.irssi/scripts/ |\n".
+ "| 3.) shell> cp twprompt.pl ~/.irssi/scripts/ |\n".
+ "| 4.) shell> mkdir ~/.irssi/scripts/autorun |\n".
+ "| 5.) shell> ln -s ~/.irssi/scripts/twprompt.pl \\ |\n".
+ "| ~/.irssi/scripts/autorun/twprompt.pl |\n".
+ "| 6.) /sbar prompt remove prompt |\n".
+ "| 7.) /sbar prompt remove prompt_empty |\n".
+ "| 8.) /sbar prompt add -before input -priority 100 |\n".
+ "| -alignment left twprompt |\n".
+ "| 9.) /toggle twprompt_instruct and last /save |\n".
+ "|--------------------------------------------------|\n".
+ "| Options: Default: |\n".
+ "| /set twprompt_refresh <speed> 100 |\n".
+ "| /set twprompt_color_a <string> %%C |\n".
+ "| /set twprompt_color_b <string> %%c |\n".
+ "| /toggle twprompt_instruct |Startup instructions |\n".
+ "\`--------------------------------------------------'";
+
+
+$VERSION = '1.00';
+%IRSSI = (
+ authors => 'John Engelbrecht',
+ contact => 'jengelbr@yahoo.com',
+ name => 'twprompt.pl',
+ description => 'BitchX\'s CrackRock3 animated prompt bar.',
+ sbitems => 'twprompt',
+ license => 'Public Domain',
+ changed => 'Wed Sep 29 02:58:28 CDT 2004',
+ url => 'http://irssi.darktalker.net'."\n",
+);
+
+my $twprompt_file = "$ENV{HOME}/.irssi/twprompt.data";
+my $num = 1;
+my $jk=0;
+my $timeout;
+
+sub reload { Irssi::statusbar_items_redraw('twprompt'); }
+
+sub setup {
+ my $time = Irssi::settings_get_int('twprompt_refresh');
+ Irssi::timeout_remove($timeout);
+ $timeout = Irssi::timeout_add($time, 'reload' , undef);
+}
+
+sub show {
+ my ($item, $get_size_only) = @_;
+ my $text = get();
+ $item->default_handler($get_size_only, "{prompt ".$text."}", undef, 1);
+}
+
+sub get {
+ my $str = Irssi::active_win()->{active}->{name};
+ $str = "Status" if($str eq "");
+ my @chars = split //, $str;
+ my $total = $#chars;
+ my $text = "";
+ my $col_a = Irssi::settings_get_str('twprompt_color_a');
+ my $col_b = Irssi::settings_get_str('twprompt_color_b');
+ for my $cx (0..$total) {
+ if($cx == ($num - 1)) {
+ $text.=$col_a.$chars[$cx];
+ } else {
+ $text.=$col_b.$chars[$cx];
+ }
+ }
+ if(!$jk) {
+ $jk=1;
+ return $text;
+ }
+ if($num <= ($total + 1)) {
+ $num++;
+ }
+ else {
+ $num = 1;
+ }
+ $jk=0;
+ return $text;
+}
+
+Irssi::statusbar_item_register('twprompt', '$0', 'show');
+Irssi::settings_add_str('tech_addon', 'twprompt_color_b',"%c");
+Irssi::settings_add_str('tech_addon', 'twprompt_color_a',"%C");
+Irssi::settings_remove('twprompt_instruct');
+Irssi::settings_add_bool('tech_addon', 'twprompt_instruct', 1);
+Irssi::settings_add_int('tech_addon', 'twprompt_refresh', 100);
+Irssi::signal_add('setup changed', 'setup');
+$timeout = Irssi::timeout_add(Irssi::settings_get_int('twprompt_refresh'), 'reload' , undef);
+
+if(Irssi::settings_get_bool('twprompt_instruct')) {
+ print $instrut;
+ }
diff --git a/scripts/twsocials.pl b/scripts/twsocials.pl
new file mode 100644
index 0000000..0ed6aa2
--- /dev/null
+++ b/scripts/twsocials.pl
@@ -0,0 +1,1154 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi;
+use Irssi::Irc;
+use DBI;
+
+$VERSION = '1.02';
+%IRSSI = (
+ authors => 'John Engelbrecht',
+ contact => 'jengelbr@yahoo.com',
+ name => 'twsocials.pl',
+ description => 'IRC version of Social Commands',
+ license => 'Public Domain',
+ changed => 'Sat Nov 20 18:25:12 CST 2004',
+ url => 'http://irssi.darktalker.net/',
+);
+
+my $instrut =
+ ".------------------------------------------------------.\n".
+ "| 1.) shell> mkdir ~/.irssi/scripts |\n".
+ "| 2.) shell> cp twsocials.pl ~/.irssi/scripts/ |\n".
+ "| 3.) shell> mkdir ~/.irssi/scripts/autorun |\n".
+ "| 4.) shell> ln -s ~/.irssi/scripts/twsocials.pl \\ |\n".
+ "| ~/.irssi/scripts/autorun/twsocials.pl |\n".
+ "| 5.) /help (Will list all your socials) |\n".
+ "| /socials (Shows you a list of arguments) |\n".
+ "| /socials list (Shows a list of socials) |\n".
+ "| /socials <social>(Contents of the Social command)|\n".
+ "| 6.) /toggle twsocials_instruct and last /save |\n".
+ "|------------------------------------------------------|\n".
+ "| Options: Default: |\n".
+ "| /toggle twsocials_remote OFF |\n".
+ "| /toggle twtopic_instruct |Startup instructions |\n".
+ "|------------------------------------------------------|\n".
+ "| Note: |\n".
+ "| If twsocials_remote is ON, that will enable public |\n".
+ "| and private social commands to work, such as the |\n".
+ "| the following. |\n".
+ "| |\n".
+ "| < TechWizard> !social |\n".
+ "| < TechWizard> !social list |\n".
+ "| < TechWizard> !social blist |\n".
+ "| < TechWizard> !hug |\n".
+ "| < TechWizard> !hug JohnDoe |\n".
+ "| < TechWizard> !hug JohnDoe 1 |\n".
+ "\`------------------------------------------------------'";
+
+
+my $maxsize=62;
+my $lastcmd="";
+my $home_chan="";
+my $path = "~/.irssi/socials";
+my @colname = ("Dark Black","Dark Red","Dark Green","Dark Yellow","Dark Blue","Dark Magenta","Dark Cyan","Dark White","Bold Black","Bold Red","Bold Green","Bold Yellow","Bold Blue","Bold Magenta","Bold Cyan","Bold White","Reset","O");
+my @mirc_color_name = ("~R0","~R1","~R2","~R3","~R4","~R5","~R6","~R7","~B0","~B1","~B2","~B3","~B4","~B5","~B6","~B7","~RS");
+my @mirc_color_arr = ("\0031","\0035","\0033","\0037","\0032","\0036","\00310","\0030","\00314","\0034","\0039","\0038","\00312","\00313","\00311","\00315","\017");
+my ($r0,$r1,$r2,$r3,$r4,$r5,$r6,$r7,$b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$rs) = @mirc_color_arr;
+ $path =~ s/^~\//$ENV{'HOME'}\//;
+my $bc=$r4;
+my $bt=$r2;
+my $m1=$r1;
+my $m2=$b1;
+
+################ Checking Social's home Directory #############
+init_socpath();
+###############################################################
+
+sub message_public {
+ my($server, $data, $nick, $address, $target) = @_;
+ if(!Irssi::settings_get_bool('twsocials_remote')) { return; }
+ $home_chan=$target;
+ $data =~ s/\r//;
+ my $socname;
+ my @data_arr = split " ", $data;
+ if(@data_arr[0] eq "!social") {
+ if(!$#data_arr) {
+ syntax($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "color") {
+ colorlist($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "list") {
+ soclist($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "blist") {
+ socblist($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "add") {
+ if($#data_arr == 1) {
+ $server->command("msg $target $r3(USAGE) $rs!social$b4 add$rs <social>$r3 :$rs$r2 Adds a new Social.");
+ return;
+ }
+ $socname = @data_arr[2];
+ addsoc($server,$target,$socname);
+ return;
+ }
+ if(@data_arr[1] eq "del") {
+ if($#data_arr == 1) {
+ $server->command("msg $target $r3(USAGE) $rs!social$b4 dels$rs <social> $r3:$r2 Deletes a Social.");
+ return;
+ }
+ $socname = @data_arr[2];
+ delsoc($server,$target,$socname);
+ return;
+ }
+ if(@data_arr[1] eq "set") {
+ if($#data_arr <= 3) {
+ set_syntax($server, $target, $socname);
+ return;
+ }
+ $socname = @data_arr[2];
+ my $set = @data_arr[3];
+ my $cutstr = "@data_arr[0] @data_arr[1] @data_arr[2] @data_arr[3] ";
+ $data =~ s/$cutstr//;
+ setsoc($server,$target,$socname,$set,$data);
+ return;
+ }
+ $socname = @data_arr[1];
+ print_social($server, $target, $socname);
+ return;
+ }
+ if(@data_arr[0] eq "!soclist") {
+ soclist($server,$target);
+ return;
+ }
+ my $chr="!";
+ $socname = @data_arr[0];
+ my @socname_arr = split //, $socname;
+ if(@socname_arr[0] ne $chr) { return; }
+ $socname =~ s/$chr//;
+ my ($nick2,$msgsw);
+ if(!ifexist_social($socname)) { return; }
+ if($#data_arr == 0) {
+ $nick2 = "UNSET";
+ $msgsw=0;
+ }
+ if($#data_arr == 1) {
+ $nick2 = @data_arr[1];
+ $msgsw=0;
+ }
+ if($#data_arr == 2) {
+ $nick2 = @data_arr[1];
+ $msgsw=1;
+ }
+ my $chan = Irssi::Irc::Server->channel_find($home_chan);
+ my $nick_obj = $chan->nick_find($nick2);
+ if($nick_obj->{nick} eq "" && $nick2 ne "UNSET") {
+ $server->command("msg $target nickname does not exist.");
+ return;
+ }
+ do_social($server,$target,$socname,$nick,$nick2,$msgsw);
+}
+
+sub message_private {
+ my($server, $data, $nick, $address) = @_;
+ if(!Irssi::settings_get_bool('twsocials_remote')) { return; }
+ my $target=$nick;
+ $home_chan=$target;
+ $data =~ s/\r//;
+ my $socname;
+ my @data_arr = split " ", $data;
+ if(@data_arr[0] eq "!social") {
+ if(!$#data_arr) {
+ syntax($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "color") {
+ colorlist($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "list") {
+ soclist($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "blist") {
+ socblist($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "add") {
+ if($#data_arr == 1) {
+ $server->command("msg $target $r3(USAGE) $rs!social$b4 add$rs <social>$r3 :$rs$r2 Adds a new Social.");
+ return;
+ }
+ $socname = @data_arr[2];
+ addsoc($server,$target,$socname);
+ return;
+ }
+ if(@data_arr[1] eq "del") {
+ if($#data_arr == 1) {
+ $server->command("msg $target $r3(USAGE) $rs!social$b4 dels$rs <social> $r3:$r2 Deletes a Social.");
+ return;
+ }
+ $socname = @data_arr[2];
+ delsoc($server,$target,$socname);
+ return;
+ }
+ if(@data_arr[1] eq "set") {
+ if($#data_arr <= 3) {
+ set_syntax($server, $target, $socname);
+ return;
+ }
+ $socname = @data_arr[2];
+ my $set = @data_arr[3];
+ my $cutstr = "@data_arr[0] @data_arr[1] @data_arr[2] @data_arr[3] ";
+ $data =~ s/$cutstr//;
+ setsoc($server,$target,$socname,$set,$data);
+ return;
+ }
+ $socname = @data_arr[1];
+ print_social($server, $target, $socname);
+ return;
+ }
+ if(@data_arr[0] eq "!soclist") {
+ soclist($server,$target);
+ return;
+ }
+ my $chr="!";
+ $socname = @data_arr[0];
+ my @socname_arr = split //, $socname;
+ if(@socname_arr[0] ne $chr) { return; }
+ $socname =~ s/$chr//;
+ my ($nick2,$msgsw);
+ if(!ifexist_social($socname)) { return; }
+ if($#data_arr == 0) {
+ $nick2 = "UNSET";
+ $msgsw=0;
+ }
+ if($#data_arr == 1) {
+ $nick2 = @data_arr[1];
+ $msgsw=0;
+ }
+ if($#data_arr == 2) {
+ $nick2 = @data_arr[1];
+ $msgsw=1;
+ }
+ my $nick1 = $nick;
+ do_social($server,$target,$socname,$nick1,$nick2,$msgsw);
+}
+
+sub on_public {
+ my($server, $data, $nick, $address, $target) = @_;
+ if(!Irssi::settings_get_bool('twsocials_remote')) { return; }
+ if($data !~ /^!/) { return; }
+ $home_chan=$nick;
+ $target=Irssi::active_win()->{active}->{name};
+ $home_chan=$target;
+ $data =~ s/\r//;
+ my $socname;
+ my @data_arr = split " ", $data;
+ if(@data_arr[0] eq "!social") {
+ if(!$#data_arr) {
+ syntax($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "color") {
+ colorlist($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "list") {
+ soclist($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "blist") {
+ socblist($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "add") {
+ if($#data_arr == 1) {
+ $server->command("msg $target $r3(USAGE) $rs!social$b4 add$rs <social>$r3 :$rs$r2 Adds a new Social.");
+ return;
+ }
+ $socname = @data_arr[2];
+ addsoc($server,$target,$socname);
+ return;
+ }
+ if(@data_arr[1] eq "del") {
+ if($#data_arr == 1) {
+ $server->command("msg $target $r3(USAGE) $rs!social$b4 dels$rs <social> $r3:$r2 Deletes a Social.");
+ return;
+ }
+ $socname = @data_arr[2];
+ delsoc($server,$target,$socname);
+ return;
+ }
+ if(@data_arr[1] eq "set") {
+ if($#data_arr <= 3) {
+ set_syntax($server, $target, $socname);
+ return;
+ }
+ $socname = @data_arr[2];
+ my $set = @data_arr[3];
+ my $cutstr = "@data_arr[0] @data_arr[1] @data_arr[2] @data_arr[3] ";
+ $data =~ s/$cutstr//;
+ setsoc($server,$target,$socname,$set,$data);
+ return;
+ }
+ $socname = @data_arr[1];
+ print_social($server, $target, $socname);
+ return;
+ }
+ if(@data_arr[0] eq "!soclist") {
+ soclist($server,$target);
+ return;
+ }
+ my $chr="!";
+ $socname = @data_arr[0];
+ my @socname_arr = split //, $socname;
+ if(@socname_arr[0] ne $chr) { return; }
+ $socname =~ s/$chr//;
+ my ($nick2,$msgsw);
+ if(!ifexist_social($socname)) {
+ return;
+ }
+ if($#data_arr == 0) {
+ $nick2 = "UNSET";
+ $msgsw=0;
+ }
+ if($#data_arr == 1) {
+ $nick2 = @data_arr[1];
+ $msgsw=0;
+ }
+ if($#data_arr == 2) {
+ $nick2 = @data_arr[1];
+ $msgsw=1;
+ }
+ my $nick1 = $server->{nick};
+ my $chan = Irssi::Irc::Server->channel_find($home_chan);
+ my $nick_obj = $chan->nick_find($nick2);
+ if($nick_obj->{nick} eq "" && $nick2 ne "UNSET") {
+ $server->command("msg $target nickname does not exist.");
+ return;
+ }
+ do_social($server,$target,$socname,$nick1,$nick2,$msgsw);
+}
+
+sub on_private {
+ my($server, $data, $nick, $address, $target) = @_;
+ if(!Irssi::settings_get_bool('twsocials_remote')) { return; }
+ if($data !~ /^!/) { return; }
+ $home_chan=$nick;
+ $target=$nick;
+ $data =~ s/\r//;
+ my $socname;
+ my @data_arr = split " ", $data;
+ if(@data_arr[0] eq "!social") {
+ if(!$#data_arr) {
+ syntax($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "color") {
+ colorlist($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "list") {
+ soclist($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "blist") {
+ socblist($server,$target);
+ return;
+ }
+ if(@data_arr[1] eq "add") {
+ if($#data_arr == 1) {
+ $server->command("msg $target $r3(USAGE) $rs!social$b4 add$rs <social>$r3 :$rs$r2 Adds a new Social.");
+ return;
+ }
+ $socname = @data_arr[2];
+ addsoc($server,$target,$socname);
+ return;
+ }
+ if(@data_arr[1] eq "del") {
+ if($#data_arr == 1) {
+ $server->command("msg $target $r3(USAGE) $rs!social$b4 dels$rs <social> $r3:$r2 Deletes a Social.");
+ return;
+ }
+ $socname = @data_arr[2];
+ delsoc($server,$target,$socname);
+ return;
+ }
+ if(@data_arr[1] eq "set") {
+ if($#data_arr <= 3) {
+ set_syntax($server, $target, $socname);
+ return;
+ }
+ $socname = @data_arr[2];
+ my $set = @data_arr[3];
+ my $cutstr = "@data_arr[0] @data_arr[1] @data_arr[2] @data_arr[3] ";
+ $data =~ s/$cutstr//;
+ setsoc($server,$target,$socname,$set,$data);
+ return;
+ }
+ $socname = @data_arr[1];
+ print_social($server, $target, $socname);
+ return;
+ }
+ if(@data_arr[0] eq "!soclist") {
+ soclist($server,$target);
+ return;
+ }
+ my $chr="!";
+ $socname = @data_arr[0];
+ my @socname_arr = split //, $socname;
+ if(@socname_arr[0] ne $chr) { return; }
+ $socname =~ s/$chr//;
+ my ($msgsw,$nick2);
+ if(!ifexist_social($socname)) {
+ return;
+ }
+ if($#data_arr == 0) {
+ $nick2 = "UNSET";
+ $msgsw=0;
+ }
+ if($#data_arr == 1) {
+ $nick2 = @data_arr[1];
+ $msgsw=0;
+ }
+ if($#data_arr == 2) {
+ $nick2 = @data_arr[1];
+ $msgsw=1;
+ }
+ my $nick1 = $server->{nick};
+ $target = $nick;
+ do_social($server,$target,$socname,$nick1,$nick2,$msgsw);
+}
+
+sub addsoc {
+ my ($server,$target,$socname) = @_;
+ if(ifexist_social($socname)) {
+ $server->command("msg $target r3social: $rs$socname already exist.");
+ return;
+ }
+ #write_social($socname,$fpriv,$fself,$fnobody,$fpublic,$fyou,$fthem)
+ write_social($socname,"0","UNSET","UNSET","UNSET","UNSET","UNSET");
+ irssicmd_socials($socname);
+ $server->command("msg $target $r2 done.");
+ return;
+}
+
+sub irssi_addsoc {
+ my ($data, $server, $witem) = @_;
+ my @data_arr = split / /, $data;
+ if(@data_arr[0] eq "") {
+ irssi_syntax();
+ return;
+ }
+ my $socname = @data_arr[0];
+ if(ifexist_social($socname)) {
+ print "$rs$socname already exist.";
+ return;
+ }
+ write_social($socname,"0","UNSET","UNSET","UNSET","UNSET","UNSET");
+ irssicmd_socials($socname);
+ print "$r2 done.";
+ return;
+}
+
+sub delsoc {
+ my ($server,$target,$socname) = @_;
+ if(!ifexist_social($socname)) {
+ $server->command("msg $target $r3 DELETE $socname: $rs$socname social does not exist.");
+ return;
+ }
+ my $filename ="$path/$socname.txt";
+ unlink($filename);
+ irssicmd_socials($socname);
+ $server->command("msg $target $r2 done.");
+ return;
+}
+
+sub irssi_delsoc {
+ my ($data, $server, $witem) = @_;
+ my @data_arr = split / /, $data;
+ if(@data_arr[0] eq "") {
+ irssi_syntax();
+ return;
+ }
+ my $socname = @data_arr[0];
+ if(!ifexist_social($socname)) {
+ print "$r3 DELETE $socname: $rs$socname social does not exist.";
+ return;
+ }
+ my $filename ="$path/$socname.txt";
+ unlink($filename);
+ irssicmd_socials($socname);
+ print "$r2 done.";
+ return;
+}
+
+sub setsoc {
+ my ($server,$target,$socname,$set,$data) = @_;
+ my @sets = ("priv","nobody","public","self","them","you");
+ if(!ifexist_social($socname)) {
+ $server->command("msg $target $r3 SET social: $rs$socname does not exist.");
+ return;
+ }
+ $set = "\L$set";
+ my $found=0;
+ foreach(@sets) { if($set eq $_) { $found=1; } }
+ if(!$found) {
+ $server->command("msg $target $r3 social:$rs invalid field name.");
+ return;
+ }
+ my $filename = "$path/$socname.txt";
+ my $cx=0;
+ my ($fpriv, $fnobody, $fpublic, $fself, $fthem, $fyou);
+ open(FILE,"<", $filename) or do {
+ print "File $filename not found.";
+ return;
+ };
+ while (<FILE>) {
+ chomp;
+ $fpriv = $_ if($cx == 0);
+ $fnobody = $_ if($cx == 1);
+ $fpublic = $_ if($cx == 2);
+ $fself = $_ if($cx == 3);
+ $fthem = $_ if($cx == 4);
+ $fyou = $_ if($cx == 5);
+ $cx++;
+ }
+ close FILE;
+ $fpriv = $data if($set eq "priv");
+ $fnobody = $data if($set eq "nobody");
+ $fpublic = $data if($set eq "public");
+ $fself = $data if($set eq "self");
+ $fthem = $data if($set eq "them");
+ $fyou = $data if($set eq "you");
+ write_social($socname,$fpriv,$fself,$fnobody,$fpublic,$fyou,$fthem);
+ $server->command("msg $target $r2 done.");
+ irssicmd_socials($socname);
+ return;
+}
+
+sub irssi_setsoc {
+ my ($data, $server, $witem) = @_;
+ my @data_arr = split / /, $data;
+ if($#data_arr <=1) {
+ irssi_set_syntax();
+ return;
+ }
+ my $cutstr = "/";
+ my $socname = @data_arr[0];
+ my $set = @data_arr[1];
+ $cutstr = "$socname $set ";
+ $data =~ s/$cutstr//g;
+ my @sets = ("priv","nobody","public","self","them","you");
+ if(!ifexist_social($socname)) {
+ print "$r3 SET social: $rs$socname does not exist.";
+ return;
+ }
+ $set = "\L$set";
+ my $found=0;
+ foreach(@sets) { if($set eq $_) { $found=1; } }
+ if(!$found) {
+ print "$r3 social:$rs invalid field name.";
+ return;
+ }
+ my $filename = "$path/$socname.txt";
+ my $cx=0;
+ my ($fpriv, $fnobody, $fpublic, $fself, $fthem, $fyou);
+ open(FILE,"<", $filename) or do {
+ print "File $filename not found.";
+ return;
+ };
+ while (<FILE>) {
+ chomp;
+ $fpriv = $_ if($cx == 0);
+ $fnobody = $_ if($cx == 1);
+ $fpublic = $_ if($cx == 2);
+ $fself = $_ if($cx == 3);
+ $fthem = $_ if($cx == 4);
+ $fyou = $_ if($cx == 5);
+ $cx++;
+ }
+ close FILE;
+ $fpriv = $data if($set eq "priv");
+ $fnobody = $data if($set eq "nobody");
+ $fpublic = $data if($set eq "public");
+ $fself = $data if($set eq "self");
+ $fthem = $data if($set eq "them");
+ $fyou = $data if($set eq "you");
+ write_social($socname,$fpriv,$fself,$fnobody,$fpublic,$fyou,$fthem);
+ print "$r2 done.";
+ irssicmd_socials($socname);
+ return;
+}
+
+sub syntax {
+ my ($server,$target) = @_;
+ $server->command("msg $target $r3(USAGE) $rs!social $r3 :$r2 Prints this screen.");
+ $server->command("msg $target !social <social> $r3 :$r2 Displays the social msgs");
+ $server->command("msg $target !social$b4 add $rs<social>$r3 :$r2 Adds a new Social.");
+ $server->command("msg $target !social$b4 del $rs<social>$r3 :$r2 Dels a Social.");
+ $server->command("msg $target !social$b4 set $rs<social>$r3 :$r2 Sets The social msg per line.");
+ $server->command("msg $target !social$b4 list $r3 :$r2 A list of socials.");
+ $server->command("msg $target !social$b4 blist $r3 :$r2 A list of socials in a box.");
+ $server->command("msg $target !social$b4 color $r3 :$r2 A list of color codes.");
+ $server->command("msg $target !soclist $r3 :$r2 Prints a list of socials.");
+ $server->command("msg $target !<social> $r3 :$r2 does the Social.");
+}
+
+sub irssi_syntax {
+ my ($server,$target) = @_;
+ print "$r3(USAGE) $rs!social $r3 :$r2 Prints this screen.";
+ print " !social <social> $r3 :$r2 Displays the social msgs";
+ print " !social$b4 add $rs<social>$r3 :$r2 Adds a new Social.";
+ print " !social$b4 del $rs<social>$r3 :$r2 Dels a Social.";
+ print " !social$b4 set $rs<social>$r3 :$r2 Sets The social msg per line.";
+ print " !social$b4 list $r3 :$r2 A list of socials.";
+ print " !social$b4 blist $r3 :$r2 A list of socials in a box.";
+ print " !social$b4 color $r3 :$r2 A list of color codes.";
+ print " !soclist $r3 :$r2 Prints a list of socials.";
+ print " !<social> $r3 :$r2 does the Social.";
+}
+
+sub colorlist {
+ my ($server,$target) = @_;
+ my $title = "$bc($bt Color List $bc)";
+ my $spc = ' 'x50;
+ my $text = "";
+ my $tmp = "";
+ my $cx=0;
+ my $bar = "------------------------------------------------------------------";
+ $bar = ".".substr($bar,0,int(($maxsize-13)/2)).$title.substr($bar,0,int(($maxsize-13)/2)).".";
+ $server->command("msg $target $bc$bar$rs");
+
+ my ($text,$blah);
+ foreach (@colname) {
+ my $col = substr("@mirc_color_name[$cx] = @colname[$cx]$spc",0,20);
+ $tmp = $text.$col;
+ if(strsize($tmp) >= $maxsize) {
+ $text.=' 'x50;
+ $blah =~ s/\003//;
+ $blah = @mirc_color_arr[$cx];
+ $text = substr(" $text",0,$maxsize);
+ $text = "$bc|$rs$text$bc|$rs";
+ $server->command("msg $target $text");
+ $text="";
+ }
+ $text=$text.$col;
+ $cx++;
+ }
+ $bar = "-------------------------------------------------------------------------------------------";
+ $bar = "`".substr($bar,0,$maxsize)."\'";
+ $server->command("msg $target $bc$bar$rs");
+ return;
+}
+
+sub irssi_colorlist {
+ my ($server,$target) = @_;
+ my $spc = ' 'x50;
+ my $title = "$bc($bt Color List $bc)";
+ my $bar = "------------------------------------------------------------------";
+ $bar = ".".substr($bar,0,int(($maxsize-13)/2)).$title.substr($bar,0,int(($maxsize-13)/2)).".";
+ print "$bc$bar$rs";
+ my $cx=0;
+ my ($text,$blah);
+ foreach (@colname) {
+ my $col = substr("@mirc_color_name[$cx] = @colname[$cx]$spc",0,20);
+ my $tmp = $text.$col;
+ if(strsize($tmp) >= $maxsize) {
+ $text.=' 'x50;
+ $blah =~ s/\003//;
+ $blah = @mirc_color_arr[$cx];
+ $text = substr(" $text",0,$maxsize);
+ $text = "$bc|$rs$text$bc|$rs";
+ print $text;
+ $text="";
+ }
+ $text=$text.$col;
+ $cx++;
+ }
+ $bar = "-------------------------------------------------------------------------------------------";
+ $bar = "`".substr($bar,0,$maxsize)."\'";
+ print "$bc$bar$rs";
+ return;
+}
+
+sub set_syntax {
+ my ($server,$target) = @_;
+ $server->command("msg $target $r3(USAGE) $rs!social$b4 set$rs <social>$b4 nobody $rs<msg>: Sets the message when no nickname is set.");
+ $server->command("msg $target !social$b4 set $rs<social>$b4 public $rs<msg> : Sets the message for the channel");
+ $server->command("msg $target !social$b4 set $rs<social>$b4 self $rs<msg> : Sets the message when you social yourself.");
+ $server->command("msg $target !social$b4 set $rs<social>$b4 you $rs<msg> : Sets message that will be messaged to you.");
+ $server->command("msg $target !social$b4 set $rs<social>$b4 them $rs<msg> : Sets The social message that will be sent to them.");
+ return;
+}
+
+sub irssi_set_syntax {
+ my ($server,$target) = @_;
+ print "$r3(USAGE)";
+ print "!social$b4 set$rs <social>$b4 nobody $rs<msg>: Sets the message when no nickname is set.";
+ print "!social$b4 set $rs<social>$b4 public $rs<msg>: Sets the message for the channel";
+ print "!social$b4 set $rs<social>$b4 self $rs<msg>: Sets the message when you social yourself.";
+ print "!social$b4 set $rs<social>$b4 you $rs<msg>: Sets message that will be messaged to you.";
+ print "!social$b4 set $rs<social>$b4 them $rs<msg>: Sets The social message that will be sent to them.";
+ return;
+}
+
+sub soclist{
+ my ($server,$target) = @_;
+ my $text="";
+ my $cutstr=".txt";
+ my @array;
+ opendir(DIR,$path) or return 0;
+ while (defined(my $file = readdir(DIR))) {
+ if($file =~ m".txt") {
+ my $tmp=$file;
+ $tmp =~ s/$cutstr//;
+ push(@array,$tmp);
+ }
+ }
+ closedir(DIR);
+ @array = sort(@array);
+ foreach(@array) { $text.=" $_"; }
+ $server->command("msg $target $text");
+ return;
+}
+
+sub socblist {
+ my ($server,$target) = @_;
+ my @array;
+ my $text="";
+ opendir(DIR,$path) or return 0;
+ my $title = "$bc($bt Social List $bc)";
+ my $bar = "------------------------------------------------------------------";
+ $bar = ".".substr($bar,0,int(($maxsize-15)/2)).$title.substr($bar,0,int(($maxsize-15)/2)+1).".";
+ $server->command("msg $target $bc$bar$rs");
+ my $spc = " ";
+ my $cutstr=".txt";
+ opendir(DIR,$path) or return 0;
+ while (defined(my $file = readdir(DIR))) {
+ if($file =~ m".txt") {
+ my $tmp=$file;
+ $tmp =~ s/$cutstr//;
+ push(@array,$tmp);
+ }
+ }
+ closedir(DIR);
+ @array = sort(@array);
+ foreach(@array) {
+ my $name;
+ my $socname=$_;
+ $socname =~ s/$cutstr//;
+ if(!get_social_str($socname,"priv")) {
+ $name = substr(" $socname$spc",0,10);
+ }
+ else {
+ $name = substr("*$socname$spc",0,10);
+ }
+ my $tmp = $text.$name;
+ if(strsize($tmp) >= $maxsize) {
+ $text.=" ";
+ $text = substr(" $text",0,($maxsize));
+ $text = "$bc|$rs$text$bc|$rs";
+ $server->command("msg $target $text");
+ $text="";
+ }
+ $text=$text.$name;
+ }
+ $text.=" ";
+ $text = substr(" $text",0,($maxsize));
+ $text = "$bc|$rs$text$bc|$rs";
+ $server->command("msg $target $text");
+ $bar = "-------------------------------------------------------------------------------------------";
+ $bar = "`".substr($bar,0,$maxsize)."\'";
+ $server->command("msg $target $bc$bar$rs");
+ return;
+}
+
+sub irssi_socblist {
+ my ($data, $server, $witem) = @_;
+ my @array;
+ my $text="";
+ opendir(DIR,$path) or return 0;
+ my $title = "$bc($bt Social List $bc)";
+ my $bar = "------------------------------------------------------------------";
+ $bar = ".".substr($bar,0,int(($maxsize-15)/2)).$title.substr($bar,0,int(($maxsize-15)/2)+1).".";
+ print "$bc$bar$rs";
+ my $spc = " ";
+ my $cutstr=".txt";
+ opendir(DIR,$path) or return 0;
+ while (defined(my $file = readdir(DIR))) {
+ if($file =~ m".txt") {
+ my $tmp=$file;
+ $tmp =~ s/$cutstr//;
+ push(@array,$tmp);
+ }
+ }
+ closedir(DIR);
+ @array = sort(@array);
+ foreach(@array) {
+ my $name;
+ my $socname=$_;
+ $socname =~ s/$cutstr//;
+ if(!get_social_str($socname,"priv")) {
+ $name = substr(" $socname$spc",0,10);
+ }
+ else {
+ $name = substr("*$socname$spc",0,10);
+ }
+ my $tmp = $text.$name;
+ if(strsize($tmp) >= $maxsize) {
+ $text.=" ";
+ $text = substr(" $text",0,($maxsize));
+ $text = "$bc|$rs$text$bc|$rs";
+ print "$text";
+ $text="";
+ }
+ $text=$text.$name;
+ }
+ $text.=" ";
+ $text = substr(" $text",0,($maxsize));
+ $text = "$bc|$rs$text$bc|$rs";
+ print "$text";
+ $bar = "-------------------------------------------------------------------------------------------";
+ $bar = "`".substr($bar,0,$maxsize)."\'";
+ print "$bc$bar$rs";
+ return;
+}
+
+sub do_social {
+ my ($server,$target,$socname,$name1,$name2,$msgsw) = @_;
+ my $text;
+ if($name1 eq $name2) {
+ $text = get_social_str($socname,"self");
+ $text= social_parse($name1,$name2,$text);
+ $server->command("msg $target $text");
+ return;
+ }
+ if($name2 eq "UNSET") {
+ $text = get_social_str($socname,"nobody");
+ $text= social_parse($name1,$name2,$text);
+ $server->command("msg $target $text");
+ return;
+ }
+ if(get_social_str("priv")) {
+ $text = get_social_str($socname,"public");
+ $text= social_parse($name1,$name2,$text);
+ $server->command("msg $target $text");
+ if($msgsw) {
+ $text = get_social_str($socname,"you");
+ $text= social_parse($name1,$name2,$text);
+ $server->command("msg $name1 $text");
+ $text = get_social_str($socname,"them");
+ $text= social_parse($name1,$name2,$text);
+ $server->command("msg $name2 $text");
+ }
+ }
+ else {
+ $text = get_social_str($socname,"you");
+ $text= social_parse($name1,$name2,$text);
+ $server->command("msg $name1 $text");
+ $text = get_social_str($socname,"them");
+ $text= social_parse($name1,$name2,$text);
+ $server->command("msg $name2 $text");
+ }
+ return;
+}
+
+sub print_social {
+ my ($server,$target,$socname) = @_;
+ my $text="";
+ my $filename = "$path/$socname.txt";
+ my $cx=0;
+ my ($fpriv, $fnobody, $fpublic, $fself, $fthem, $fyou);
+ open(FILE,"<", $filename) or do {
+ $server->command("msg $target $socname does not exist.");
+ return;
+ };
+ while (<FILE>) {
+ chomp;
+ $fpriv = $_ if($cx == 0);
+ $fnobody = $_ if($cx == 1);
+ $fpublic = $_ if($cx == 2);
+ $fself = $_ if($cx == 3);
+ $fthem = $_ if($cx == 4);
+ $fyou = $_ if($cx == 5);
+ $cx++;
+ }
+ close FILE;
+ $server->command("msg $target $r3 Name:$r2 $socname");
+ $server->command("msg $target $r3 Private:$r2 $fpriv");
+ $server->command("msg $target $r3 Nobody:$r2 ".colsocial($fnobody));
+ $server->command("msg $target $r3 Public:$r2 ".colsocial($fpublic));
+ $server->command("msg $target $r3 Self:$r2 ".colsocial($fself));
+ $server->command("msg $target $r3 Them:$r2 ".colsocial($fthem));
+ $server->command("msg $target $r3 You:$r2 ".colsocial($fyou));
+ return;
+}
+
+sub irssi_print_social {
+ my ($data, $server, $item) = @_;
+ my @data_arr = split / /, $data;
+ my $cutstr = "/";
+ if (@data_arr[0] =~ m/^[(set)|(blist)|(add)|(list)|(del)|(color)]/i && !ifexist_social(@data_arr[0])) {
+ Irssi::command_runsub ('social', $data, $server, $item);
+ return;
+ }
+ my $socname = @data_arr[0];
+ my $text="";
+ my $filename = "$path/$socname.txt";
+ my $cx=0;
+ my ($fpriv, $fnobody, $fpublic, $fself, $fthem, $fyou);
+ open(FILE,"<", $filename) or do {
+ print "$socname does not exist.";
+ return;
+ };
+ while (<FILE>) {
+ chomp;
+ $fpriv = $_ if($cx == 0);
+ $fnobody = $_ if($cx == 1);
+ $fpublic = $_ if($cx == 2);
+ $fself = $_ if($cx == 3);
+ $fthem = $_ if($cx == 4);
+ $fyou = $_ if($cx == 5);
+ $cx++;
+ }
+ close FILE;
+ print"$r3 Name:$r2 $socname";
+ print"$r3 Private:$r2 $fpriv";
+ print"$r3 Nobody:$r2 ".colsocial($fnobody);
+ print"$r3 Public:$r2 ".colsocial($fpublic);
+ print"$r3 Self:$r2 ".colsocial($fself);
+ print"$r3 Them:$r2 ".colsocial($fthem);
+ print"$r3 You:$r2 ".colsocial($fyou);
+ return;
+}
+
+sub colsocial {
+ my ($str) = @_;
+ my $name1 = "$r2 name1$rs";
+ my $name2 = "$r2 name2$rs";
+ return $str;
+}
+
+sub color_parse {
+ my ($str) = @_;
+ my $cx=0;
+ foreach(@mirc_color_name) {
+ my $old = @mirc_color_name[$cx];
+ my $new = @mirc_color_arr[$cx];
+ $str =~ s/$old/$new/g;
+ $cx++;
+ }
+ return $str;
+}
+
+sub social_parse {
+ my ($name1,$name2,$str) = @_;
+ $name1 = "$r2$name1$rs";
+ $name2 = "$r2$name2$rs";
+ $str =~ s/name1/$name1/g;
+ $str =~ s/name2/$name2/g;
+ return $str;
+}
+
+sub get_social_str {
+ my ($social,$colum) = @_;
+ my $filename = "$path/$social.txt";
+ my $cx=0;
+ my ($fpriv, $fnobody, $fpublic, $fself, $fthem, $fyou);
+ open(FILE,"<", $filename);
+ while (<FILE>) {
+ chomp;
+ $fpriv = color_parse($_) if($cx == 0);
+ $fnobody = color_parse($_) if($cx == 1);
+ $fpublic = color_parse($_) if($cx == 2);
+ $fself = color_parse($_) if($cx == 3);
+ $fthem = color_parse($_) if($cx == 4);
+ $fyou = color_parse($_) if($cx == 5);
+ $cx++;
+ }
+ close FILE;
+ return $fpriv if($colum eq "priv");
+ return $fself if($colum eq "self");
+ return $fnobody if($colum eq "nobody");
+ return $fpublic if($colum eq "public");
+ return $fyou if($colum eq "you");
+ return $fthem if($colum eq "them");
+ return "UNSET";
+}
+
+sub ifexist_social {
+ my ($socname) = @_;
+ my $cutstr= ".txt";
+ my $filename = "$path/$socname.txt";
+ opendir(DIR,$path) or return 0;
+ while (defined(my $file = readdir(DIR))) {
+ if($file =~ m".txt") {
+ my $tmp=$file;
+ $tmp =~ s/$cutstr//;
+ return 1 if($socname eq $tmp);
+ }
+ }
+ return 0;
+}
+
+sub strsize {
+ my ($word) = @_;
+ my @word_arr = split //, $word;
+ return $#word_arr+1;
+}
+
+sub write_social {
+ my ($socname,$fpriv,$fself,$fnobody,$fpublic,$fyou,$fthem) = @_;
+ my $filename = "$path/$socname.txt";
+ open(FILE,">", $filename);
+ print FILE "$fpriv\n";
+ print FILE "$fnobody\n";
+ print FILE "$fpublic\n";
+ print FILE "$fself\n";
+ print FILE "$fthem\n";
+ print FILE "$fyou\n";
+ close FILE;
+ return;
+}
+
+sub irssicmd_reset {
+ for my $cmd (Irssi::commands()) {
+ if($cmd->{category} eq "Social Commands") {
+ my $tmp=$cmd->{cmd};
+ Irssi::command_unbind($tmp,'on_cmd');
+ }
+ }
+}
+
+sub irssicmd_socials {
+ my ($socname) = @_;
+ irssicmd_reset();
+ my $cutstr= ".txt";
+ my $filename = "$path/$socname.txt";
+ opendir(DIR,$path) or return 0;
+ while (defined(my $file = readdir(DIR))) {
+ if($file =~ m".txt") {
+ my $tmp=$file;
+ $tmp =~ s/$cutstr//;
+ Irssi::command_bind($tmp,'on_cmd','Social Commands');
+ }
+ }
+}
+
+sub on_cmd {
+ my ($data, $server, $witem) = @_;
+ my @data_arr = split / /, $lastcmd;
+ my $cutstr = "/";
+ my $socname = @data_arr[0];
+ $socname =~ s/$cutstr//;
+ my $target=Irssi::active_win()->{active}->{name};
+ $home_chan=$target;
+ my $nick = "TechWizard";
+ my ($msgsw, $nick2);
+ if($#data_arr == 0) {
+ $nick2 = "UNSET";
+ $msgsw=0;
+ }
+ if($#data_arr == 1) {
+ $nick2 = @data_arr[1];
+ $msgsw=0;
+ }
+ if($#data_arr == 2) {
+ $nick2 = @data_arr[1];
+ $msgsw=1;
+ }
+ if($home_chan =~ /^#/) {
+ my $chan = Irssi::Irc::Server->channel_find($home_chan);
+ my $nick_obj = $chan->nick_find($nick2);
+ if($nick_obj->{nick} eq "" && $nick2 ne "UNSET") {
+ $server->command("msg $target nickname does not exist.");
+ return;
+ }
+ }
+ do_social($server,$target,$socname,$nick,$nick2,$msgsw);
+}
+
+sub cmd_sig {
+ my($args) = @_;
+ irssicmd_socials();
+ $lastcmd=$args;
+}
+
+sub check_dir {
+ my $sw=1;
+ opendir(DIR,$path) or $sw=0;
+ closedir(DIR);
+ return $sw;
+}
+
+sub init_socpath {
+ if(check_dir()) { return; }
+ my @socnam_arr = ("beer","bslap","chains","cut","drp","fart","french","halo",
+ "hug","hump","kiss","smacks","smooch","spank","stab","staple",
+ "strip","trout","whips","yawn"
+ );
+ my @socline_arr = (
+ "0\nWho wants Beer!?!?!?\nname1 throws name2 a fresh cold beer out of the fridge.\nname1 opens up a nice cold beer, and drinks it.\nname1 tosses you a nice cold beer, better catch it!!\nyou just tossed name2 a nice cold beer.\n",
+ "0\nLook OUT!!!! name1 is ready to Bitch slap someone!!!!\nname1 Bitch slaps name2 Violently, OUWWW that gotta hurt!\nname1 Bitch Slaps themself hard, Are they Crazy or what???\nyou gotten Bitch Slapped by name1, can you call 911?.\nyou violently bitch slap name2.\n",
+ "0\nname1 looks around swinging the chains around, who shall be my victim?\nname1 chains name2 up, Ohh... Boy, name2 is gonna get it...\nname1 chain themself up, and swallowed the keys.\nname1 chained you up, aren't you wondering what they will do next?\nyou just chained up name2, whats next? torchure?\n",
+ "0\nname1 wants to cut something......\nname1 cut name2 arms and legs off with blood on your face\nname1 cut something on them off\nyou cut everything off of their body\nyou cut name2 arms and legs off and blood flies everywhere\n",
+ "0\nname1 goes out and buys a box of ~R1Dr.Pepper~RS.\nname1 tosses a ~R1Dr.Pepper~RS can to name2, If you waste it, You're Dead.\nname1 grabs a ~R1Dr.Pepper~RS, pops it open and gulps it down... aaahhhh.....\nname1 tosses you a can of ~R1Dr.Pepper~RS.\nyou gave name2 a can of ~R1Dr.Pepper~RS.\n",
+ "0\nname1 farts, Roam roam!!!! Can ya hear it?\nname1 farts towards name2!! QUICK Wear a Gas Mask!!!!\nname1 farts up a storm and kills themself.\nname1 farts towards you, EWWWWW!!! can ya smell it????\nyou farted towards name2! you B*stard!\n",
+ "0\nname1 need to be french\nname1 french name2 until name2 cant breathe\nname1 want to be french\nname1 french them until name1 cant breathe\nyou french name2 with all you got\n",
+ "0\nname1 looks around seeing whoes innocent.\nname1 does their best best to look innocent.\nname1 looks and the mirror and finds a gold circle.\nblah\n",
+ "0\nname1 needs a hug.\nname1 hugs name2 tightly.\nname1 hugs themself tightly.\nname1 hugs you tightly.\nyou hugs name2 tightly.\n",
+ "0\nname1 wants to be hump........\nname1 hump name2 until name1 drop\nname1 hump themself\nname1 hump them hard and passionately\nyou hump name2 with all you got\n",
+ "0\nname1 needs a kiss.\nname1 kisses name2 passionately.\nname1 kisses themself passionately.\nname1 kisses them passionately.\nyou kisses name2 passionately.\n",
+ "0\nname1 smacks his monkey slowly.\nname1 smacks name2 for being an idiot, What were they thinking???\nname1 smacks and smacks until his face burns red.\nname1 smacks you for being an idiot.\nyou smacked name2, that damn idiot, what were they thinking???\n",
+ "0\nname1 smooches everyone in the channel.\nname1 smooches name2. AWW aint that cute.. NOT!!!\nname1 tries to smooch themself, but can't. Anyone got a mirror????\nname1 smooches you very passionately.\nyou have smooched name2 on the lips.\n",
+ "0\nname1 looks for a paddle to spank someone's ass with.\nname1 spanks name2 ass for being naughty.....\nname1 is trying to spank their own ass, does somebody have a paddle?\nyou felt something on your ass, you turned around a look, did name1 spank you?\nhow did feel spanking name2's ass.\n",
+ "0\nLook OUT!!!! name1 is ready to Stab someone with a knife!!!!\nname1 Stabs name2 Violently, I hope they got life insurance\nname1 tries to Stab themself with a knife, 911, SUICIDE!!!\nname1 slaps ya with their dirty trout, are you going to let them get away with that???\nyou slapped name2 with your trout, I hope ya cleaned it first.\n",
+ "0\nname1 grabs a staple gun and reloads the gun.\nname1 staples name2 to the wall, now they can't run, MUahahaha....\nname1 tries to staple themself to the wall, OUWWWW!!\nyou got stapled to the wall by name1.\nyou have stapled name2 to the wall.\n",
+ "0\nname1 is waiting for someone to strip down, any volunteers?\nname1 strips name2 down one clothes after another.\nname1 watches themself in a mirror while stripping down.\nname1 is removing ya clothes.\nyou are removing name2's clothes, you better hope that camera is ready.\n",
+ "0\nname1 is juggling the trout while looking for their victim.\nname1 slaps name2 with their dirty trout, *SPLAT*!!!\nname1 slaps himself with a dead trout, EWWWWWWW\nname1 slaps you with a dead trout, EWWWWWWW!!!\nyou slapped name2 with a dead trout, EWWWWWWW!!!\n",
+ "0\nname1 is looking for a whip to torture someone.......RUN............\nname1 whips name2 until name1 sees blood.....\nname1 whips themself without mercy\nname1 whips them violently\nyou whips name2 with everything you have\n",
+ "0\nname1 yawns and stretches.\nname1 yawns at name2, mann.. You're boring.\nname1 yawns and stretches and then falls over, WHOOPS!!\nname1 yawns at you, they are very bored.\nyou yawned at name2, how rude....\n",
+ );
+ my $cx=0;
+ print "Mkdir $path.";
+ mkdir($path);
+ print "Inserting socials into $path.";
+ foreach my $socname (@socnam_arr) {
+ my $filename = "$path/$socname.txt";
+ open(FILE,">", $filename);
+ print FILE @socline_arr[$cx];
+ close FILE;
+ $cx++;
+ }
+}
+
+Irssi::command_bind('social','irssi_print_social','tech_addon');
+Irssi::command_bind('social set','irssi_setsoc','tech_addon');
+Irssi::command_bind('social color','irssi_colorlist','tech_addon');
+Irssi::command_bind('social reset','irssicmd_reset','tech_addon');
+Irssi::command_bind('social add','irssi_addsoc','tech_addon');
+Irssi::command_bind('social del','irssi_delsoc','tech_addon');
+Irssi::command_bind('social list','irssi_socblist','tech_addon');
+Irssi::command_bind('soclist','irssi_socblist','tech_addon');
+Irssi::command_bind('soccolor','irssi_socblist','tech_addon');
+
+Irssi::signal_add_first('send command', 'cmd_sig');
+Irssi::signal_add_last('message public', 'message_public');
+Irssi::signal_add_last('message private', 'message_private');
+Irssi::signal_add_last("message own_public", "on_public");
+Irssi::signal_add_last("message own_private", "on_private");
+Irssi::settings_add_bool('tech_addon', 'twsocials_instruct', 1);
+Irssi::settings_add_bool('tech_addon', 'twsocials_remote', 0);
+irssicmd_socials();
+
+if(Irssi::settings_get_bool('twsocials_instruct')) {
+ print $instrut;
+ }
+
diff --git a/scripts/twtopic.pl b/scripts/twtopic.pl
new file mode 100644
index 0000000..9981e0a
--- /dev/null
+++ b/scripts/twtopic.pl
@@ -0,0 +1,120 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+use Irssi;
+use Irssi::Irc;
+use Irssi::TextUI;
+
+$VERSION = '1.02';
+%IRSSI = (
+ authors => 'John Engelbrecht',
+ contact => 'jengelbr@yahoo.com',
+ name => 'twtopic.pl',
+ description => 'Animated Topic bar.',
+ sbitems => 'twtopic',
+ license => 'Public Domain',
+ changed => '2018-09-08',
+ url => 'http://irssi.darktalker.net'."\n",
+);
+
+my $instrut =
+ ".--------------------------------------------------.\n".
+ "| 1.) shell> mkdir ~/.irssi/scripts |\n".
+ "| 2.) shell> cp twtopic.pl ~/.irssi/scripts/ |\n".
+ "| 3.) shell> mkdir ~/.irssi/scripts/autorun |\n".
+ "| 4.) shell> ln -s ~/.irssi/scripts/twtopic.pl \\ |\n".
+ "| ~/.irssi/scripts/autorun/twtopic.pl |\n".
+ "| 5.) /sbar topic remove topic |\n".
+ "| 6.) /sbar topic remove topic_empty |\n".
+ "| 7.) /sbar topic add -after topicbarstart |\n".
+ "| -priority 100 -alignment left twtopic |\n".
+ "| 9.) /toggle twtopic_instruct and last /save |\n".
+ "|--------------------------------------------------|\n".
+ "| Options: Default: |\n".
+ "| /set twtopic_refresh <speed> 150 |\n".
+ "| /set twtopic_size <size> 20 |\n".
+ "| /toggle twtopic_instruct |Startup instructions |\n".
+ "\`--------------------------------------------------'";
+
+my $timeout=0;
+my $start_pos=0;
+my $flipflop=0;
+my @mirc_color_arr = ("\0031","\0035","\0033","\0037","\0032","\0036","\00310","\0030","\00314","\0034","\0039","\0038","\00312","\00313","\00311","\00315","\017");
+
+
+sub setup {
+ my $time = Irssi::settings_get_int('twtopic_refresh');
+ Irssi::timeout_remove($timeout) if ($timeout != 0);
+
+ if ($time < 10 ) {
+ print "Warning: 'twtopic_refresh' must be >= 10";
+ $time=150;
+ Irssi::settings_set_int('twtopic_refresh',$time);
+ }
+ $timeout = Irssi::timeout_add($time, 'reload' , undef);
+}
+
+sub show {
+ my ($item, $get_size_only) = @_;
+ my $text = get();
+ $text="[".$text."]";
+ $item->default_handler($get_size_only,$text, undef, 1);
+}
+
+sub get_topic {
+ my $topic = "";
+ my $name = Irssi::active_win()->{active}->{name};
+ my $type = Irssi::active_win()->{active}->{type};
+ $name = "Status" if($name eq "");
+ if($name eq "Status") { return "Irssi website: http://www.irssi.org, Irssi IRC channel: #irssi @ irc://irc.freenode:6667, twtopic has been written by Tech Wizard"; }
+ if($type eq "QUERY") {
+ my $text = "You are now talking too...... ".$name;
+ return $text;
+ }
+ my $channel = Irssi::Irc::Server->channel_find($name);
+ $topic = $channel->{topic};
+ foreach (@mirc_color_arr) { $topic =~ s/$_//g; }
+ return $topic;
+}
+
+sub get {
+ my $str=get_topic();
+ $str =~ s/(\00313)+//;
+ $str =~ s/(\002)+//;
+ $str =~ s/(\001)+//;
+ my $extra_str= " ";
+ my $size = Irssi::settings_get_int('twtopic_size');
+ if($str eq "") {
+ my $str = "=-=-=-=-= No Topic=-=-=-=-=-=-=-";
+ }
+ my @str_arr = split //, $str;
+ my $total = $#str_arr;
+ $str=substr($extra_str,0,$size).$str.$extra_str;
+ my $text = substr($str,$start_pos,$size);
+ if($start_pos > $total+$size) {
+ $start_pos=0;
+ }
+ if(!$flipflop) {
+ $flipflop=1;
+ return $text;
+ }
+ $start_pos++;
+ $flipflop=0;
+ return $text;
+}
+
+sub reload {
+ Irssi::statusbar_items_redraw('twtopic');
+}
+
+Irssi::statusbar_item_register('twtopic', '$0', 'show');
+Irssi::signal_add('setup changed', 'setup');
+Irssi::settings_add_int('tech_addon', 'twtopic_refresh', 150);
+Irssi::settings_add_bool('tech_addon', 'twtopic_instruct', 1);
+Irssi::settings_add_int('tech_addon', 'twtopic_size',20);
+
+setup();
+
+if(Irssi::settings_get_bool('twtopic_instruct')) {
+ print $instrut;
+}
+
diff --git a/scripts/u.pl b/scripts/u.pl
new file mode 100644
index 0000000..a552da7
--- /dev/null
+++ b/scripts/u.pl
@@ -0,0 +1,69 @@
+use vars qw($VERSION %IRSSI);
+
+use Irssi 20020120;
+$VERSION = "1.2";
+%IRSSI = (
+ authors => "Michiel",
+ contact => "michiel\@dotgeek.org",
+ name => "List nicks in channel",
+ description => "BitchX /u clone. Use /u <regex> to show all nicks (including ident\@host) matching regex in the current channel.",
+ license => "GNU GPL",
+ url => "http://otoria.freecode.nl/~michiel/u.pl",
+ changed => "Thu Jun 3 11:04:27 CEST 2004",
+);
+
+
+sub cmd_u
+{
+ my ($data, $server, $channel) = @_;
+ my @nicks;
+ my $space;
+ my $msg;
+ my $match;
+ my $nick;
+
+ if ($channel->{type} ne "CHANNEL")
+ {
+ Irssi::print("You are not on a channel");
+ return;
+ }
+
+ @nicks = $channel->nicks();
+
+ $space = ' 'x50;
+
+ foreach $nick (@nicks)
+ {
+
+ # user status?
+ $msg = ($nick->{serverop} ? '[*' : '[ ');
+ $msg .= ($nick->{other} ? chr($nick->{other}) : ($nick->{op} ? '@' : ($nick->{halfop} ? '%' : ($nick->{voice} ? '+' : ' '))));
+
+ # if nick is too long, cut it off
+ if (length($nick->{nick}) > 10)
+ {
+ $msg .= substr($nick->{nick}, 0, 10)."] ";
+ }
+ else # if it is too short, add some spaces
+ {
+ $msg .= $nick->{nick}.substr($space, 0, 10-length($nick->{nick}))."] ";
+ }
+
+ # if host is too long, cut it off
+ if (length($nick->{host}) > 50)
+ {
+ $msg .= '['.substr($nick->{host}, 0, 50).']';
+ }
+ else # if it is too short, add some spaces
+ {
+ $msg .= '['.$nick->{host}.substr($space, 0, 50-length($nick->{host})).']';
+ }
+
+ $match = $nick->{nick}.'!'.$nick->{host}; # For regexp matching
+
+ $channel->print($msg) if $match =~ /$data/i;
+
+ }
+}
+
+Irssi::command_bind('u','cmd_u');
diff --git a/scripts/upgradeinfo.pl b/scripts/upgradeinfo.pl
new file mode 100644
index 0000000..6f69fae
--- /dev/null
+++ b/scripts/upgradeinfo.pl
@@ -0,0 +1,87 @@
+#
+# Copyright (C) 2002-2021 by Peder Stray <peder.stray@gmail.com>
+#
+
+use strict;
+use Irssi 20021204.1123;
+use Irssi::TextUI;
+
+use vars qw{$VERSION %IRSSI};
+($VERSION) = '$Revision: 1.7.1 $' =~ / (\d+(\.\d+)+) /;
+%IRSSI = (
+ name => 'upgradeinfo',
+ authors => 'Peder Stray',
+ contact => 'peder.stray@gmail.com',
+ url => 'https://github.com/pstray/irssi-upgradeinfo',
+ license => 'GPL',
+ description => 'Statusbar item notifying you about updated binary',
+ sbitems => 'upgradeinfo',
+ );
+
+my($load_time) = 0; # modification time of binary at load
+my($file_time) = 0; # modification time of binary file
+my($timer) = 0; # ID of current timer
+
+sub cmd_upgradeinfo {
+ my($param,$serv,$chan) = @_;
+
+ print CLIENTCRAP sprintf ">> load: %s", scalar localtime $load_time;
+ print CLIENTCRAP sprintf ">> file: %s", scalar localtime $file_time;
+}
+
+sub sig_setup_changed {
+ my($interval) = Irssi::settings_get_int('upgrade_check_interval');
+
+ Irssi::timeout_remove($timer);
+
+ if ($interval < 1) {
+ $interval = 0;
+ }
+
+ return unless $interval;
+
+ $interval *= 1000;
+ $timer = Irssi::timeout_add($interval, 'ui_check' , undef);
+}
+
+sub sb_upgradeinfo {
+ my($item, $get_size_only) = @_;
+ my $format = "";
+ my($time);
+ my($timefmt) = Irssi::settings_get_str('upgrade_time_format');
+
+ $time = $file_time - $load_time;
+
+ if ($time) {
+ $time = sprintf($timefmt,
+ $time/60/60/24,
+ $time/60/60%24,
+ $time/60%60,
+ $time%60
+ );
+ $time =~ s/^(0+\D+)+//;
+ $format = "{sb %r$time%n}";
+ }
+
+ $item->default_handler($get_size_only, $format, undef, 1);
+}
+
+sub ui_check {
+ $file_time = (stat Irssi::get_irssi_binary)[9];
+
+ Irssi::statusbar_items_redraw('upgradeinfo');
+}
+
+Irssi::command_bind('upgradeinfo', 'cmd_upgradeinfo');
+
+Irssi::settings_add_int('upgrade', 'upgrade_check_interval', 300);
+Irssi::settings_add_str('upgrade', 'upgrade_time_format', '%d+%02d:%02d');
+
+Irssi::signal_add('setup changed', 'sig_setup_changed');
+
+Irssi::statusbar_item_register('upgradeinfo', undef, 'sb_upgradeinfo');
+
+$load_time = (stat Irssi::get_irssi_binary)[9];
+$file_time = $load_time;
+
+sig_setup_changed;
diff --git a/scripts/uptime.pl b/scripts/uptime.pl
new file mode 100644
index 0000000..f77a154
--- /dev/null
+++ b/scripts/uptime.pl
@@ -0,0 +1,138 @@
+#
+# Copyright (C) 2002-2021 by Peder Stray <peder.stray@gmail.com>
+#
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use Irssi::TextUI;
+
+use vars qw{$VERSION %IRSSI};
+($VERSION) = '$Revision: 1.6.1 $' =~ / (\d+(\.\d+)+) /;
+%IRSSI = (
+ name => 'uptime',
+ authors => 'Peder Stray',
+ contact => 'peder.stray@gmail.com',
+ url => 'https://github.com/pstray/irssi-uptime',
+ license => 'GPL',
+ description => 'Try a little harder to figure out client uptime',
+ sbitem => 'uptime',
+ );
+
+my($timer) = 0; # ID of current timer
+
+sub uptime_linux {
+ my($sys_uptime);
+ my($irssi_start);
+ local(*FILE);
+
+ open FILE, "<", "/proc/uptime";
+ $sys_uptime = (split " ", <FILE>)[0];
+ close FILE;
+
+ open FILE, "<", "/proc/$$/stat";
+ $irssi_start = (split " ", <FILE>)[21];
+ close FILE;
+
+ return $sys_uptime - $irssi_start/100;
+}
+
+sub uptime_solaris {
+ my($irssi_start);
+
+ $irssi_start = time - (stat("/proc/$$"))[9];
+
+ return $irssi_start;
+}
+
+sub uptime {
+ my($sysname) = @_;
+ my($time);
+
+ if ($sysname eq 'Linux') {
+ $time = uptime_linux;
+ } elsif ($sysname eq 'SunOS') {
+ $time = uptime_solaris;
+ } else {
+ $time = time - $^T;
+ }
+
+ return $time;
+}
+
+sub format_interval {
+ my($interval) = @_;
+
+ my(@interval,$str);
+ for (60, 60, 24, 365) {
+ push @interval, $interval%$_;
+ $interval = int($interval/$_);
+ }
+ $str = sprintf "%dy %dd %dh %dm %ds", $interval, @interval[3,2,1,0];
+ $str =~ s/^(0. )+//;
+
+ return $str;
+}
+
+sub cmd_uptime {
+ my($data,$server,$witem) = @_;
+ my($sysname) = Irssi::parse_special('$sysname');
+ my($uptime) = uptime($sysname);
+ my($str) = format_interval($uptime);
+
+ if ($data && $server) {
+ $server->command("MSG $data uptime: $str");
+ } elsif ($witem && ($witem->{type} eq "CHANNEL" ||
+ $witem->{type} eq "QUERY")) {
+ $witem->command("MSG ".$witem->{name}." uptime: $str");
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'uptime',
+ $str, $sysname);
+ }
+}
+
+sub sig_setup_changed {
+ my($interval) = Irssi::settings_get_int('uptime_refresh_interval');
+
+ Irssi::timeout_remove($timer);
+
+ if ($interval < 1) {
+ $interval = 0;
+ }
+
+ return unless $interval;
+
+ $interval *= 1000;
+ $timer = Irssi::timeout_add($interval, 'uptime_refresh' , undef);
+}
+
+sub sb_uptime {
+ my($item, $get_size_only) = @_;
+ my $format = "";
+ my($uptime) = uptime(Irssi::parse_special('$sysname'));
+ my($time) = format_interval($uptime);
+
+ $format = "{sb %g$time%n}";
+
+ $item->default_handler($get_size_only, $format, undef, 1);
+}
+
+sub uptime_refresh {
+ Irssi::statusbar_items_redraw('uptime');
+}
+
+Irssi::command_bind('uptime', 'cmd_uptime');
+
+Irssi::theme_register(
+[
+ 'uptime',
+ '{line_start}{hilight Uptime:} $0 ($1)',
+]);
+
+Irssi::settings_add_int('upgrade', 'uptime_refresh_interval', 12);
+
+Irssi::signal_add('setup changed', 'sig_setup_changed');
+
+Irssi::statusbar_item_register('uptime', undef, 'sb_uptime');
+
+sig_setup_changed;
diff --git a/scripts/url.pl b/scripts/url.pl
new file mode 100644
index 0000000..a9b6b46
--- /dev/null
+++ b/scripts/url.pl
@@ -0,0 +1,329 @@
+# $Id: url.pl,v 1.52 2002/11/21 06:04:52 jylefort Exp $
+
+use Irssi 20020121.2020 ();
+$VERSION = "0.54";
+%IRSSI = (
+ authors => 'Jean-Yves Lefort',
+ contact => 'jylefort\@brutele.be, decadix on IRCNet',
+ name => 'url',
+ description => 'An URL grabber for Irssi',
+ license => 'BSD',
+ url => 'http://void.adminz.be/',
+ changed => '$Date: 2002/11/21 06:04:52 $ ',
+);
+
+# description:
+#
+# url.pl grabs URLs in messages and allows you to open them on the fly,
+# or to write them in a HTML file and open that file.
+#
+# /set's:
+#
+# url_grab_level
+#
+# message levels to take in consideration
+# example: PUBLICS ACTIONS
+#
+# url_redundant
+#
+# whether to grab same URLs multiple times or not
+# example: ON
+#
+# url_verbose_grab
+#
+# whether to grab verbosely or not
+# example: OFF
+#
+# url_hilight
+#
+# whether to hilight the URLs in the text or not
+# example: OFF
+#
+# url_index_color
+#
+# hilight index color (mirc color string)
+#
+# url_color
+#
+# hilight URL color (mirc color string)
+#
+# browse_command
+#
+# a command used to open URLs
+# %u will be replaced by the URL
+# example: galeon %u &
+#
+# url_file
+#
+# where to write the URL list
+# example: ~/.irssi-urls.html
+#
+# commands
+#
+# /URL [-clear|<number>]
+#
+# -clear will clear the URL list.
+#
+# <number> will open the specified URL.
+#
+# If no arguments are specified, a HTML file containing all
+# grabbed URLs will be written and opened.
+#
+# changes:
+#
+# 2002-11-21 release 0.54
+# * added a DTD to the generated HTML file, suggested
+# by Hugo Haas <hugo@larve.net>
+#
+# 2002-11-19 release 0.53
+# * eh yes, once again a better regexp by
+# Hugo Haas <hugo@larve.net>
+#
+# 2002-11-06 release 0.52
+# * yet another regexp correction, again by
+# Hugo Haas <hugo@larve.net>
+#
+# 2002-10-23 release 0.51
+# * URI regexp corrected by Hugo Haas <hugo@larve.net>
+#
+# 2002-09-26 release 0.50
+# * entirely rewritten; the previous template bloatness
+# has been dropped to get back to a simpler concept
+#
+# 2002-07-04 release 0.47
+# * signal_add's uses a reference instead of a string
+#
+# 2002-03-11 release 0.46
+# * fixed an oblivion in the documentation
+#
+# 2002-02-14 release 0.45
+# * replaced theme capability by /set url_color,
+# fixing a bug in the URL hilighting
+#
+# 2002-02-09 release 0.44
+# * 0.43 didn't grabbed anything: fixed
+#
+# 2002-02-09 release 0.43
+# * url_hilight was _still_ causing an infinite loop
+# under certain conditions: fixed
+# * URLs found at the start of a message were
+# hilighted wrongly: fixed
+#
+# 2002-02-09 release 0.42
+# * if url_hilight was enabled, an infinite loop was
+# caused while printing the hilighted message: fixed
+#
+# 2002-02-08 release 0.41
+# * safer percent substitutions
+# * improved URL regexp
+#
+# 2002-02-08 release 0.40
+# * added /URL -create command
+# * added url_hilight setting
+#
+# 2002-02-01 release 0.34
+# * more precise URL regexp
+#
+# 2002-02-01 release 0.33
+# * added /URL - command
+# * added url_redundant setting
+#
+# 2002-02-01 release 0.32
+# * some little improvements made in the URL regexp
+#
+# 2002-01-31 release 0.31
+# * oops, '<@idiot> I am really stupid' was grabbed coz
+# the '@' mode char trigerred the email regexp
+#
+# 2002-01-31 release 0.30
+# * major update: not HTML-oriented anymore; can generate
+# any type of text file by the use of template files
+#
+# 2002-01-28 release 0.23
+# * changes in url_item and url_item_timestamp_format
+# settings will now be seen immediately
+# * "Added item #n in URL list" is now printed after
+# the grabbed message
+#
+# 2002-01-28 release 0.22
+# * messages are now saved as they were printed in irssi
+# * removed %n format of url_item
+#
+# 2002-01-27 release 0.21
+# * uses builtin expand
+#
+# 2002-01-27 release 0.20
+# * added a %s format to url_item
+# * changed the %d format of url_page to %s
+# * added url_{page|item}_timestamp_format settings
+# * reworked the documentation
+#
+# 2002-01-25 release 0.12
+# * added url_verbose_grab_setting
+#
+# 2002-01-24 release 0.11
+# * now handles actions correctly
+#
+# 2002-01-23 initial release
+#
+# todo:
+#
+# * also hilight redundant URLs
+# * open URLs with alternate programs
+# * add a 'url_grab_own_messages' setting
+
+use strict;
+use POSIX qw(strftime);
+
+use constant MSGLEVEL_NO_URL => 0x0400000;
+
+my @items;
+
+# -verbatim- import expand
+sub expand {
+ my ($string, %format) = @_;
+ my ($len, $attn, $repl) = (length $string, 0);
+
+ $format{'%'} = '%';
+
+ for (my $i = 0; $i < $len; $i++) {
+ my $char = substr $string, $i, 1;
+ if ($attn) {
+ $attn = undef;
+ if (exists($format{$char})) {
+ $repl .= $format{$char};
+ } else {
+ $repl .= '%' . $char;
+ }
+ } elsif ($char eq '%') {
+ $attn = 1;
+ } else {
+ $repl .= $char;
+ }
+ }
+
+ return $repl;
+}
+# -verbatim- end
+
+sub print_text {
+ my ($textdest, $text, $stripped) = @_;
+
+ if (! ($textdest->{level} & MSGLEVEL_NO_URL)
+ && (Irssi::level2bits(Irssi::settings_get_str('url_grab_level'))
+ & $textdest->{level})
+ && ($stripped =~ /[a-zA-Z0-9+-.]+:\/\/[^ \t\<\>\"]+/o)) {
+
+ if (! Irssi::settings_get_bool('url_redundant')) {
+ foreach (@items) { return if ($_->{url} eq $&) }
+ }
+
+ push @items,
+ {
+ time => time,
+ target => $textdest->{target},
+ pre_url => $`,
+ url => $&,
+ post_url => $'
+ };
+
+ if (Irssi::settings_get_bool('url_hilight')) {
+ my $url_pos = index $text, $&;
+ $textdest->{level} |= MSGLEVEL_NO_URL;
+ Irssi::signal_emit('print text', $textdest,
+ substr($text, 0, $url_pos) .
+ Irssi::settings_get_str('url_index_color') . @items . ':' .
+ Irssi::settings_get_str('url_color') . $& . '' .
+ substr($text, $url_pos + length $&),
+ $stripped);
+ Irssi::signal_stop();
+ }
+
+ Irssi::print('Added item #' . @items . ' to URL list')
+ if Irssi::settings_get_bool('url_verbose_grab');
+ }
+}
+
+sub write_file {
+ my $file = shift;
+
+ open(FILE, ">$file") or return $!;
+
+ print FILE <<'EOF' or return $!;
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+ <head>
+ <title>IRC URL list</title>
+ </head>
+ <body>
+ <center>
+ <table border="1" cellpadding="5">
+ <caption>IRC URL list</caption>
+ <tr><th>time<th>target<th>message</tr>
+EOF
+
+ foreach (@items) {
+ my $timestamp = strftime('%c', localtime $_->{time});
+ print FILE " <tr><td>$timestamp<td>$_->{target}<td>$_->{pre_url}<a href=\"$_->{url}\">$_->{url}</a>$_->{post_url}</tr>\n" or return $!;
+ }
+
+ print FILE <<'EOF' or return $!;
+ </table>
+ </center>
+ <hr>
+ <center><small>Generated by url.pl</small>
+ </body>
+</html>
+EOF
+
+ close(FILE) or return $!;
+
+ return undef;
+}
+
+sub url {
+ my ($args, $server, $item) = @_;
+ my ($file) = glob Irssi::settings_get_str('url_file');
+ my $command = Irssi::settings_get_str('browse_command');
+
+ if ($args ne '') {
+ if (lc $args eq '-clear') {
+ @items = ();
+ Irssi::print('URL list cleared');
+ } elsif ($args =~ /^[0-9]+$/) {
+ if ($args > 0 && $items[$args - 1]) {
+ system(expand($command, 'u', $items[$args - 1]->{url}));
+ } else {
+ Irssi::print("URL #$args not found");
+ }
+ } else {
+ Irssi::print('Usage: /URL [-clear|<number>]', MSGLEVEL_CLIENTERROR);
+ }
+ } else {
+ if (@items) {
+ my $error;
+ if ($error = write_file($file)) {
+ Irssi::print("Unable to write $file: $error", MSGLEVEL_CLIENTERROR);
+ } else {
+ system(expand($command, 'u', $file));
+ }
+ } else {
+ Irssi::print('URL list is empty');
+ }
+ }
+}
+
+Irssi::settings_add_str('misc', 'url_grab_level',
+ 'PUBLIC TOPICS ACTIONS MSGS DCCMSGS');
+Irssi::settings_add_bool('lookandfeel', 'url_verbose_grab', undef);
+Irssi::settings_add_bool('lookandfeel', 'url_hilight', 1);
+Irssi::settings_add_str('lookandfeel', 'url_index_color', '08');
+Irssi::settings_add_str('lookandfeel', 'url_color', '12');
+Irssi::settings_add_bool('misc', 'url_redundant', 0);
+Irssi::settings_add_str('misc', 'browse_command',
+ 'galeon-wrapper %u >/dev/null &');
+Irssi::settings_add_str('misc', 'url_file', '~/.irc_url_list.html');
+
+Irssi::signal_add('print text', \&print_text);
+
+Irssi::command_bind('url', \&url);
diff --git a/scripts/url_log.pl b/scripts/url_log.pl
new file mode 100644
index 0000000..8ee9777
--- /dev/null
+++ b/scripts/url_log.pl
@@ -0,0 +1,399 @@
+# url grabber, yes it sucks
+#
+# infected with the gpl virus
+#
+# Thomas Graf <tgraf@europe.com>
+#
+# version: 0.2
+#
+# Commands:
+#
+# /URL LIST
+# /URL CLEAR
+# /URL OPEN [<nr>]
+# /URL QUOTE [<nr>]
+# /URL HEAD [<nr>] !! Blocking !!
+# /HEAD <url> !! Blocking !!
+#
+# Config Values
+#
+# [url logfile]
+# url_log log urls to url_log_file
+# url_log_file file to save urls
+# url_log_format format in url logfile
+# url_log_timestamp format of timestamp in url logfile
+#
+# [url log in memory]
+# url_log_browser command to execute to open url, %f will be replaced with the url
+# url_log_size keep that many urls in the list
+#
+# [http head stuff]
+# url_head_format format of HEAD output
+# url_auto_head do a head on every url received
+# url_auto_head_format format of auto head output
+#
+#
+# Database installation
+# - create database and user
+# - create table url ( id INT UNSIGNED NOT NULL PRIMARY KEY AUTO_INCREMENT,
+# time INT UNSIGNED, nick VARCHAR(25), target VARCHAR(25), url VARCHAR(255));
+# or similiar :)
+#
+#
+# todo:
+#
+# - fix XXX marks
+# - xml output?
+# - don't output "bytes" if content-length is not available
+# - prefix with http:// if no prefix is given
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "0.3";
+%IRSSI = (
+ authors => 'Thomas Graf',
+ contact => 'irssi@reeler.org',
+ name => 'url_log',
+ description => 'logs urls to textfile or/and database, able to list, quote, open or `http head` saved urls.',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.reeler.org/url/',
+);
+
+use LWP;
+use LWP::UserAgent;
+use HTTP::Status;
+use DBI;
+
+use POSIX qw(strftime);
+
+my @urls;
+my $user_agent = new LWP::UserAgent;
+
+$user_agent->agent("IrssiUrlLog/0.3");
+
+# hmm... stolen..
+# -verbatim- import expand
+sub expand {
+ my ($string, %format) = @_;
+ my ($exp, $repl);
+ $string =~ s/%$exp/$repl/g while (($exp, $repl) = each(%format));
+ return $string;
+}
+# -verbatim- end
+
+sub print_msg
+{
+ Irssi::active_win()->print("@_");
+}
+
+#
+# open url in brower using url_log_brower command
+#
+sub open_url
+{
+ my ($data) = @_;
+
+ my ($nick, $target, $url) = split(/ /, $data);
+
+ my $pid = fork();
+
+ if ($pid) {
+ Irssi::pidwait_add($pid);
+ } elsif (defined $pid) { # $pid is zero here if defined
+ my $data = expand(Irssi::settings_get_str("url_log_browser"), "f", $url);
+ # XXX use exec
+ system $data;
+ POSIX::_exit(1);
+ } else {
+ # weird fork error
+ print_msg "Can't fork: $!";
+ }
+}
+
+sub head
+{
+ my ($url) = @_;
+ my $req = new HTTP::Request HEAD => $url;
+ my $res = $user_agent->request($req);
+ return $res;
+}
+
+#
+# do a HEAD
+#
+sub do_head
+{
+ my ($url) = @_;
+
+ my $res = head($url);
+
+ if ($res->code ne RC_OK) {
+ Irssi::active_win()->printformat(MSGLEVEL_CRAP, 'url_head', $url, "\n" .
+ $res->status_line());
+ } else {
+
+ my $t = expand(Irssi::settings_get_str("url_head_format"),
+ "u", $url,
+ "t", scalar $res->content_type,
+ "l", scalar $res->content_length,
+ "s", scalar $res->server);
+
+ Irssi::active_win()->printformat(MSGLEVEL_CRAP, 'url_head', $url, $t);
+ }
+}
+
+#
+# called if url is detected, should do a HEAD and print a 1-liner
+#
+sub do_auto_head
+{
+ my ($url, $window) = @_;
+
+ return if ($url !~ /^http:\/\//);
+
+ my $res = head($url);
+
+ if ($res->code ne RC_OK) {
+ $window->printformat(MSGLEVEL_CRAP, 'url_auto_head', $res->status_line());
+ } else {
+
+ my $t = expand(Irssi::settings_get_str("url_auto_head_format"),
+ "u", $url,
+ "c", $res->code,
+ "t", scalar $res->content_type,
+ "l", scalar $res->content_length,
+ "s", scalar $res->server);
+
+ $window->printformat(MSGLEVEL_CRAP, 'url_auto_head', $t);
+ }
+}
+
+#
+# log url to file
+#
+sub log_to_file
+{
+ my ($nick, $target, $text) = @_;
+ my ($lfile) = glob Irssi::settings_get_str("url_log_file");
+
+ if ( open(LFD, ">>", $lfile) ) {
+
+ my %h = {
+ time => time,
+ nick => $nick,
+ target => $target,
+ url => $text
+ };
+
+ print LFD expand(Irssi::settings_get_str("url_log_format"),
+ "s", strftime(Irssi::settings_get_str("url_log_timestamp_format"), localtime),
+ "n", $nick,
+ "t", $target,
+ "u", $text), "\n";
+
+ close LFD;
+ } else {
+ print_msg "Warning: Unable to open file $lfile $!";
+ }
+}
+
+
+#
+# log url to database
+#
+sub log_to_database
+{
+ my ($nick, $target, $text) = @_;
+
+ # this is quite expensive, but...
+ my $dbh = DBI->connect(Irssi::settings_get_str("url_log_db_dsn"),
+ Irssi::settings_get_str("url_log_db_user"),
+ Irssi::settings_get_str("url_log_db_password"))
+ or print_msg "Can't connect to database " . $DBI::errstr;
+
+ if ($dbh) {
+
+ my $sql = "INSERT INTO url (time, nick, target, url) VALUES (UNIX_TIMESTAMP()," .
+ $dbh->quote($nick) . "," . $dbh->quote($target) . "," . $dbh->quote($text) . ")";
+
+ $dbh->do($sql) or print_msg "Can't execute sql command: " . $DBI::errstr;
+
+ $dbh->disconnect();
+ }
+}
+
+#
+# head command handler
+#
+sub sig_head
+{
+ my ($cmd_line, $server, $win_item) = @_;
+ my @args = split(' ', $cmd_line);
+
+ my $url;
+
+ if (@args <= 0) {
+
+ if ($#urls eq 0) {
+ return;
+ }
+
+ $url = $urls[$#urls];
+ $url =~ s/^.*?\s.*?\s//;
+ } else {
+ $url = lc(shift(@args));
+ }
+
+ do_head($url);
+}
+
+#
+# msg handler
+#
+sub sig_msg
+{
+ my ($server, $data, $nick, $address) = @_;
+ my ($target, $text) = split(/ :/, $data, 2);
+
+ # very special, but better than just \w::/* and www.*
+ while ($text =~ s#.*?(^|\s)(\w+?://.+?|[\w\.]{3,}/[\w~\.]+?(/|/\w+?\.\w+?))(\s|$)(.*)#$5#i) {
+
+ return if ($1 =~ /^\.\./);
+
+ push @urls, "$nick $target $2";
+
+ # XXX resize correctly if delta is > 1
+ if ($#urls >= Irssi::settings_get_int("url_log_size")) {
+ shift @urls;
+ }
+
+ my $ischannel = $server->ischannel($target);
+ my $level = $ischannel ? MSGLEVEL_PUBLIC : MSGLEVEL_MSGS;
+ $target = $nick unless $ischannel;
+ my $window = $server->window_find_closest($target, $level);
+
+ if ( Irssi::settings_get_bool("url_log_auto_head") ) {
+ do_auto_head($2, $window);
+ }
+
+ if ( Irssi::settings_get_bool("url_log") ) {
+ log_to_file($nick, $target, $2);
+ }
+
+ if ( Irssi::settings_get_bool("url_log_db") ) {
+ log_to_database($nick, $target, $2);
+ }
+ }
+}
+
+sub print_url_list_item
+{
+ my ($n, $data) = @_;
+ my ($src, $dst, $url) = split(/ /, $data);
+
+ Irssi::active_win()->printformat(MSGLEVEL_CRAP, 'url_list', $n, $src, $dst, $url);
+}
+
+#
+# url command handler
+#
+sub sig_url
+{
+ my ($cmd_line, $server, $win_item) = @_;
+ my @args = split(' ', $cmd_line);
+
+ if (@args <= 0) {
+ print_msg "URL LIST [<nr>] list all url(s)";
+ print_msg " OPEN [<nr>] open url in browser";
+ print_msg " QUOTE [<nr>] quote url (print to current channel)";
+ print_msg " HEAD send HEAD to server";
+ print_msg " CLEAR clear url list";
+ return;
+ }
+
+ my $action = lc(shift(@args));
+
+ if ($action eq "list") {
+
+ if (@args > 0) {
+ my $i = shift(@args);
+ print_url_list_item($i, $urls[$i]);
+ } else {
+ my $i = 0;
+ foreach my $l (@urls) {
+ print_url_list_item($i, $l);
+ $i++;
+ }
+ }
+
+ } elsif($action eq "open") {
+
+ my $i = $#urls;
+ if (@args > 0) {
+ $i = shift(@args);
+ }
+ open_url($urls[$i]);
+
+ } elsif ($action eq "quote") {
+
+ my $i = $#urls;
+ if (@args > 0) {
+ $i = shift(@args);
+ }
+ Irssi::active_win()->command("SAY URL: " . $urls[$i]);
+
+ } elsif ($action eq "clear") {
+
+ splice @urls;
+
+ } elsif ($action eq "head") {
+
+ my $i = $#urls;
+ if (@args > 0) {
+ $i = shift(@args);
+ }
+ my $url = $urls[$i];
+ $url =~ s/^.*?\s.*?\s//;
+
+ do_head($url);
+
+ } else {
+ print_msg "Unknown action";
+ }
+}
+
+Irssi::command_bind('head', 'sig_head');
+Irssi::command_bind('url', 'sig_url');
+Irssi::command_bind('url list', 'sig_url');
+Irssi::command_bind('url clear', 'sig_url');
+Irssi::command_bind('url open', 'sig_url');
+Irssi::command_bind('url quote', 'sig_url');
+Irssi::command_bind('url head', 'sig_url');
+Irssi::signal_add_first('event privmsg', 'sig_msg');
+
+Irssi::settings_add_bool("url_log", "url_log", 1);
+Irssi::settings_add_bool("url_log", "url_log_auto_head", 1);
+Irssi::settings_add_bool("url_log", "url_log_db", 0);
+Irssi::settings_add_str("url_log", "url_log_db_dsn", 'DBI:mysql:irc_url:localhost');
+Irssi::settings_add_str("url_log", "url_log_db_user", 'irc_url');
+Irssi::settings_add_str("url_log", "url_log_db_password", 'nada');
+Irssi::settings_add_str("url_log", "url_log_file", "~/.irssi/url");
+Irssi::settings_add_str("url_log", "url_log_timestamp_format", '%c');
+Irssi::settings_add_str("url_log", "url_log_format", '%s %n %t %u');
+Irssi::settings_add_str("url_log", "url_log_browser", 'galeon -n -x %f > /dev/null');
+Irssi::settings_add_int("url_log", "url_log_size", 25);
+Irssi::settings_add_str("url_log", "url_auto_head_format", '%c %t %l bytes');
+Irssi::settings_add_str("url_log", "url_head_format", '
+Content-Type: %t
+Length: %l bytes
+Server: %s');
+
+
+Irssi::theme_register(['url_head', '[%gHTTP Head%n %g$0%n]$1-',
+ 'url_auto_head', '[%gHEAD%n] $0-',
+ 'url_list', '[$0] $1 %W$2%n $3-']);
+
+# vim:set ts=4 sw=4 expandtab:
diff --git a/scripts/urlfeed.pl b/scripts/urlfeed.pl
new file mode 100644
index 0000000..936fc14
--- /dev/null
+++ b/scripts/urlfeed.pl
@@ -0,0 +1,262 @@
+#!/usr/bin/perl -w
+#
+# this is a VERY experimental code, use at own risk
+#
+# WARNING:
+# I am still not sure of the UTF-8 handling. It may only work if you
+# are on a UTF-8 terminal, with UTF-8ized settings.
+#
+# TODO:
+# - make urlfeed_title, urlfeed_link, urlfeed_description work for
+# already-created feeds, not only the new ones
+# - some exclude-list would be useful I guess
+# - enhance urlfeed_find_url() maybe
+# - TEST IT! it's not idiot-proof at the moment
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+use POSIX qw(strftime);
+use Irssi;
+use Irssi::Irc;
+use Encode;
+use XML::RSS;
+use Regexp::Common qw /URI/;
+
+$VERSION = '1.31';
+
+%IRSSI = (
+ authors => 'Jakub Jankowski',
+ contact => 'shasta@toxcorp.com',
+ name => 'URLfeed',
+ description => 'Provides RSS feeds with URLs pasted on your channels.',
+ license => 'GNU GPLv2 or later',
+ url => 'http://toxcorp.com/irc/irssi/urlfeed/',
+ changed => '2019-03-02'
+);
+
+# These rules apply only to per-channel RSS files, NOT to the bundle!
+# $stripchan is replaced with channel name, BUT with stripped #!&+
+# $chan is replaced with channel name
+# $tag is replaced with server tag
+
+my $rss_title = 'URLs on $chan';
+my $rss_link = 'http://toxcorp.com/irc/irssi/';
+my $rss_description = 'List of URLs recently pasted on $chan $tag channel';
+my $rss_path = $ENV{HOME}.'/public_html/rss/$tag/$stripchan.rdf';
+my $rss_bundle_path = $ENV{HOME}.'/public_html/rss/all.rdf';
+my $max_items = 15;
+my $bundle_max_items = 40;
+my $debug = 1;
+my $provide_bundle = 0;
+
+sub urlfeed_build_path {
+ my ($tag, $chan) = @_;
+ my ($stripchan) = $chan =~ /^[\!\#\&\+](.+)/g;
+ my $str = Irssi::settings_get_str('urlfeed_path');
+ $str =~ s/\$tag/$tag/gi;
+ $str =~ s/\$chan/$chan/gi;
+ $str =~ s/\$stripchan/$stripchan/gi;
+ $str .= $chan . ".rdf" if ($str =~ /\/$/);
+ return $str;
+}
+
+sub urlfeed_replace ($$$) {
+ my ($str, $tag, $chan) = @_;
+ my ($stripchan) = $chan =~ /^[\!\#\&\+](.+)/g;
+ $str =~ s/\$tag/$tag/gi;
+ $str =~ s/\$chan/$chan/gi;
+ $str =~ s/\$stripchan/$stripchan/gi;
+ return $str;
+}
+
+sub urlfeed_touch_file ($) {
+ my ($f) = @_;
+ my ($basedir) = $f =~ /(.*)\/[^\/]*$/;
+ my @dirs = split(/[\/]+/, $basedir);
+ local *FH;
+ my $path = "";
+
+ foreach my $idx (1..$#dirs) {
+ $path .= "/" . $dirs[$idx];
+ if (! -d $path) {
+ Irssi::print("URLfeed warning: $path is not a dir, trying to mkdir");
+ eval { mkdir($path); };
+ if ($@) {
+ Irssi::print("URLfeed error: couldn't mkdir($path): $@");
+ return 0;
+ }
+ }
+ }
+
+ if (! -w $basedir) {
+ Irssi::print("URLfeed error: $basedir isn't writable");
+ return 0;
+ }
+
+ eval { open(FH, '+<',$f); };
+ if ($@) {
+ Irssi::print("URLfeed error: couldn't open $f for writing: $@");
+ return 0;
+ }
+
+ close(FH);
+
+ return 1;
+}
+
+sub urlfeed_format_time ($) {
+ my @t = localtime($_[0]);
+ my $time = strftime("%Y-%m-%dT%H:%M:%S", @t);
+ my $tzd = strftime("%z", @t);
+ return sprintf("%s%s:%s", $time, substr($tzd,0,3), substr($tzd,3));
+}
+
+# we might make use of timestamp someday
+sub urlfeed_rss_add {
+ my ($timestamp, $tag, $chan, $nickname, $text, $url) = @_;
+
+ return 0 unless (defined $url && defined $tag && defined $chan);
+
+ $nickname = "guest" unless (defined $nickname);
+ $text = $url unless (defined $text);
+
+ my $filename = urlfeed_build_path($tag, $chan);
+ if (!urlfeed_touch_file($filename)) {
+ Irssi::print("URLfeed error: Couldn't touch $filename");
+ return 0;
+ }
+
+ # UTF-8 is the default encoding
+ my $rss = new XML::RSS (version => '1.0' );
+ eval { $rss->parsefile($filename); };
+ if ($@) {
+ Irssi::print("URLfeed notice: rss->parsefile($filename) failed. Creating new RSS") if (Irssi::settings_get_bool('urlfeed_debug'));
+ $rss->channel(
+ title => urlfeed_replace(Irssi::settings_get_str('urlfeed_title'), $tag, $chan),
+ link => urlfeed_replace(Irssi::settings_get_str('urlfeed_link'), $tag, $chan),
+ description => urlfeed_replace(Irssi::settings_get_str('urlfeed_description'), $tag, $chan)
+ );
+ }
+
+ # tiny spam protection
+ foreach my $item (@{$rss->{'items'}}) {
+ return 0 if (lc($url) eq lc($item->{'link'}));
+ }
+
+ my $guard = 0;
+ while (@{$rss->{'items'}} >= Irssi::settings_get_int('urlfeed_max_items') && $guard++ < 10000) {
+ pop(@{$rss->{'items'}});
+ }
+
+ $rss->add_item(title => Encode::decode_utf8($text),
+ link => $url,
+ dc => { creator => $nickname, date => urlfeed_format_time($timestamp) },
+ mode => 'insert'
+ );
+
+ $rss->save($filename);
+
+ return 1 unless (Irssi::settings_get_bool('urlfeed_provide_bundle'));
+
+ # now do the bundle part
+ $filename = Irssi::settings_get_str('urlfeed_bundle_path');
+ if (!urlfeed_touch_file($filename)) {
+ Irssi::print("URLfeed error: Couldn't touch $filename");
+ return 0;
+ }
+ my $brss = new XML::RSS (version => '1.0' );
+ eval { $brss->parsefile($filename); };
+ if ($@) {
+ Irssi::print("URLfeed notice: rss->parsefile($filename) failed. Creating new RSS") if (Irssi::settings_get_bool('urlfeed_debug'));
+ $brss->channel(
+ title => $rss_title,
+ link => $rss_link,
+ description => $rss_description
+ );
+ }
+
+ # tiny spam protection
+ foreach my $item (@{$brss->{'items'}}) {
+ return 0 if (lc($url) eq lc($item->{'link'}));
+ }
+
+ my $guard = 0;
+ while (@{$brss->{'items'}} >= Irssi::settings_get_int('urlfeed_bundle_max_items') && $guard++ < 10000) {
+ pop(@{$brss->{'items'}});
+ }
+
+ $brss->add_item(title => Encode::decode_utf8($text),
+ link => $url,
+ dc => { creator => $nickname . " on " . $tag, date => urlfeed_format_time($timestamp) },
+ mode => 'insert'
+ );
+
+ $brss->save($filename);
+
+ return 1;
+}
+
+# based on urlgrab.pl by David Leadbeater
+sub urlfeed_find_urls {
+ my ($text) = @_;
+ my @chunks = split(/[ \t]+/, $text);
+ my @urls = ();
+
+ foreach my $chunk (@chunks) {
+ if ($chunk =~ /($RE{URI}{HTTP}{-scheme => qr#https?#})/ ||
+ $chunk =~ /($RE{URI}{FTP})/ ||
+ $chunk =~ /($RE{URI}{NNTP})/ ||
+ $chunk =~ /($RE{URI}{news})/) {
+ push(@urls, $1);
+ } elsif ($chunk =~ /(www\.[a-zA-Z0-9\/\\\:\?\%\.\&\;=#\-\_\!\+\~\,]+)/i) {
+ push(@urls, "http://" . $1);
+ }
+ }
+ return @urls;
+}
+
+sub urlfeed_process {
+ my ($time, $tag, $target, $nick, $text) = @_;
+
+ my @urls = urlfeed_find_urls($text);
+
+ foreach my $url (@urls) {
+ my $retval = urlfeed_rss_add($time, $tag, $target, $nick, $text, $url);
+ if (Irssi::settings_get_bool('urlfeed_debug')) {
+ # escape url, in case it needs to be Irssi::print()ed
+ $url =~ s/\%/\%\%/g;
+ if ($retval == 1) {
+ Irssi::print("URLfeed notice: URL $url (pasted by $nick on $target/$tag) successfully added to RSS feed.");
+ } elsif ($retval == 0) {
+ Irssi::print("URLfeed notice: Adding URL $url (pasted by $nick on $target/$tag) to RSS failed.");
+ }
+ }
+ }
+}
+
+sub urlfeed_message_own_public {
+ my ($server, $text, $target) = @_;
+ return unless ($target =~ /^[\!\#\&\+]/);
+ $target = '!' . substr($target, 6) if ($target =~ /^\!/);
+ urlfeed_process(time, $server->{tag}, lc($target), $server->{nick}, $text);
+}
+
+sub urlfeed_message_public {
+ my ($server, $text, $nick, $hostmask, $target) = @_;
+ return unless ($target =~ /^[\!\#\&\+]/);
+ urlfeed_process(time, $server->{tag}, lc($target), $nick, $text);
+}
+
+Irssi::settings_add_bool('urlfeed', 'urlfeed_debug', $debug);
+Irssi::settings_add_bool('urlfeed', 'urlfeed_provide_bundle', $provide_bundle);
+Irssi::settings_add_int ('urlfeed', 'urlfeed_max_items', $max_items);
+Irssi::settings_add_int ('urlfeed', 'urlfeed_bundle_max_items', $bundle_max_items);
+Irssi::settings_add_str ('urlfeed', 'urlfeed_title', $rss_title);
+Irssi::settings_add_str ('urlfeed', 'urlfeed_link', $rss_link);
+Irssi::settings_add_str ('urlfeed', 'urlfeed_description', $rss_description);
+Irssi::settings_add_str ('urlfeed', 'urlfeed_path', $rss_path);
+Irssi::settings_add_str ('urlfeed', 'urlfeed_bundle_path', $rss_bundle_path);
+
+Irssi::signal_add_last('message public', 'urlfeed_message_public');
+Irssi::signal_add_last('message own_public', 'urlfeed_message_own_public');
diff --git a/scripts/urlgrab.pl b/scripts/urlgrab.pl
new file mode 100644
index 0000000..5f83a30
--- /dev/null
+++ b/scripts/urlgrab.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/perl -w
+#
+# Settings:
+# /SET urlgrab_command <command>
+# Command to execute when opening URLs
+# Default: xdg-open '%s' > /dev/null 2>&1
+#
+
+use strict;
+use Time::Piece;
+use Irssi 20010120.0250 ();
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.5";
+%IRSSI = (
+ authors => 'David Leadbeater, Thorsten Scherf',
+ contact => 'dgl@dgl.cx, tscherf@redhat.com',
+ name => 'urlgrab',
+ description => 'Captures urls said in channel and private messages and saves them to a file, also adds a /url command which loads the last said url into a browser.',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.dgl.cx/',
+);
+
+my $lasturl;
+
+# Change the file path below if needed
+my $file = "$ENV{HOME}/.urllog";
+
+sub url_public{
+ my($server,$text,$nick,$hostmask,$channel)=@_;
+ my $url = find_url($text);
+ url_log($nick, $channel, $url) if defined $url;
+}
+
+sub url_private{
+ my($server,$text,$nick,$hostmask)=@_;
+ my $url = find_url($text);
+ url_log($nick, $server->{nick}, $url) if defined $url;
+}
+
+sub url_cmd{
+ if(!$lasturl){
+ Irssi::print("No url captured yet");
+ return;
+ }
+ system(sprintf(Irssi::settings_get_str("urlgrab_command"), $lasturl));
+}
+
+sub find_url {
+ my $text = shift;
+ if($text =~ /((ftp|http|https):\/\/[a-zA-Z0-9\/\\\:\?\%\.\&\;=#\-\_\!\+\~]*)/i){
+ return $1;
+ }elsif($text =~ /(www\.[a-zA-Z0-9\/\\\:\?\%\.\&\;=#\-\_\!\+\~]*)/i){
+ return "http://".$1;
+ }
+ return undef;
+}
+
+sub url_log{
+ my $t = localtime;
+ my($where,$channel,$url) = @_;
+ return if lc $url eq lc $lasturl; # a tiny bit of protection from spam/flood
+ $lasturl = $url;
+ open(URLLOG, ">>", $file) or return;
+ print URLLOG $t->datetime . " $where $channel $lasturl\n";
+ close(URLLOG);
+}
+
+Irssi::settings_add_str("misc", "urlgrab_command", "xdg-open '%s' > /dev/null 2>&1");
+Irssi::signal_add_last("message public", "url_public");
+Irssi::signal_add_last("message private", "url_private");
+Irssi::command_bind("url", "url_cmd");
diff --git a/scripts/urlplot.pl b/scripts/urlplot.pl
new file mode 100644
index 0000000..a56d124
--- /dev/null
+++ b/scripts/urlplot.pl
@@ -0,0 +1,841 @@
+use strict;
+#use warnings; # Not a default module in perl 5.005
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.2';
+%IRSSI = (
+ authors => 'bwolf',
+ contact => 'bwolf@geekmind.org',
+ name => 'urlplot',
+ description => 'URL grabber with HTML generation and cmd execution',
+ license => 'BSD',
+ url => 'http://www.geekmind.net',
+ changed => 'Sun Jun 16 14:00:13 CEST 2002'
+);
+
+# To read the documentation you may use one of the following commands:
+#
+# pod2man urlplot.pl | nroff -man | more
+# pod2text urlplot.pl | more
+# pod2man urlplot.pl | troff -man -Tps -t > urlplot.ps
+
+=head1 NAME
+
+urlplot
+
+=head1 SYNOPSIS
+
+All URL loggers suck. This one just sucks less.
+
+=head1 DESCRIPTION
+
+urlplot watches your channels for URLs and creates nice HTML logfiles of it.
+Actually it parses normal text and topic changes for URLs. Internally it uses
+two caches to prevent flooding and logging of duplicate URLs. As an additional
+feature urlplot can create CSV datafiles. Logfiles can be created for all
+channels and for separate channels. Logging can be allowed and denied on a per
+channel/nick basis. A lockfile is used to protect the caches and logfiles from
+accessing them by multiple irssi instances. A command allows you to send a
+logged URL to your webbrowser of choice.
+
+The format of the CSV logfiles is as follows:
+date nick channel url
+
+=head1 GETTING STARTED
+
+Copy urlplot.pl intoF< $HOME/.irssi/scripts> and create the necessary
+directories withC< mkdir -p>F< $HOME/.irssi/urlplot/urls>.
+Look for the settingsC< url_log_basedir> andC< url_db_basedir> if you want to
+change the directories urlplot will populate with files.
+Follow the documentation and configure urlplot to fit your needs.
+
+=head1 COMMANDS
+
+=head2 /url <integer>
+
+Executes the commandC< url_command> with an URL from the cache as its
+argument. If no number has been specified it defaults to nth URL logged which
+references the most recently logged URL.
+
+=head2 /url -list
+
+Displays a list of all logged URLs.
+
+=head2 /url -clearcache
+
+Clears the cache databases.
+
+=head /url -showlog
+
+ExecutesC< url_command> withC< url_navigate> as its argument. It can be used
+to display the main logfile in your favourite webbrowser.
+
+=head1 SETTINGS
+
+=head2 Pathnames
+
+Please note that you can't use $HOME or any environment variables in the
+settings because irssi/urlplot isn't a shell ;)
+
+=head2 /set url_command <string>
+
+Command to be executed to display an URL (see /url). The command string should
+contain the sequence C<__URL__> which will be replaced by a certain URL.
+
+The default is:
+C< mozilla -remote "openURL(__URL__)" E<gt> /dev/null 2E<gt>&1 || \ >
+C< mozilla "__URL__"& >
+
+This will send a certain URL to mozilla or it will start mozilla if it is not
+already there. The string can be anything. For example I use the following:
+C< ssh host /home/user/bin/mozopenurl "'__URL__'" >/dev/null 2>&1 &>
+where mozopenurl is a shell script that contains similar code as the mozilla
+-remote example above.
+
+=head2 /set url_cache_max <integer>
+
+Specifies the maximum count of items which will be held in the persisten URL
+caches. A value of zero disables automatic cache resizing (round-robbin). The
+default is to keep the last 90 URLs.
+
+=head2 /set url_log_basedir <path>
+
+Specifies the logging base directory used to create the log files beneath it.
+The default isF< $HOME/.irssi/urlplot/urls/>. You have to create directories
+by yourself:C< mkdir -p>F< $HOME/.irssi/urlplot/urls>.
+
+=head2 /set url_log_file_name <relative-filename>
+
+Defines the filename of the full logfile. It will be passed to I<
+strftime(3)>. This can be usefull to create logfiles with a timestamp.
+The file will be created relative toC< url_log_basedir>. The default
+isF< ircurls.html>.
+
+=head2 /set url_chan_prefix <string>
+
+Defines the filename prefix for channel logfiles. The leadingC< # >of the
+channel name will be replaced by this prefix. It will be passed to
+I<strftime(3)>. The file will be created relative toC< url_log_basedir>. The
+default isF< chan_>.
+
+=head2 /set url_chan_logging <bool>
+
+Enables or disable channel logging globally.
+The default isC< ON>.
+
+=head2 /set url_log_csv_file_name <relative-filename>
+
+Defines the filename of the full CSV logfile. It will be passed to
+I<strftime(3)>. The file will be created relative toC< url_log_basedir>. The
+default isF< ircurls.csv>.
+
+=head2 /set url_log_csv_file_max_size <integer>
+
+Defines the maximum size of the full CSV logfile. If it reaches the specified
+maximum size in bytes it will be simply resized to zero. The default isC< 30*1024>
+bytes.
+
+=head2 /set url_log_csv_separator <string>
+
+Defines the separator used as a delimeter for the fields of the CSV files.
+The default isC< |>.
+
+=head2 /set url_csv_logging <bool>
+
+Conditionally turns on or off CSV logging for the full logfile. The default
+isC< OFF>.
+
+=head2 /set url_csv_chan_logging <bool>
+
+Conditionally turns on or off CSV logging of the channel logfiles. The default isC< OFF>.
+
+=head2 /set url_time_format <string>
+
+Specifies the time format that will be passed toI< strftime(3)> to produce an
+ASCII representation of the time/date when an URL was grabbed. It will be used
+in the logfiles. The default isC< %Y:%m:%d - %H:%M:%S>.
+
+=head2 /set url_log_file_max_size <integer>
+
+Defines the maximum size of the full logfile and the channel logfile. If it
+reaches the specified maximum size in bytes it will be simply resized to zero.
+The default isC< 30*1024> bytes.
+
+=head2 /set url_log_file_autoreload_time <integer>
+
+Intervall in seconds used for the HTML logfile header. The logfile reloads
+itself every N seconds. The default isC< 90> seconds.
+
+=head2 /set url_db_basedir <path>
+
+Specifies the database base directory where two database files and a lockfile
+will be created. The default isF< $HOME/.irssi/urlplot>. You have to create
+the directory by yourself.
+
+=head2 /set url_db_cache_a_filename <relative-filename>
+
+Defines the filename of the index URL database. The file will be created
+relative toC< url_db_basedir>. The default isF< a_cache>.
+
+=head2 /set url_db_cache_h_filename <relative-filename>
+
+Defines the filename of the hash URL database. The file will be created
+relative toC< url_db_basedir>. The default isF< h_cache>.
+
+=head2 /set url_db_lock_filename <relative-filename>
+
+Defines the filename of the lockfile used to lock all logfiles and the cache
+databases. It will be created relative toC< url_db_basedir>. The default
+isF< lockfile>.
+
+=head2 /set url_policy_default <allow|deny>
+
+Specifies the default policy that will be used to decide if logging ist
+permitted for a certain nick or channel. This can be eitherC< allow>
+orC< deny>. If you set this toC< deny> you will have to allow explicitly those
+channels and nicks for which logging should be permitted. In contrast if you
+set it to allow, you can deny logging for certain nicks and channels.
+The keysC< url_policy_chans> andC< url_policy_nicks> control the allow, deny
+behaviour depending onC< url_policy_default>. The default isC< allow> which
+permits logging of all channels and nicks.
+
+=head2 /set url_policy_chans <string>
+
+Specifies those channels for whoom logging is permitted or denied. Multiple
+channels may be specified by usingC< ,>C< ;>C< :> or a space to separate the
+items.
+
+=head2 /set url_policy_nicks <string>
+
+SeeC< url_policy_chans> and replace the word channel by nick.
+
+=head2 /set url_navigate <string>
+
+ExecutesC< url_command> withC< url_navigate> as its argument. It can be used
+to display the main logfile in your favourite webbrowser. Because you may pass
+this command at anytime to your webbrowser it will not be passed to strftime.
+Thus you can only specify a static file here.
+
+=head1 AUTHOR
+
+Marcus Geiger <bwolf@geekmind.org>
+
+=cut
+
+use integer;
+use Irssi;
+use POSIX qw(strftime);
+use Fcntl qw(:DEFAULT :flock);
+use DB_File;
+
+# Regexps
+sub URL_SCHEME_REGEX() { '(http|ftp|https|news|irc)' }
+sub URL_GUESS_REGEX() { '(www|ftp)' }
+sub URL_BASE_REGEX() { '[a-z0-9_\-+\\/:?%.&!~;,=\#<>]' }
+
+# Other
+sub BACKWARD_SEEK_BYTES() { 130 }
+sub LOG_FILE_MARKER() { '<!-- bottom-line -->' }
+
+# Keys for settings
+sub KEY_URL_COMMAND() { 'url_command' }
+sub KEY_URL_CACHE_MAX() { 'url_cache_max' }
+sub KEY_URL_LOG_BASEDIR() { 'url_log_basedir' }
+sub KEY_URL_LOG_FILE_NAME() { 'url_log_file_name' }
+sub KEY_URL_CHAN_PREFIX() { 'url_chan_prefix' }
+sub KEY_URL_CHAN_LOGGING() { 'url_chan_logging' }
+sub KEY_URL_LOG_CSV_FILE_NAME() { 'url_log_csv_file_name' }
+sub KEY_URL_LOG_CSV_FILE_MAX_SIZE() { 'url_log_csv_file_max_size' }
+sub KEY_URL_LOG_CSV_SEPARATOR() { 'url_log_csv_separator' }
+sub KEY_URL_CSV_LOGGING() { 'url_csv_logging' }
+sub KEY_URL_CSV_CHAN_LOGGING() { 'url_csv_chan_logging' }
+sub KEY_URL_TIME_FORMAT() { 'url_time_format' }
+sub KEY_URL_LOG_FILE_MAX_SIZE() { 'url_log_file_max_size' }
+sub KEY_URL_LOG_FILE_AUTORELOAD_TIME() { 'url_log_file_autoreload_time' }
+sub KEY_URL_DB_BASEDIR() { 'url_db_basedir' }
+sub KEY_URL_DB_CACHE_A_FILENAME() { 'url_db_cache_a_filename' }
+sub KEY_URL_DB_CACHE_H_FILENAME() { 'url_db_cache_h_filename' }
+sub KEY_URL_DB_LOCK_FILENAME() { 'url_db_lock_filename' }
+sub KEY_URL_POLICY_DEFAULT() { 'url_policy_default' }
+sub KEY_URL_POLICY_CHANS() { 'url_policy_chans' }
+sub KEY_URL_POLICY_NICKS() { 'url_policy_nicks' }
+sub KEY_URL_NAVIGATE() { 'url_navigate' }
+
+# Defaults
+sub DEF_URL_COMMAND() {
+ 'mozilla -remote "openURL(__URL__)" > /dev/null 2>&1 || mozilla "__URL__"&' }
+sub DEF_URL_CACHE_MAX() { 90 }
+sub DEF_URL_LOG_FILE_AUTORELOAD_TIME() { 120 }
+sub DEF_URL_TIME_FORMAT() { '%Y:%m:%d - %H:%M:%S' }
+sub DEF_URL_DO_FILE_RESIZE() { '0' }
+sub DEF_URL_LOG_FILE_MAX_SIZE() { 1024 * 30 }
+sub DEF_URL_LOG_BASEDIR() { '.irssi/urlplot/urls/' }
+sub DEF_URL_LOG_FILE_NAME() { 'ircurls.html' }
+sub DEF_URL_CHAN_PREFIX() { 'chan_' }
+sub DEF_URL_CHAN_LOGGING() { '1' }
+sub DEF_URL_LOG_CSV_FILE_NAME() { 'ircurls.csv' }
+sub DEF_URL_LOG_CSV_FILE_MAX_SIZE() { 1024 * 30 }
+sub DEF_URL_LOG_CSV_SEPARATOR() { '|' }
+sub DEF_URL_CSV_LOGGING() { '' }
+sub DEF_URL_CSV_CHAN_LOGGING() { '' }
+sub DEF_URL_DB_BASEDIR() { '.irssi/urlplot/' }
+sub DEF_URL_DB_CACHE_A_FILENAME() { 'a_cache' }
+sub DEF_URL_DB_CACHE_H_FILENAME() { 'h_cache' }
+sub DEF_URL_DB_LOCK_FILENAME() { 'lockfile' }
+sub DEF_URL_POLICY_DEFAULT() { 'allow' }
+sub DEF_URL_POLICY_CHANS() { '' }
+sub DEF_URL_POLICY_NICKS() { '' }
+sub DEF_URL_NAVIGATE() { '.irssi/urlplot/urls/ircurls.html' }
+
+sub print_full_log_file_template {
+ my ($fh, $reload) = @_;
+ print $fh <<EOT;
+<?xml version="1.0" encoding="iso-8859-1"?>
+ <!DOCTYPE html
+ PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+ "DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head>
+ <title>IRC-URLs</title>
+ <meta http-equiv="cache-control" content="no-cache" />
+ <meta http-equiv="refresh" content="$reload;" />
+ <style type="text/css">
+ <!--
+ .small { font-size: small; }
+ .xsmall { font-size: x-small; }
+ -->
+ </style>
+ </head>
+ <body>
+ <h1>IRC-URLs</h1>
+ <p class="xsmall">
+ Visit <a href="http://www.geekmind.net">geekmind.net</a>
+ </p>
+ <p>This page reloads itself every $reload seconds.</p>
+ <p>
+ <a name="top" />
+ <a class="small" href="#bottom">Page bottom</a>
+ <br />
+ <br />
+ </p>
+ <table rules="rows" frame="void" width="100%" cellpadding="5">
+ <tr align="left">
+ <th><b>Date/Time</b></th>
+ <th><b>Nick</b></th>
+ <th><b>Channel/Nick</b></th>
+ <th><b>URL</b></th>
+ </tr>
+EOT
+}
+
+sub print_chan_log_file_template {
+ my ($fh, $reload, $channel, $full_log) = @_;
+ print $fh <<EOT;
+<?xml version="1.0" encoding="iso-8859-1"?>
+ <!DOCTYPE html
+ PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+ "DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head>
+ <title>IRC-URLs of $channel</title>
+ <meta http-equiv="cache-control" content="no-cache" />
+ <meta http-equiv="refresh" content="$reload;" />
+ <style type="text/css">
+ <!--
+ .small { font-size: small; }
+ .xsmall { font-size: x-small; }
+ -->
+ </style>
+ </head>
+ <body>
+ <h1>IRC-URLs of $channel</h1>
+ <p class="xsmall">
+ Visit <a href="http://www.geekmind.net">geekmind.net</a>
+ </p>
+ <p>This page reloads itself every $reload seconds.</p>
+ <p><a href="$full_log">Complete</a> listing.</p>
+ <p>
+ <a name="top" />
+ <a class="small" href="#bottom">Page bottom</a>
+ <br />
+ <br />
+ </p>
+ <table rules="rows" frame="void" width="100%" cellpadding="5">
+ <tr align="left">
+ <th><b>Date/Time</b></th>
+ <th><b>Nick</b></th>
+ <th><b>URL</b></th>
+ </tr>
+EOT
+}
+
+sub LOG_FILE_TAIL () {
+ return <<"EOT";
+
+ @{[ LOG_FILE_MARKER ]}
+ </table>
+ <p>
+ <a class="small" href="#top">Page top</a>
+ <a name="bottom" />
+ </p>
+ </body>
+</html>
+EOT
+}
+
+sub print_chan_log_file_entry {
+ my ($fh, $date, $nick, $channel, $url) = @_;
+ print $fh <<EOURL;
+ <tr>
+ <td>$date</td>
+ <td><em>$nick</em></td>
+ <td><a href=\"$url\">$url</a></td>
+ </tr>
+EOURL
+ print $fh LOG_FILE_TAIL;
+};
+
+sub print_full_log_file_entry {
+ my ($fh, $date, $nick, $channel, $chan_log, $url) = @_;
+ print $fh <<EOURL;
+ <tr>
+ <td>$date</td>
+ <td><em>$nick</em></td>
+ <td><a href="$chan_log">$channel</a></td>
+ <td><a href=\"$url\">$url</a></td>
+ </tr>
+EOURL
+ print $fh LOG_FILE_TAIL;
+}
+
+sub p_error { # Error printing (directly to the current window)
+ Irssi::print("urlplot: @_");
+}
+
+sub p_normal { # Normal printing (to the msg window)
+ Irssi::print("@_", MSGLEVEL_MSGS+MSGLEVEL_NOHILIGHT);
+}
+
+sub scan_url {
+ my $rawtext = shift;
+ return $1 if $rawtext =~ m|(@{[ URL_SCHEME_REGEX ]}://@{[ URL_BASE_REGEX ]}+)|io;
+ # The URL misses a scheme, try to be smart
+ if ($rawtext =~ m|@{[ URL_GUESS_REGEX ]}\.@{[ URL_BASE_REGEX ]}+|io) {
+ my $preserve = $&;
+ return "http://$preserve" if $1 =~ /^www/;
+ return "ftp://$preserve" if $1 =~ /^ftp/;
+ }
+ return undef;
+}
+
+sub aquire_lock {
+ my $db_base = Irssi::settings_get_str(KEY_URL_DB_BASEDIR)
+ || die "missing setting for @{[ KEY_URL_DB_BASEDIR ]}";
+ my $lockfile = Irssi::settings_get_str(KEY_URL_DB_LOCK_FILENAME)
+ || die "missing setting for @{[ KEY_URL_DB_LOCK_FILENAME ]}";
+
+ local *LOCK_F;
+ my $fh;
+ $db_base .= '/' if $db_base !~ m#/$#;
+ $lockfile = "${db_base}${lockfile}";
+
+ die "directory $db_base doesn't exist or isn't readable"
+ unless -d $db_base and -r $db_base;
+
+ sysopen(LOCK_F, $lockfile, O_RDONLY | O_CREAT)
+ || die "can't open/create lockfile $lockfile: $!";
+ flock(LOCK_F, LOCK_EX | LOCK_NB)
+ || die "can't exclusively lock $lockfile: $!";
+ # Can't pass back localized typeglob reference
+ $fh = *LOCK_F;
+ return $fh;
+}
+
+sub open_caches {
+ my $db_base = Irssi::settings_get_str(KEY_URL_DB_BASEDIR)
+ || die "missing setting for @{[ KEY_URL_DB_BASEDIR ]}";
+ my $dbfile_a = Irssi::settings_get_str(KEY_URL_DB_CACHE_A_FILENAME)
+ || die "missing setting for @{[ KEY_URL_DB_CACHE_A_FILENAME ]}";
+ my $dbfile_h = Irssi::settings_get_str(KEY_URL_DB_CACHE_H_FILENAME)
+ || die "missing setting for @{[ KEY_URL_DB_CACHE_H_FILENAME ]}";
+
+ my (@cache, %cache);
+ $db_base .= '/' if $db_base !~ m#/$#;
+ $dbfile_a = "${db_base}${dbfile_a}";
+ $dbfile_h = "${db_base}${dbfile_h}";
+
+ die "directory $db_base doesn't exist or isn't readable"
+ unless -d $db_base and -r $db_base;
+
+ tie @cache, 'DB_File', $dbfile_a, O_RDWR | O_CREAT, 0666, $DB_RECNO
+ or die "can't tie urlcache db $dbfile_a: $!";
+ tie %cache, 'DB_File', $dbfile_h, O_RDWR | O_CREAT, 0666
+ or die "can't tie urlcache db $dbfile_h: $!";
+ return \(@cache, %cache);
+}
+
+sub create_chan_template {
+ my ($full_log, $file, $channel) = @_;
+ my $reload = Irssi::settings_get_int(KEY_URL_LOG_FILE_AUTORELOAD_TIME);
+ local *FH;
+ open(FH, ">", $file)
+ || die "can't create logfile $file: $!";
+ print_chan_log_file_template(\*FH, $reload, $channel, $full_log);
+ print FH LOG_FILE_TAIL;
+ close(FH);
+}
+
+sub create_full_template {
+ my $file = shift;
+ my $reload = Irssi::settings_get_int(KEY_URL_LOG_FILE_AUTORELOAD_TIME);
+ local *FH;
+ open(FH, ">", $file)
+ || die "can't create logfile $file: $!";
+ print_full_log_file_template(\*FH, $reload);
+ print FH LOG_FILE_TAIL;
+ close(FH);
+}
+
+sub create_csv_file {
+ my $file = shift;
+ open(FH, ">", $file)
+ || die "can't create $file: $!";
+ close FH;
+}
+
+sub log_csv {
+ my $csv_log = shift;
+ my $sep = Irssi::settings_get_str(KEY_URL_LOG_CSV_SEPARATOR);
+ my $fields = join $sep, @_;
+ local *FH;
+ open(FH, ">>", $csv_log)
+ || die "can't open $csv_log: $!";
+ print FH "$fields\n";
+ close FH;
+}
+
+sub position_log_file {
+ my $file = shift;
+ my ($fh, $pos, $buf, @lines, $off, $got_it);
+ local *FH;
+ my $hint = "Conside manual removal of this file";
+ sysopen(FH, $file, O_RDWR)
+ || die "can't open $file: $!";
+ $pos = sysseek(FH, 0, 2)
+ || die "can't seek to EOF in $file. ${hint}: $!";
+ $pos -= BACKWARD_SEEK_BYTES;
+ sysseek(FH, $pos, 0)
+ || die "can't seek backwards to $pos in $file. ${hint}: $!";
+ sysread(FH, $buf, 2048)
+ || die "can't read rest of $file. ${hint}: $!";
+ $off = 0;
+ @lines = split /\n/, $buf;
+ for (@lines) {
+ $off += length;
+ $off += 1;
+ chomp;
+ next if /^$/;
+ if (/@{[ LOG_FILE_MARKER ]}/io) {
+ $got_it = 1;
+ $off -= length;
+ $off -= 1;
+ last;
+ }
+ }
+ die "Can't locate @{[ LOG_FILE_MARKER ]} in $file. ${hint}"
+ unless $got_it;
+ $pos += $off;
+ sysseek(FH, $pos, 0)
+ || die "Can't seek to $pos in $file. ${hint}: $!";
+ # Can't pass back localized typeglob reference
+ $fh = *FH;
+ return $fh;
+}
+
+sub log_url {
+ my ($nick, $channel, $url) = @_;
+ my $log_base = Irssi::settings_get_str(KEY_URL_LOG_BASEDIR)
+ || die "missing setting for @{[ KEY_URL_LOG_BASEDIR ]}";
+ my $fullfile = Irssi::settings_get_str(KEY_URL_LOG_FILE_NAME)
+ || die "missing setting for @{[ KEY_URL_LOG_FILE_NAME ]}";
+ my $csvfile = Irssi::settings_get_str(KEY_URL_LOG_CSV_FILE_NAME)
+ || die "missing setting for @{[ KEY_URL_LOG_CSV_FILE_NAME ]}";
+ my $csv_max = Irssi::settings_get_int(KEY_URL_LOG_CSV_FILE_MAX_SIZE);
+ my $csv_logging = Irssi::settings_get_bool(KEY_URL_CSV_LOGGING);
+ my $csv_chan_logging = Irssi::settings_get_bool(KEY_URL_CSV_CHAN_LOGGING);
+ my $time_fmt = Irssi::settings_get_str(KEY_URL_TIME_FORMAT)
+ || die "missing setting for @{[ KEY_URL_TIME_FORMAT ]}";
+ my $max = Irssi::settings_get_int(KEY_URL_LOG_FILE_MAX_SIZE);
+ my $chan_prefix = Irssi::settings_get_str(KEY_URL_CHAN_PREFIX)
+ || die "missing setting for @{[ KEY_URL_CHAN_PREFIX ]}";
+ my $chan_logging = Irssi::settings_get_bool(KEY_URL_CHAN_LOGGING);
+
+ my @curr_time = localtime(time());
+ $log_base .= '/' if $log_base !~ m#/$#;
+
+ die "directory $log_base doesn't exist or isn't readable"
+ unless -d $log_base and -r $log_base;
+
+ # Make channel filename
+ my $tmp = POSIX::strftime($chan_prefix, @curr_time);
+ my $chan_fname = lc $channel;
+ $chan_fname =~ s/^#/$tmp/;
+ my $chan_log = "${log_base}${chan_fname}.html";
+
+ # Make full filename
+ $tmp = POSIX::strftime($fullfile, @curr_time);
+ my $full_fname = $tmp;
+ my $full_log = $log_base . $tmp;
+
+ # Replace spaces in date string to show up as '&#160;' to prevent line
+ # breaks.
+ my $date = POSIX::strftime($time_fmt, @curr_time);
+ my $html_date = $date;
+ $html_date =~ s/ /\&#160;/g;
+
+ my $fh;
+
+ # Channel logging
+ if ($chan_logging) {
+ create_chan_template $full_fname, $chan_log, $channel
+ if not -r $chan_log or ($max > 0 and (stat($chan_log))[7] > $max);
+ $fh = undef;
+ $fh = position_log_file $chan_log;
+ print_chan_log_file_entry($fh, $html_date, $nick, $channel, $url);
+ close $fh;
+ }
+
+ # Full logging
+ create_full_template $full_log
+ if not -r $full_log or ($max > 0 and (stat($full_log))[7] > $max);
+ $fh = undef;
+ $fh = position_log_file $full_log;
+ print_full_log_file_entry($fh, $html_date, $nick, $channel,
+ "${chan_fname}.html", $url);
+ close $fh;
+
+ # CSV logging
+ if ($csv_logging) {
+ $tmp = POSIX::strftime($csvfile, @curr_time);
+ my $log = $log_base . $tmp;
+ create_csv_file $log
+ if not -r $log or ($csv_max > 0 and (stat($log))[7] > $max);
+ log_csv($log, $date, $nick, $channel, $url);
+ }
+
+ # CSV channel logging
+ if ($csv_chan_logging) {
+ my $log = "${log_base}${chan_fname}.csv";
+ create_csv_file $log
+ if not -r $log or ($csv_max > 0 and (stat($log))[7] > $max);
+ log_csv($log, $date, $nick, $channel, $url);
+ }
+}
+
+sub mk_home($) {
+ my $arg = shift;
+ return "$ENV{HOME}/$arg";
+}
+
+sub logging_permited {
+ my ($nick, $chan_or_nick) = @_;
+ my $default_policy = Irssi::settings_get_str(KEY_URL_POLICY_DEFAULT)
+ || die "missing setting for @{[ KEY_URL_POLICY_DEFAULT ]}";
+ my $chans = Irssi::settings_get_str(KEY_URL_POLICY_CHANS);
+ my $nicks = Irssi::settings_get_str(KEY_URL_POLICY_NICKS);
+ my @policy_chans = split /[,;: ]/, $chans;
+ my @policy_nicks = split /[,;: ]/, $nicks;
+ my $permit;
+
+ if ($default_policy eq 'deny') {
+ # logging must be explicitly permited
+ $permit = 0;
+ for (@policy_chans) {
+ return 1 if $_ eq $chan_or_nick;
+ }
+ for (@policy_nicks) {
+ return 1 if $_ eq $nick;
+ }
+ } elsif ($default_policy eq 'allow') {
+ # logging must be explicitly denied
+ $permit = 1;
+ for (@policy_chans) {
+ return 0 if $_ eq $chan_or_nick;
+ }
+ for (@policy_nicks) {
+ return 0 if $_ eq $nick;
+ }
+ } else {
+ p_error("setting @{[ KEY_URL_POLICY_DEFAULT ]} can be either " .
+ "'allow' or 'deny'");
+ return undef;
+ }
+ return $permit;
+}
+
+sub do_locked {
+ my $f = shift or die "missing function argument " . caller;
+ my $lockf;
+ eval { $lockf = aquire_lock };
+ if ($@) {
+ p_error("$@");
+ return;
+ }
+ eval { $f->(@_) };
+ p_error("$@") if $@;
+ eval { close $lockf };
+}
+
+sub do_with_caches {
+ my $f = shift or die "missing function argument " . caller;
+ my ($cache_a, $cache_h) = ();
+ eval { ($cache_a, $cache_h) = open_caches };
+ if ($@) {
+ p_error("$@");
+ eval { untie %$cache_h } if defined $cache_h;
+ eval { untie @$cache_a } if defined $cache_a;
+ return;
+ }
+ eval { $f->($cache_a, $cache_h, @_) };
+ p_error("$@") if $@;
+ eval { untie %$cache_h };
+ eval { untie @$cache_a };
+}
+
+sub url_msg_log {
+ my ($cache_a, $cache_h, $nick, $chan_or_nick, $url) = @_;
+ my ($cache_size, $tmp);
+ my $max_cache = Irssi::settings_get_int(KEY_URL_CACHE_MAX);
+
+ unless (exists $cache_h->{$url}) {
+ $cache_size = scalar(@$cache_a) + 1;
+ $cache_h->{$url} = '1';
+ # push the URL to the end of the file seems to work better on
+ # some systems in contrast to unshift.
+ push @$cache_a, $url;
+ if ($max_cache > 0 && $cache_size > $max_cache) {
+ $tmp = shift @$cache_a;
+ delete $cache_h->{$tmp};
+ }
+ log_url($nick, $chan_or_nick, $url);
+ }
+}
+
+sub url_topic {
+ my ($server, $channel, $topic, $nick, $hostmask) = @_;
+ url_message($server, $topic, $nick, $hostmask, $channel);
+}
+
+sub url_message {
+ my ($server, $rawtext, $nick, $hostmask, $channel) = @_;
+ my ($url, $permit, $chan_or_nick);
+
+ if (defined($url = scan_url($rawtext))) {
+ $chan_or_nick = defined $channel ? $channel : $server->{nick};
+ if (defined($permit = logging_permited($nick, $chan_or_nick)) && $permit) {
+ do_locked(\&do_with_caches, \&url_msg_log, $nick, $chan_or_nick, $url);
+ }
+ }
+}
+
+sub url_cmd_show {
+ my ($cache_a, $cache_h) = @_;
+ my $n = 0;
+ p_normal("urlplot: total of " . scalar(@$cache_a) . " URLs");
+ foreach my $url (@$cache_a) {
+ p_normal(sprintf("%02d - %s", $n++, $url));
+ }
+}
+
+sub url_cmd_clearcaches {
+ my ($cache_a, $cache_h) = @_;
+ @$cache_a = ();
+ %$cache_h = ();
+}
+
+sub url_cmd_real_navigate {
+ my ($url) = @_;
+ die 'no URLs captured so far' unless $url;
+ my $url_cmd = Irssi::settings_get_str(KEY_URL_COMMAND)
+ || die "missing setting for @{[ KEY_URL_COMMAND ]}";
+ unless ($url_cmd =~ s/__URL__/$url/g) {
+ die "setting url_cmd doesn't contain an URL placeholder '__URL__'";
+ }
+ system($url_cmd);
+}
+
+sub url_cmd_navigate {
+ my ($cache_a, $cache_h, $n) = @_;
+ my ($len, $url) = scalar @$cache_a;
+ unless (defined $n) {
+ $n = $len > 0 ? $len - 1 : $len;
+ }
+ die "no such URL; I've only $len" unless $n < $len;
+ $url = $cache_a->[$n];
+ die 'no URLs captured so far' unless $url;
+ url_cmd_real_navigate $url;
+}
+
+sub url_command {
+ my ($data, $server, $witem) = @_;
+ $_ = $data;
+ if (/^-list/) {
+ do_locked(\&do_with_caches, \&url_cmd_show);
+ } elsif (/^-clearcache/) {
+ do_locked(\&do_with_caches, \&url_cmd_clearcaches);
+ } elsif (/^-showlog/) {
+ my $nav_url = Irssi::settings_get_str(KEY_URL_NAVIGATE)
+ || die "missing setting for @{[ KEY_URL_NAVIGATE ]}";
+ url_cmd_real_navigate $nav_url;
+ } else {
+ my $n;
+ if (/^(\d+)/) {
+ $n = $1;
+ if ($n < 0) {
+ p_error("argument must be a positive integer");
+ return;
+ }
+ } elsif (/^$/) {
+ $n = undef;
+ } else {
+ p_error("usage for /url [-list|-showlog|-clearcache|<digit>]");
+ return;
+ }
+ do_locked(\&do_with_caches, \&url_cmd_navigate, $n);
+ }
+}
+
+Irssi::signal_add_last('message public', 'url_message');
+Irssi::signal_add_last('message private', 'url_message');
+Irssi::signal_add_last('message topic', 'url_topic');
+Irssi::command_bind('url', 'url_command');
+
+Irssi::settings_add_str('misc', KEY_URL_COMMAND, DEF_URL_COMMAND);
+Irssi::settings_add_int('misc', KEY_URL_CACHE_MAX, DEF_URL_CACHE_MAX);
+Irssi::settings_add_str('misc', KEY_URL_LOG_BASEDIR, mk_home(DEF_URL_LOG_BASEDIR));
+Irssi::settings_add_str('misc', KEY_URL_LOG_FILE_NAME, DEF_URL_LOG_FILE_NAME);
+Irssi::settings_add_str('misc', KEY_URL_CHAN_PREFIX, DEF_URL_CHAN_PREFIX);
+Irssi::settings_add_bool('misc', KEY_URL_CHAN_LOGGING, DEF_URL_CHAN_LOGGING);
+Irssi::settings_add_str('misc', KEY_URL_LOG_CSV_FILE_NAME, DEF_URL_LOG_CSV_FILE_NAME);
+Irssi::settings_add_int('misc', KEY_URL_LOG_CSV_FILE_MAX_SIZE, DEF_URL_LOG_CSV_FILE_MAX_SIZE);
+Irssi::settings_add_str('misc', KEY_URL_LOG_CSV_SEPARATOR, DEF_URL_LOG_CSV_SEPARATOR);
+Irssi::settings_add_bool('misc', KEY_URL_CSV_LOGGING, DEF_URL_CSV_LOGGING);
+Irssi::settings_add_bool('misc', KEY_URL_CSV_CHAN_LOGGING, DEF_URL_CSV_CHAN_LOGGING);
+Irssi::settings_add_str('misc', KEY_URL_TIME_FORMAT, DEF_URL_TIME_FORMAT);
+Irssi::settings_add_int('misc', KEY_URL_LOG_FILE_MAX_SIZE, DEF_URL_LOG_FILE_MAX_SIZE);
+Irssi::settings_add_int('misc', KEY_URL_LOG_FILE_AUTORELOAD_TIME,
+ DEF_URL_LOG_FILE_AUTORELOAD_TIME);
+Irssi::settings_add_str('misc', KEY_URL_DB_BASEDIR, mk_home(DEF_URL_DB_BASEDIR));
+Irssi::settings_add_str('misc', KEY_URL_DB_CACHE_A_FILENAME, DEF_URL_DB_CACHE_A_FILENAME);
+Irssi::settings_add_str('misc', KEY_URL_DB_CACHE_H_FILENAME, DEF_URL_DB_CACHE_H_FILENAME);
+Irssi::settings_add_str('misc', KEY_URL_DB_LOCK_FILENAME, DEF_URL_DB_LOCK_FILENAME);
+
+Irssi::settings_add_str('misc', KEY_URL_POLICY_DEFAULT, DEF_URL_POLICY_DEFAULT);
+Irssi::settings_add_str('misc', KEY_URL_POLICY_CHANS, DEF_URL_POLICY_CHANS);
+Irssi::settings_add_str('misc', KEY_URL_POLICY_NICKS, DEF_URL_POLICY_NICKS);
+Irssi::settings_add_str('misc', KEY_URL_NAVIGATE, 'file://' . mk_home(DEF_URL_NAVIGATE));
+
+#
+# $Log$
+#
diff --git a/scripts/urlwindow.pl b/scripts/urlwindow.pl
new file mode 100644
index 0000000..4016285
--- /dev/null
+++ b/scripts/urlwindow.pl
@@ -0,0 +1,47 @@
+#
+# Logs all urls from #channels and /msgs in a separate window called "urls"
+#
+
+use Irssi;
+use POSIX;
+use vars qw($VERSION %IRSSI);
+use strict;
+
+$VERSION = "1.4";
+%IRSSI = (
+ authors => "zdleaf",
+ contact => 'zdleaf@zinc.london',
+ name => "urlwindow",
+ description => "Log all urls from #channels and /msgs in a separate window",
+ license => "Public Domain",
+);
+
+sub sig_printtext {
+ my ($dest, $text, $stripped) = @_;
+
+ if((($dest->{level} & (MSGLEVEL_PUBLIC)) || ($dest->{level} & (MSGLEVEL_MSGS)))
+ && ($text =~
+ qr#((?:(https?|gopher|ftp)://[^\s<>"]+|www\.[-a-z0-9.]+)[^\s.,;<">\):])# ))
+ {
+ my $window = Irssi::window_find_name('urls');
+
+ if ($dest->{level} & MSGLEVEL_PUBLIC) {
+ $text = $dest->{target}.": ".$text;
+ }
+
+ $text = strftime(
+ Irssi::settings_get_str('timestamp_format')." ",
+ localtime
+ ).$text;
+ $window->print($text, MSGLEVEL_NEVER) if ($window);
+ }
+}
+
+my $window = Irssi::window_find_name('urls');
+
+if (!$window) {
+ $window = Irssi::Windowitem::window_create('urls', 1);
+ $window->set_name('urls');
+}
+
+Irssi::signal_add('print text', 'sig_printtext');
diff --git a/scripts/userhost.pl b/scripts/userhost.pl
new file mode 100644
index 0000000..339b309
--- /dev/null
+++ b/scripts/userhost.pl
@@ -0,0 +1,103 @@
+# $Id: userhost.pl,v 1.18 2002/07/04 13:18:02 jylefort Exp $
+use strict;
+use Irssi 20020121.2020 ();
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.23";
+%IRSSI = (
+ authors => 'Jean-Yves Lefort',
+ contact => 'jylefort\@brutele.be, decadix on IRCNet',
+ name => 'userhost',
+ description => 'Adds a -cmd option to the /USERHOST builtin command',
+ license => 'BSD',
+ url => 'http://void.adminz.be/irssi.shtml',
+ changed => '$Date: 2002/07/04 13:18:02 $ ',
+);
+
+# usage:
+#
+# /USERHOST <nicks> [-cmd <command>]
+#
+# -cmd evaluate the specified Irssi command
+#
+# percent substitutions in command:
+#
+# %n nick
+# %u user
+# %h host
+# %% a single percent sign
+#
+# examples:
+#
+# /userhost albert -cmd echo %n is %u at %h
+# /userhost john james -cmd exec xterm -e ping %h
+#
+# changes:
+#
+# 2002-07-04 release 0.23
+# * signal_add's uses a reference instead of a string
+#
+# 2002-02-08 release 0.22
+# * safer percent substitutions
+#
+# 2002-01-27 release 0.21
+# * uses builtin expand
+#
+# 2002-01-24 release 0.20
+# * now replaces builtin /USERHOST
+#
+# 2002-01-23 initial release
+
+# -verbatim- import expand
+sub expand {
+ my ($string, %format) = @_;
+ my ($len, $attn, $repl) = (length $string, 0);
+
+ $format{'%'} = '%';
+
+ for (my $i = 0; $i < $len; $i++) {
+ my $char = substr $string, $i, 1;
+ if ($attn) {
+ $attn = undef;
+ if (exists($format{$char})) {
+ $repl .= $format{$char};
+ } else {
+ $repl .= '%' . $char;
+ }
+ } elsif ($char eq '%') {
+ $attn = 1;
+ } else {
+ $repl .= $char;
+ }
+ }
+
+ return $repl;
+}
+# -verbatim- end
+
+my $queuedcmd;
+
+sub userhost_reply {
+ if ($queuedcmd) {
+ my ($server, $args, $sender, $sender_address) = @_;
+ if ($args =~ / :(.*)$/) {
+ foreach (split(/ /, $1)) {
+ $server->command(expand($queuedcmd, "n", $1, "u", $2, "h", $3))
+ if (/(.*)\*?=[-+][-+~]?(.*)@(.*)/);
+ }
+ }
+ $queuedcmd = undef;
+ Irssi::signal_stop();
+ }
+}
+
+sub userhost {
+ my ($args, $server, $item) = @_;
+ my ($nicks, $command) = split(/ -cmd /, $args);
+ if ($queuedcmd = $command) {
+ $server->send_raw("USERHOST :$nicks");
+ Irssi::signal_stop();
+ }
+}
+
+Irssi::signal_add("event 302", \&userhost_reply);
+Irssi::command_bind("userhost", \&userhost);
diff --git a/scripts/users.pl b/scripts/users.pl
new file mode 100644
index 0000000..32bd175
--- /dev/null
+++ b/scripts/users.pl
@@ -0,0 +1,270 @@
+# $Id: users.pl,v 1.22 2003/01/11 14:54:35 jylefort Exp $
+
+use strict;
+use Irssi 20020121.2020 ();
+use vars qw($VERSION %IRSSI);
+$VERSION = "2.3";
+%IRSSI = (
+ authors => 'Jean-Yves Lefort',
+ contact => 'jylefort\@brutele.be, decadix on IRCnet',
+ name => 'users',
+ description => 'Implements /USERS',
+ license => 'BSD',
+ changed => '$Date: 2003/01/11 14:54:35 $ ',
+);
+
+# usage:
+#
+# /USERS [<orderstring>]
+#
+# <orderstring> is an optional string
+# whose format is described below.
+#
+# /set's:
+#
+# users_sort_order
+#
+# A sort order string which will be used to complete
+# the order string given as a parameter to /USERS.
+#
+# Example: /set users_sort_order mnha
+#
+# Command Resulting order
+#
+# /USERS mnha
+# /USERS an anmh
+#
+# sort order string format:
+#
+# An order string must be composed by one or more characters from
+# the following set:
+#
+# m server and channel mode
+# n nickname
+# h user@hostname
+# a away state
+#
+# /format's:
+#
+# users list header
+# $0 channel name
+#
+# users_nick nick
+# $0 * if IRC operator
+# $1 @ if channel operator
+# $2 % if half channel operator
+# $3 + if voiced
+# $4 a if marked away
+# $5 nickname
+# $6 user@hostname
+#
+# endofusers end of list
+# $0 channel name
+# $1 number of nicks
+# $2 number of IRC operators
+# $3 number of channel operators
+# $4 number of half channel operators
+# $5 number of voiced
+# $6 number of marked away
+#
+# changes:
+#
+# 2003-01-11 release 2.3
+# * nick count was wrong
+#
+# 2003-01-09 release 2.2
+# * command char independed
+#
+# 2003-01-09 release 2.1
+# * minor oblivion fix
+#
+# 2003-01-09 release 2.0
+# * /USERS accepts a sort order argument
+# * added /set users_sort_order
+# * shows away state
+#
+# 2002-07-04 release 1.01
+# * command_bind uses a reference instead of a string
+#
+# 2002-04-25 release 1.00
+# * uses '*' instead of 'S' for IRC operators
+#
+# 2002-04-12 release 0.13
+# * added support for ircops
+# * changed theme
+#
+# 2002-01-28 release 0.12
+# * added support for halfops
+#
+# 2002-01-28 release 0.11
+#
+# 2002-01-23 initial release
+
+### sort algorithms table #####################################################
+
+my %cmp = (
+ m => sub { get_mode_weight($_[1]) cmp get_mode_weight($_[0]) },
+ n => sub { lc $_[0]->{nick} cmp lc $_[1]->{nick} },
+ h => sub { lc $_[0]->{host} cmp lc $_[1]->{host} },
+ a => sub { $_[1]->{gone} cmp $_[0]->{gone} }
+ );
+
+### support functions #########################################################
+
+sub get_mode_weight
+{
+ my ($nick) = @_;
+
+ return ($nick->{serverop} * 4) + ($nick->{op} * 3) + ($nick->{halfop} * 2) + $nick->{voice};
+}
+
+sub nick_cmp
+{
+ my ($this, $that, @order) = @_;
+ my $sort;
+
+ foreach (@order)
+ {
+ $sort = &{$cmp{$_}}($this, $that);
+
+ if ($sort)
+ {
+ return $sort;
+ }
+ }
+
+ return $sort;
+}
+
+sub validate_order
+{
+ my @order = @_;
+
+ foreach (@order)
+ {
+ if (! exists($cmp{$_}))
+ {
+ return "unknown character '$_'";
+ }
+ }
+
+ return undef;
+}
+
+sub get_order
+{
+ my ($string) = @_;
+ my @order;
+ my @default;
+ my $error;
+ my %has;
+
+ @order = split(//, $string);
+ @default = split(//, Irssi::settings_get_str("users_sort_order"));
+
+ $error = validate_order(@default);
+ if (defined $error)
+ {
+ return "unable to validate users_sort_order: $error";
+ }
+
+ $error = validate_order(@order);
+ if (defined $error)
+ {
+ return "unable to validate given order: $error";
+ }
+
+ foreach (@order)
+ {
+ $has{$_} = 1;
+ }
+
+ foreach (@default)
+ {
+ if (! exists($has{$_}))
+ {
+ push(@order, $_);
+ }
+ }
+
+ return (undef, @order);
+}
+
+### /users ####################################################################
+
+sub users
+{
+ my ($args, $server, $item) = @_;
+
+ if ($item && $item->{type} eq "CHANNEL")
+ {
+ my $error;
+ my @order;
+ my $window;
+ my @nicks;
+
+ my $serverop_count = 0;
+ my $chanop_count = 0;
+ my $halfop_count = 0;
+ my $voice_count = 0;
+ my $away_count = 0;
+
+ ($error, @order) = get_order($args);
+
+ if (defined $error)
+ {
+ Irssi::print("Unable to compute sort order: $error", MSGLEVEL_CLIENTERROR);
+ return;
+ }
+
+ Irssi::command('WINDOW NEW HIDDEN');
+
+ $window = Irssi::active_win();
+ $window->set_name("U:$item->{name}");
+ $window->printformat(MSGLEVEL_CRAP, "users", $item->{name});
+
+ @nicks = $item->nicks();
+ @nicks = sort { nick_cmp($a, $b, @order) } @nicks;
+
+ foreach (@nicks)
+ {
+ my $serverop;
+ my $chanop;
+ my $halfop;
+ my $voice;
+ my $away;
+
+ $serverop = $_->{serverop} ? '*' : '.';
+ $chanop = $_->{op} ? '@' : '.';
+ $halfop = $_->{halfop} ? '%' : '.';
+ $voice = $_->{voice} ? '+' : '.';
+ $away = $_->{gone} ? 'a' : '.';
+
+ $serverop_count++ if ($_->{serverop});
+ $chanop_count++ if ($_->{op});
+ $halfop_count++ if ($_->{halfop});
+ $voice_count++ if ($_->{voice});
+ $away_count++ if ($_->{gone});
+
+ $window->printformat(MSGLEVEL_CRAP, "users_nick",
+ $serverop, $chanop, $halfop, $voice, $away,
+ $_->{nick}, $_->{host});
+ }
+
+ $window->printformat(MSGLEVEL_CRAP, "endofusers", $item->{name},
+ scalar @nicks, $serverop_count, $chanop_count,
+ $halfop_count, $voice_count, $away_count);
+ }
+}
+
+### initialization ############################################################
+
+Irssi::theme_register([
+ "users", '{names_users Users {names_channel $0}}',
+ "users_nick", '{hilight $0$1$3$4} $[9]5 $[50]6',
+ "endofusers", '{channel $0}: Total of {hilight $1} nicks, {hilight $2} IRC operators, {hilight $3} channel operators, {hilight $5} voiced, {hilight $6} marked away',
+ ]);
+
+Irssi::settings_add_str("misc", "users_sort_order", "mnha");
+
+Irssi::command_bind("users", \&users);
diff --git a/scripts/version-stat.pl b/scripts/version-stat.pl
new file mode 100644
index 0000000..6894ab4
--- /dev/null
+++ b/scripts/version-stat.pl
@@ -0,0 +1,88 @@
+#!/usr/bin/perl -w
+# shows top[0-9]+ irc client versions in a channel
+# by c0ffee
+# - http://www.penguin-breeder.org/?page=irssi
+
+#<scriptinfo>
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi 20020120;
+$VERSION = "0.1";
+%IRSSI = (
+ authors => "c0ffee",
+ contact => "c0ffee\@penguin-breeder.org",
+ name => "version-stats",
+ description => "shows top[0-9]+ irc client versions in a channel",
+ license => "Public Domain",
+ url => "http://www.penguin-breeder.org/?page=irssi",
+ changed => "Sun Apr 14 17:30 GMT 2002",
+);
+#</scriptinfo>
+
+my %versions;
+my $tag;
+my $running = 0;
+
+sub version_reply {
+ my ($server, $data, $nick, $addr, $target) = @_;
+
+ $versions{$data} = 1 + $versions{$data} if $running;
+
+ if (not Irssi::settings_get_bool('mute_version_reply') or not $running) {
+
+
+ Irssi::signal_emit("default ctcp reply", $server, "VERSION $data", $nick, $addr, $target);
+
+ }
+
+
+}
+
+sub show_stats {
+
+ my ($data) = @_;
+ my @stats = map "$versions{$_},$_", sort { $versions{$b} <=> $versions{$a} } keys %versions;
+ my ($top,$best,$cnt,$v,$foo,$bar);
+ $running = 0;
+
+ ($top,$best) = $data =~ /(.*)\/(.*)/;
+
+ Irssi::print("VERSION stats:");
+
+ Irssi::timeout_remove($tag);
+
+ foreach (1..$top) {
+ last if not defined $stats[$_ - 1];
+ ($cnt,$v) = $stats[$_ - 1] =~ /(.*?),(.*)/;
+ $bar = $cnt * 20 / $best;
+ $foo = "|" x $bar . "." x (20 - $bar),
+ Irssi::print("$_. [$foo]: ($cnt) $v");
+ }
+
+}
+
+sub cmd_vstat {
+ my ($data, $server, $channel) = @_;
+ my ($period, $top,@nicks,$num);
+
+ Irssi::print("usage: /vstat period-in-secs top-n"), return
+ if not (($period, $top) = $data =~ /(\d+)\s+(\d+)/);
+
+ @nicks = $channel->nicks();
+
+ $num = @nicks;
+
+ $tag = Irssi::timeout_add($period * 1000, 'show_stats', "$top/$num");
+
+ undef %versions;
+ $running = 1;
+
+ $server->send_raw("PRIVMSG $channel->{name} :\001VERSION\001");
+ Irssi::print("Starting version collection in $channel->{name}");
+
+}
+
+Irssi::signal_add_last('ctcp reply version', 'version_reply');
+Irssi::command_bind('vstat', 'cmd_vstat');
+Irssi::settings_add_bool('misc', 'mute_version_reply', 1);
diff --git a/scripts/verstats.pl b/scripts/verstats.pl
new file mode 100644
index 0000000..c40195c
--- /dev/null
+++ b/scripts/verstats.pl
@@ -0,0 +1,81 @@
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "20030208";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "VerStats",
+ description => "Draws a diagram of the used clients in a channel",
+ license => "GPLv2",
+ url => "http://scripts.irssi.org",
+ changed => "$VERSION",
+ commands => "verstats"
+);
+
+
+use Irssi;
+
+use vars qw(%clients $timeout);
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+
+sub sig_ctcp_reply_version ($$$$$) {
+ my ($server, $args, $nick, $addr, $target) = @_;
+ return unless $timeout;
+ Irssi::timeout_remove($timeout);
+ if ($args =~ /^(.*?)( |\/|$)/) {
+ my $client = lc($1);
+ $client =~ s/^[^\w]//;
+ $client =~ s/%.//g;
+ #$clients{$client} = 0 unless defined $clients{$client};
+ push @{$clients{$client}}, $nick;
+ }
+ $timeout = Irssi::timeout_add(5000, \&finished, undef);
+}
+
+sub finished {
+ my $max=0;
+ foreach (keys %clients) {
+ $max = @{$clients{$_}} if $max < @{$clients{$_}};
+ }
+ return if $max == 0;
+ my $width = 60;
+ my $block = $width/$max;
+ my $text;
+ foreach (sort {@{$clients{$b}} <=> @{$clients{$a}}} keys %clients) {
+ s/%/%%/g;
+ $text .= "'".$_."'".': '.@{$clients{$_}}."\n";
+ my $bar = '#'x(($block * @{$clients{$_}})-1);
+ $text .= $bar.">\n";
+ #$text .= $_.' ' foreach (@{$clients{$_}});
+ #$text .= "\n";
+ }
+ %clients = ();
+ print CLIENTCRAP draw_box('VerStats', $text, 'stats', 1);
+ Irssi::timeout_remove($timeout);
+ $timeout = undef;
+}
+
+sub cmd_verstats ($$$) {
+ my ($args, $server, $witem) = @_;
+ return unless ($server && ref $witem && $witem->{type} eq 'CHANNEL');
+ $witem->command('ctcp '.$witem->{name}.' version');
+ $timeout = Irssi::timeout_add(5000, \&finished, undef)
+}
+
+Irssi::signal_add('ctcp reply version' => \&sig_ctcp_reply_version);
+Irssi::command_bind('verstats' => \&cmd_verstats);
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded';
diff --git a/scripts/vowels.pl b/scripts/vowels.pl
new file mode 100644
index 0000000..eae47d7
--- /dev/null
+++ b/scripts/vowels.pl
@@ -0,0 +1,93 @@
+#!/usr/bin/perl -w
+
+# /VSAY <text>
+# - same as /say, but removes vowels from text
+#
+# /VME <text>
+# - same as /me, but removes vowels from text
+#
+# /VTOPIC <text>
+# - same as /topic, but removes vowels from text :)
+
+# Written by Jakub Jankowski <shasta@atn.pl>
+# for Irssi 0.7.98.4+
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = "1.0";
+%IRSSI = (
+ authors => 'Jakub Jankowski',
+ contact => 'shasta@atn.pl',
+ name => 'vowels',
+ description => 'Silly script, removes vowels, idea taken from #linuxnews ;-)',
+ license => 'GNU GPLv2 or later',
+ url => 'http://irssi.atn.pl/',
+);
+
+use Irssi;
+use Irssi::Irc;
+
+# str remove_vowels($string)
+# returns random-coloured string
+sub remove_vowels {
+ my ($string) = @_;
+ $string =~ s/[eyuioa]//gi;
+ return $string;
+}
+
+# void rsay($text, $server, $destination)
+# handles /rsay
+sub rsay {
+ my ($text, $server, $dest) = @_;
+
+ if (!$server || !$server->{connected}) {
+ Irssi::print("Not connected to server");
+ return;
+ }
+
+ return unless $dest;
+ if ($dest->{type} eq "CHANNEL" || $dest->{type} eq "QUERY") {
+ $dest->command("/msg " . $dest->{name} . " " . remove_vowels($text));
+ }
+}
+
+# void rme($text, $server, $destination)
+# handles /rme
+sub rme {
+ my ($text, $server, $dest) = @_;
+
+ if (!$server || !$server->{connected}) {
+ Irssi::print("Not connected to server");
+ return;
+ }
+
+ return unless $dest;
+ if ($dest->{type} eq "CHANNEL" || $dest->{type} eq "QUERY") {
+ $dest->command("/me " . remove_vowels($text));
+ }
+}
+
+# void rtopic($text, $server, $destination)
+# handles /rtopic
+sub rtopic {
+ my ($text, $server, $dest) = @_;
+
+ if (!$server || !$server->{connected}) {
+ Irssi::print("Not connected to server");
+ return;
+ }
+
+ return unless $dest;
+ if ($dest->{type} eq "CHANNEL") {
+ $dest->command("/topic " . remove_vowels($text));
+ }
+}
+
+Irssi::command_bind("vsay", "rsay");
+Irssi::command_bind("vtopic", "rtopic");
+Irssi::command_bind("vme", "rme");
+
+# changes:
+#
+# 07.02.2002: Initial release (v1.0)
diff --git a/scripts/warnkick.pl b/scripts/warnkick.pl
new file mode 100644
index 0000000..f50204f
--- /dev/null
+++ b/scripts/warnkick.pl
@@ -0,0 +1,71 @@
+# warnkick.pl v0.0.2 by Svante Kvarnstrom <svarre@undernet.org>
+#
+# This script will warn you if you get kicked out of a channel which
+# isn't your current "active" channel, and also hilight the refnum
+# to the channel you got kicked from, eg.:
+#
+# [03:42.50] >> zaei (~zaei@zaei.users.undernet.org) kicked you
+# from #gentoo: GRUB GRUB GRUB GRUB GRUB GRUB GRUB GRUB GRUB
+#
+# This program is free software, you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PERTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# ----------------------------------------------------------------------
+
+use Irssi qw(printformat signal_add theme_register);
+use Irssi::Irc;
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+# ----------------------------------------------------------------------
+
+$VERSION = "0.0.3";
+%IRSSI = (
+ authors => 'Svante Kvarnström',
+# contact => 'svarre@undernet.org',
+ contact => 'sjk@ankeborg.nu',
+ name => 'warnkick',
+ description => 'warns you if someone kicks you out of a channel',
+ license => 'GPL',
+ url => 'http://ankeborg.nu',
+ changed => 'Tue Sep 28 03:51 CEST 2004',
+);
+
+# ----------------------------------------------------------------------
+
+sub event_kick {
+ my ($server, $chan, $nick, $knick, $address, $reason) = @_;
+ my $win = Irssi::active_win();
+ my $kchan = $server->window_find_item($chan);
+
+ return if $win->{refnum} == $kchan->{refnum} || $server->{nick} ne $nick;
+
+ Irssi::active_win()->printformat(MSGLEVEL_CLIENTCRAP, 'warnkick', $knick, $address, $chan, $reason);
+ $kchan->activity(4);
+}
+
+# ----------------------------------------------------------------------
+
+theme_register([
+ 'warnkick_loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.',
+ 'warnkick', '%R>>%n $0 ($1) kicked you from $2: $3'
+]);
+
+# ----------------------------------------------------------------------
+
+signal_add("message kick", "event_kick");
+
+printformat(MSGLEVEL_CLIENTCRAP, 'warnkick_loaded', $IRSSI{name}, $VERSION, $IRSSI{authors});
+
diff --git a/scripts/washnicks.pl b/scripts/washnicks.pl
new file mode 100644
index 0000000..09d1bcd
--- /dev/null
+++ b/scripts/washnicks.pl
@@ -0,0 +1,79 @@
+# washnicks.pl
+#
+# Removes annoying characters from nicks
+#
+# TODO:
+# - Don't use the function if only the first letter is upper case
+#
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+
+$VERSION = '1.02';
+%IRSSI = (
+ authors => 'ulbkold',
+ contact => 'solaris@sundevil.de',
+ name => 'washnicks',
+ description => 'Removes annoying characters from nicks',
+ license => 'GPL',
+ url => 'n/a',
+ changed => '2018-04-04',
+);
+
+# Channel list
+my @channels;
+
+#main event handler
+sub wash_nick {
+ my ($server, $data, $nick, $address, $target) = @_;
+ my ($channel, $msg) = split(/ :/, $data,2);
+ my $oldnick=$nick;
+
+ # if the current channel is in the list...
+ for (@channels) {
+ if ($_ eq $channel) {
+ # ... check the nick
+ # if the nick contains one of these characters or upper case letters
+ # enter the changing function
+ if ( $nick =~/[A-Z]|\||\\|\]|\[|\^|-|\`|3|0|1|4|_/ ) {
+ $nick =~ s/\|//;
+ $nick =~ s/\\//;
+ $nick =~ s/\]//;
+ $nick =~ s/\[//;
+ $nick =~ s/\^//;
+ $nick =~ s/-//;
+ $nick =~ s/_//;
+ $nick =~ s/\`//;
+ $nick =~ s/3/e/;
+ $nick =~ s/0/O/;
+ $nick =~ s/1/i/;
+ $nick =~ s/4/a/;
+ $nick = lc($nick);
+
+ # fail safe
+ if ($oldnick ne $nick) {
+ # emit signal
+ Irssi::signal_emit("event privmsg", $server, $data,
+ $nick, $address, $target);
+
+ #and stop
+ Irssi::signal_stop();
+ }
+ }
+ }
+ }
+
+}
+
+Irssi::settings_add_str('washnicks', 'washnicks_channels', '#fof');
+
+sub update_config {
+ @channels=split(/ /,Irssi::settings_get_str('washnicks_channels'));
+}
+
+update_config();
+
+Irssi::signal_add('setup changed', 'update_config');
+Irssi::signal_add('event privmsg', 'wash_nick');
diff --git a/scripts/watch.pl b/scripts/watch.pl
new file mode 100644
index 0000000..e0a297a
--- /dev/null
+++ b/scripts/watch.pl
@@ -0,0 +1,179 @@
+# Watch script para irssi
+
+# watch script consiste en un pequeño script que interpreta
+# este novedoso sistema de notify que nos evita la tarea de
+# tener que comprobar cada X tiempo si alguien de nuestro notify
+# esta en el irc, este script solamente podra ser usado en redes
+# que lo permitan, como por ejemplo irc-hispano.
+
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = '1.0';
+%IRSSI = (
+ authors => 'ThEbUtChE',
+ contact => 'thebutche@interec.org',
+ name => 'Watch script',
+ description => 'Uso del comando watch para irssi.',
+ license => 'BSD',
+ url => 'http://www.nebulosa.org',
+ changed => 'viernes, 17 de enero de 2003, 03:19:15 CET',
+ bugs => 'ninguno'
+);
+
+use Irssi;
+use Irssi::Irc;
+use POSIX qw(floor);
+
+
+
+sub watch_list
+{
+ my($file) = Irssi::get_irssi_dir."/watch";
+ my($nick);
+ local(*FILE);
+
+ open FILE, "<", $file;
+ while (<FILE>) {
+ my @nick = split;
+ Irssi::print "Notify \002@nick[0]\002";
+ }
+ close FILE;
+}
+
+sub esta_notify
+{
+ my ($ni) = @_;
+
+ my($file) = Irssi::get_irssi_dir."/watch";
+ my($nick);
+ local(*FILE);
+ open FILE, "<", $file;
+ while (<FILE>) {
+ my @nick = split;
+ if (@nick[0] eq $ni) { return 1; }
+ }
+ close FILE;
+ return 0;
+}
+
+sub watch_add
+{
+ my ($nick) = @_;
+ my($file) = Irssi::get_irssi_dir."/watch";
+ local(*FILE);
+ if ($nick eq "") { Irssi::print "Debes decir un nick a incluir en la lista."; return;
+ } elsif (esta_notify($nick)) { Irssi::print "El nick ya esta en el notify."; return; }
+
+ open FILE, ">>", $file;
+ print FILE join("\t","$nick\n");
+ close FILE;
+ Irssi::print "El nick $nick ha sido metido en el notify";
+ Irssi::active_win()->command("quote watch +$nick");
+
+}
+
+sub watch_del
+{
+ my ($ni) = @_;
+ my($file) = Irssi::get_irssi_dir."/watch";
+ my($file2) = Irssi::get_irssi_dir."/watch2";
+ local(*FILE);
+ local(*FILE2);
+ if ($ni eq "") { Irssi::print "Debes decir un nick a borrar de la lista."; return;
+ } elsif (!esta_notify($ni)) { Irssi::print "El nick no esta en el notify."; return; }
+
+ open FILE2, ">", $file2;
+ print FILE2 "";
+ close FILE2;
+
+ open FILE, "<", $file;
+ open FILE2, ">>", $file2;
+ while (<FILE>) {
+ my @nick = split;
+ if (@nick[0] eq $ni) {
+ } else {
+ print FILE2 join("\t","@nick[0]\n");
+ }
+ }
+ close FILE;
+ close FILE2;
+
+ open FILE, ">", $file;
+ print FILE "";
+ close FILE;
+
+ open FILE, ">>", $file;
+ open FILE2, "<", $file2;
+ while (<FILE2>) {
+ my @nick = split;
+ print FILE join("\t","@nick[0]\n");
+ }
+ close FILE;
+ close FILE2;
+
+ Irssi::active_win()->command("quote watch -$ni");
+ Irssi::print "Usuario \002$ni\002 Borrado de la lista de notify";
+
+}
+
+sub watch_list_online
+{
+ Irssi::active_win()->command("quote watch l");
+}
+
+sub watch
+{
+ my ($arg) = @_;
+ my ($cmd, $nick) = split(/ /, $arg);
+ if ($cmd eq "list") {
+ watch_list();
+ } elsif ($cmd eq "add") {
+ watch_add($nick);
+ } elsif ($cmd eq "del") {
+ watch_del($nick);
+ } else {
+ watch_list_online();
+ }
+}
+
+sub mete_lista
+{
+ my($file) = Irssi::get_irssi_dir."/watch";
+ my($nick);
+ local(*FILE);
+ my $ret;
+ open FILE, "<", $file;
+ while (<FILE>) {
+ my @nick = split;
+ $ret .= "+@nick[0],";
+ }
+ chop $ret;
+ Irssi::active_win()->command("quote watch $ret");
+ close FILE;
+}
+
+sub event_is_online
+{
+ my ($server, $data) = @_;
+ my ($me, $nick, $ident, $host) = split(/ /, $data);
+ Irssi::print "\002$nick\002 \0034[\003$ident\@$host\0034]\003 has joined to IRC";
+}
+
+sub event_is_offline
+{
+ my ($server, $data) = @_;
+ my ($me, $nick) = split(/ /, $data);
+ Irssi::print "\002$nick\002 has left IRC";
+}
+
+sub null
+{
+}
+
+Irssi::command_bind('watch', 'watch');
+Irssi::signal_add_last('event connected', 'mete_lista');
+Irssi::signal_add('event 604', 'event_is_online');
+Irssi::signal_add('event 605', 'null');
+Irssi::signal_add('event 601', 'event_is_offline');
+Irssi::signal_add('event 600', 'event_is_online');
+
diff --git a/scripts/whitelist.pl b/scripts/whitelist.pl
new file mode 100644
index 0000000..836eec9
--- /dev/null
+++ b/scripts/whitelist.pl
@@ -0,0 +1,445 @@
+##
+# /toggle whitelist_notify [default ON]
+# Print a message in the status window if someone not on the whitelist messages us
+#
+# /toggle whitelist_log_ignored_msgs [default ON]
+# if this is on, ignored messages will be logged to ~/.irssi/whitelist.log
+#
+# /set whitelist_nicks phyber etc
+# nicks that are allowed to msg us (whitelist checks for a valid nick before a valid host)
+#
+# /toggle whitelist_nicks_case_sensitive [default OFF]
+# do we care which case nicknames are in?
+#
+# Thanks to Geert for help/suggestions on this script
+#
+# Karl "Sique" Siegemund's addition:
+# Managing the whitelists with the /whitelist command:
+#
+# /whitelist add nick <list of nicks>
+# puts new nicks into the whitelist_nicks list
+#
+# /whitelist add host <list of hosts>
+# puts new hosts into the whitelist_hosts list
+#
+# /whitelist add chan[nel] <list of channels>
+# puts new channels into the whitelist_channels list
+#
+# /whitelist add net[work] <list of chatnets/servers>
+# puts new chatnets or irc servers into the whitelist_networks list
+#
+# /whitelist del nick <list of nicks>
+# removes the nicks from whitelist_nicks
+#
+# /whitelist del host <list of hosts>
+# removes the hosts from whitelist_hosts
+#
+# /whitelist del chan[nel] <list of channels>
+# removes the channels from whitelist_channels
+#
+# /whitelist del net[work] <list of chatnets/servers>
+# removes the chatnets or irc servers from whitelist_networks
+#
+# Instead of the 'del' modifier you can also use 'remove':
+# /whitelist remove [...]
+#
+# /whitelist nick
+# shows the current whitelist_nicks
+#
+# /whitelist host
+# shows the current whitelist_hosts
+#
+# /whitelist chan[nel]
+# shows the current whitelist_channels
+#
+# /whitelist net[work]
+# shows the current whitelist_networks
+#
+# Additional feature for nicks, channels and hosts:
+# You may use <nick>@<network>/<ircserver>, <host>@<network>/<ircserver>
+# and <channel>@<network>/<ircserver> to restrict the whitelisting to the
+# specified network or ircserver.
+#
+# The new commands are quite verbose. They are so for a reason: The commands
+# should be easy to remember and self explaining. If someone wants shorter
+# commands, feel free to use 'alias'.
+##
+# /whitelist upgrade
+# convert the old style settings to the new hash/config file based settings.
+# you MUST run this if you haven't generated a config file yet.
+#
+# /whitelist show
+# shows you all of the whitelisted entries.
+
+use strict;
+use Irssi;
+use Irssi::Irc;
+use IO::File;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.0";
+%IRSSI = (
+ authors => "David O\'Rourke, Karl Siegemund",
+ contact => "phyber \[at\] #irssi, q \[at\] spuk.de",
+ name => "whitelist",
+ description => "Whitelist specific nicks or hosts and ignore messages from anyone else.",
+ license => "GPLv2",
+ changed => "12/03/2007 15:20 GMT"
+);
+
+# location of the settings file
+my $settings_file = Irssi::get_irssi_dir.'/whitelist.conf';
+# This hash stores our various whitelists.
+my %whitelisted;
+
+# A mapping to convert simple regexp (* and ?) into Perl regexp
+my %htr = ( );
+foreach my $i (0..255) {
+ my $ch = chr($i);
+ $htr{$ch} = "\Q$ch\E";
+}
+$htr{'?'} = '.';
+$htr{'*'} = '.*';
+
+# A list of settings we can use and change
+my %types = (
+ 'nick' => 'nicks',
+ 'host' => 'hosts',
+ 'chan' => 'channels',
+ 'channel' => 'channels',
+ 'net' => 'networks',
+ 'network' => 'networks',
+);
+
+sub host_to_regexp {
+ my ($mask) = @_;
+ $mask = lc_host($mask);
+ $mask =~ s/(.)/$htr{$1}/g;
+ return $mask;
+}
+
+sub lc_host {
+ my ($host) = @_;
+ $host =~ s/(.+)\@(.+)/sprintf("%s@%s", $1, lc($2));/eg;
+ return $host;
+}
+
+# Show the current config
+sub print_config {
+ foreach my $listtype (keys %whitelisted) {
+ my $str = join ' ', @{$whitelisted{$listtype}};
+ Irssi::print "Whitelisted $listtype: $str";
+ }
+}
+
+# Read in the whitelist.conf
+sub read_config {
+ # nicks, hosts, channels, networks
+ my $f = IO::File->new($settings_file, 'r');
+ #die "Couldn't open $settings_file for reading" if (!defined $f);
+ if (!defined $f) {
+ Irssi::print "Couldn't open $settings_file for reading. Do you need to generate a config file with '/whitelist upgrade' ?";
+ return;
+ }
+
+ while (<$f>) {
+ chomp;
+ my ($listtype, @list) = split / /, $_;
+ @{$whitelisted{$listtype}} = map { $_ } @list;
+
+ # Make sure there is no duplicate weirdness
+ undef my %saw;
+ @{$whitelisted{$listtype}} = grep(!$saw{$_}++, @{$whitelisted{$listtype}});
+ }
+ $f = undef;
+}
+
+# Write out the whitelist.conf
+sub write_config {
+ my $f = IO::File->new($settings_file, 'w');
+ die "Couldn't open $settings_file for writing" if (!defined $f);
+
+ foreach my $listtype (keys %whitelisted) {
+ # Make sure we arn't writing duplicates
+ undef my %saw;
+ @{$whitelisted{$listtype}} = grep(!$saw{$_}++, @{$whitelisted{$listtype}});
+
+ my $str = join ' ', @{$whitelisted{$listtype}};
+ print {$f} "$listtype $str\n";
+ }
+ $f = undef;
+}
+
+# convert old settings to new settings (/whitelist upgrade)
+sub old2new {
+ my $nicks = Irssi::settings_get_str('whitelist_nicks');
+ my $hosts = Irssi::settings_get_str('whitelist_hosts');
+ my $channels = Irssi::settings_get_str('whitelist_channels');
+ my $networks = Irssi::settings_get_str('whitelist_networks');
+
+ foreach my $nick (split /\s+/, $nicks) {
+ next if not length $nick;
+ push @{$whitelisted{'nicks'}}, $nick;
+ }
+
+ foreach my $host (split /\s+/, $hosts) {
+ next if not length $host;
+ push @{$whitelisted{'hosts'}}, $host;
+ }
+
+ foreach my $channel (split /\s+/, $channels) {
+ next if not length $channel;
+ push @{$whitelisted{'channels'}}, $channel;
+ }
+
+ foreach my $network (split /\s+/, $networks) {
+ next if not length $network;
+ push @{$whitelisted{'networks'}}, $network;
+ }
+
+ write_config();
+}
+# This one gets called from IRSSI if we get a private message (PRIVMSG)
+sub whitelist_check {
+ my ($server, $msg, $nick, $address) = @_;
+ # these four settings are stored in a hash now after reading the config file.
+ #my $nicks = Irssi::settings_get_str('whitelist_nicks');
+ #my $hosts = Irssi::settings_get_str('whitelist_hosts');
+ #my $channels = Irssi::settings_get_str('whitelist_channels');
+ #my $networks = Irssi::settings_get_str('whitelist_networks');
+ my $warning = Irssi::settings_get_bool('whitelist_notify');
+ my $casesensitive = Irssi::settings_get_bool('whitelist_nicks_case_sensitive');
+ my $logging = Irssi::settings_get_bool('whitelist_log_ignored_msgs');
+ my $logfile = Irssi::get_irssi_dir.'/whitelist.log';
+
+ my $hostmask = "$nick!$address";
+
+ my $tag = $server->{chatnet};
+ $tag = $server->{tag} unless defined $tag;
+ $tag = lc($tag);
+
+ # Handle servers first, because they are the most significant,
+ # Nicks, Channels and Hostmasks are always local to a network
+ foreach my $network (@{$whitelisted{'networks'}}) {
+ # Change it to lower case
+ $network = lc($network);
+ # Kludge. Sometimes you get superfluous '', you have to ignore
+ next if ($network eq '');
+ # Rewrite simplified regexp (* and ?) to Perl regexp
+ $network =~ s/(.)/$htr{$1}/g;
+ # Either the server tag matches
+ return if ($tag =~ /$network/);
+ # Or its address
+ return if ($server->{address} =~ /$network/);
+ }
+
+ # Nicks are the easiest to handle with the least computational effort.
+ # So do them before hosts and networks.
+ foreach my $whitenick (@{$whitelisted{'nicks'}}) {
+ if (!$casesensitive) {
+ $nick = lc($nick);
+ $whitenick = lc($whitenick);
+ }
+ # Simple check first: Is the nick itself whitelisted?
+ return if ($nick eq $whitenick);
+ # Second check: We have to look if the nick was localized to a network
+ # or irc server. So we have to look at <nick>@<network> too.
+ ($whitenick, my $network) = split /@/, $whitenick, 2;
+ # Ignore nicks without @<network>
+ next if !defined $network;
+ # Convert simple regexp to Perl regexp
+ $network =~ s/(.)/$htr{$1}/g;
+ # If the nick matches...
+ if ($nick eq $whitenick) {
+ # ...allow if the server tag is right...
+ return if ($tag =~ /$network/);
+ # ...or the server address matches
+ return if ($server->{address} =~ /$network/);
+ }
+ }
+
+ # Hostmasks are somewhat more sophisticated, because they allow wildcards
+ foreach my $whitehost (@{$whitelisted{'hosts'}}) {
+ # Kludge, sometimes you get ''
+ next if ($whitehost eq '');
+ # First reconvert simple regexp to Perl regexp
+ $whitehost = host_to_regexp($whitehost);
+ # Allow if the hostmask matches
+ return if ($hostmask =~ /$whitehost/);
+ # Check if hostmask is localized to a network
+ (my $whitename, $whitehost, my $network) = split /@/, $whitehost, 3;
+ # Ignore hostmasks without attached network
+ next if !defined $network;
+ # We don't need to convert the network address again
+ # $network =~ s/(.)/$htr{$1}/g;
+ # But we have to reassemble the hostmask
+ $whitehost = "$whitename\@$whitehost";
+ # If the hostmask matches...
+ if ($hostmask eq $whitehost) {
+ # ...allow if the server tag is ok...
+ return if ($tag =~ /$network/);
+ # ... or the server address
+ return if ($server->{address} =~ /$network/);
+ }
+ }
+
+ # Channels require some interaction with the server, so we do them last,
+ # hoping that some ACCEPT cases are already done, thus saving computation
+ # time and effort
+ foreach my $channel (@{$whitelisted{'channels'}}) {
+ # Check if we are on the specified channel
+ my $chan = $server->channel_find($channel);
+ # If yes...
+ if (defined $chan) {
+ # Check if the nick in question is also on that channel
+ my $chk = $chan->nick_find($nick);
+ # Allow the message
+ return if defined $chk;
+ }
+ # Check if we are talking about a localized channel
+ ($chan, my $network) = split /@/, $_, 2;
+ # Ignore not localized channels
+ next if !defined $network;
+ # Convert simple regexp to Perl regexp
+ $network =~ s/(.)/$htr{$1}/g;
+ # Ignore channels from a differently tagged server or from a different
+ # address
+ next if (!($tag =~ /$network/ || $server->{address} =~ /$network/));
+ # Check if we are on the channel
+ $chan = $server->channel_find($chan);
+ # Ignore if not
+ next unless defined $chan;
+ # Check if $nick is on that channel too
+ my $chk = $chan->nick_find($nick);
+ # Allow if yes
+ return if defined $chk;
+ }
+
+ # Do we want a notice about this message attempt?
+ if ($warning) {
+ Irssi::print "[$tag] $nick [$address] attempted to send private message.";
+ }
+
+ # Do we want to make a log entry for it?
+ if ($logging) {
+ my $f = IO::File->new($logfile, '>>');
+ return if (!defined $f);
+ print {$f} localtime().": [$tag] $nick [$address]: $msg\n";
+ $f = undef;
+ }
+
+ # stop if the message isn't from a whitelisted address
+ Irssi::signal_stop();
+ return;
+}
+
+sub usage {
+ Irssi::print "Usage: whitelist (add|del|remove) (nick|host|chan[nel]|net[work]) <list>";
+ Irssi::print " whitelist (nick|host|chan[nel]|net[work])";
+ Irssi::print " whitelist upgrade";
+ Irssi::print " whitelist show";
+}
+
+# This is bound to the /whitelist command
+sub whitelist_cmd {
+ my ($args, $server, $winit) = @_;
+ my ($cmd, $type, $rest) = split /\s+/, $args, 3;
+
+ # What type of settings we want to change?
+ my $listtype = $types{$type};
+
+ # If we didn't get a syntactically correct command, put out an error
+ if(!defined $listtype && defined $type) {
+ usage;
+ return;
+ }
+
+ # What are we doing?
+ if ($cmd eq 'add') {
+ # split $rest into a list.
+ my @list = split /\s+/, $rest;
+
+ # Add the entries to the whitelist and then make sure it's unique
+ foreach my $entry (@list) {
+ push @{$whitelisted{$listtype}}, $entry;
+ undef my %saw;
+ @{$whitelisted{$listtype}} = grep(!$saw{$_}++, @{$whitelisted{$listtype}});
+ }
+ } elsif ($cmd eq 'del' || $cmd eq 'remove') {
+ # Escape all letters to protect the Perl Regexp special characters
+ $rest =~ s/(.)/$htr{$1}/g;
+
+ # Make a list of things we want removing.
+ my @list = split /\s+/, $rest;
+
+ # Use grep to remove the list of things we don't want anymore.
+ foreach my $removal (@list) {
+ @{$whitelisted{$listtype}} = grep {!/^$removal$/} @{$whitelisted{$listtype}};
+ }
+ } elsif ($cmd eq 'upgrade') {
+ Irssi::print "Converting old style /settings to new config file based settings";
+ old2new();
+ read_config();
+ print_config();
+ return;
+ } elsif ($cmd eq 'show') {
+ print_config();
+ return;
+ } elsif(!defined $type) {
+ # Look if we just want to see the current values
+ $listtype = $types{$cmd};
+ if (defined $listtype) {
+ # Print them
+ Irssi::print "Whitelist ${cmd}s: ".join ' ', @{$whitelisted{$listtype}};
+ } else {
+ # Or give error message
+ usage;
+ }
+ return;
+ } else {
+ # If we felt through until here, something went wrong
+ usage;
+ return;
+ }
+ # Display the changed value and store it in the settings
+ Irssi::print "Whitelist ${type}s: ".join ' ', @{$whitelisted{$listtype}};
+ # Save the new settings
+ write_config();
+ return;
+}
+
+Irssi::settings_add_bool('whitelist', 'whitelist_notify' => 1);
+Irssi::settings_add_bool('whitelist', 'whitelist_log_ignored_msgs' => 1);
+Irssi::settings_add_bool('whitelist', 'whitelist_nicks_case_sensitive' => 0);
+
+foreach (keys(%types)) {
+ Irssi::settings_add_str('whitelist', 'whitelist_'.$types{$_}, '');
+}
+
+Irssi::signal_add_first('message private', \&whitelist_check);
+
+Irssi::command_bind('whitelist', \&whitelist_cmd);
+
+# Read the config
+\&read_config();
+#########################
+####### Changelog #######
+### 1.0: David O'Rourke
+# Changed how whitelists are stored. We no longer use the settings_*_str for them.
+# We now store them in a hash and write/read a config file.
+# Added '/whitelist old2new' function, for converting to the new style list.
+# Added '/whitelist show' for showing everything that's been whitelisted.
+### 0.9g: David O'Rourke
+# Cleanups.
+### 0.9f: David O'Rourke
+# Cleanups.
+### 0.9e: David O'Rourke
+# Changed print -> Irssi::print
+# Fixed '' in $whitehost
+#########################
+# 0.9d: David O'Rourke
+# General cleanup of script.
+# Removed pointless function timestamp()
+# Removed pointless global variables $tstamp, $whitenick, $whitehost
+# Created whitelist logging directory in ~/.irssi with option to rotate log daily.
+# Fixed comparison of whitelist_networks to $tag. $tag was being lowercased, whitelist_networks was not.
diff --git a/scripts/whois.pl b/scripts/whois.pl
new file mode 100644
index 0000000..e6be917
--- /dev/null
+++ b/scripts/whois.pl
@@ -0,0 +1,38 @@
+# whois.pl/Irssi/fahren@bochnia.pl
+
+use Irssi;
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.0";
+%IRSSI = (
+ authors => "Maciek \'fahren\' Freudenheim",
+ contact => "fahren\@bochnia.pl",
+ name => "cwhois",
+ description => "Hilights \'@\' in whois channel reply",
+ license => "GNU GPLv2 or later",
+ changed => "Fri Mar 15 15:09:42 CET 2002"
+);
+
+Irssi::theme_register([
+ 'cwhois_channels', '{whois channels %|$1}'
+]);
+
+sub event_cwhois
+{
+ my ($server, $data) = @_;
+
+ my ($nick, $chans) = $data =~ /([\S]+)\s:(.*)/;
+
+ my $ret;
+ foreach my $chan (split(/ /, $chans)) {
+ $ret .= (($chan =~ s/^@//)? "\00316@\003" : "") . $chan . " ";
+ }
+
+ chop $ret;
+ $server->printformat($nick, MSGLEVEL_CRAP, 'cwhois_channels', $nick, $ret);
+
+ Irssi::signal_stop();
+}
+
+Irssi::signal_add('event 319', 'event_cwhois');
diff --git a/scripts/whos.pl b/scripts/whos.pl
new file mode 100644
index 0000000..96eb898
--- /dev/null
+++ b/scripts/whos.pl
@@ -0,0 +1,109 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+$VERSION = '1.01';
+%IRSSI = (
+ authors => 'Erik Fears',
+ contact => 'strtok@softhome.net',
+ name => 'whos',
+ description => 'This script allows ' .
+ 'you to view all users ' .
+ 'on a specific server.',
+ license => 'GPL',
+);
+
+Irssi::command_bind('whos', \&cmd_whos);
+Irssi::command_bind('whoss', \&cmd_whoss);
+Irssi::signal_add('redir whos', \&sig_whos);
+Irssi::signal_add('redir whosend', \&sig_whosend);
+
+Irssi::theme_register([
+ 'whos' => '%#{channelhilight $[-10]0} %|{nick $[!9]1} $[!3]2 $[!2]3 $4@$5 {comment {hilight $6}}',
+ 'whos_end' => 'End of /WHOS list',
+ 'whos_hil' => '{hilight $0} $1'
+]);
+
+#results
+my %res;
+
+#WHOS <CHANNEL>
+sub cmd_whos
+{
+ my @parv;
+ my ($data, $server, $witem) = @_;
+ my $chan;
+ if (exists $res{$server->{tag}}) {
+ $res{$server->{tag}}=();
+ }
+ $res{$server->{tag}}->{result}=();
+ $res{$server->{tag}}->{server}=();
+ $res{$server->{tag}}->{regex}='';
+
+ if( !($witem && $witem->{type} eq "CHANNEL") )
+ {
+ return;
+ }
+
+ $chan = $witem->{name};
+
+ @parv = split(/\s+/,$data);
+
+ $server->redirect_event("who", 1, $chan, 0, undef, {
+ "event 352" => "redir whos",
+ "event 315" => "redir whosend",
+ "" => "event empty"}
+ );
+
+
+ if(length($parv[0]) <= 0)
+ {
+ $res{$server->{tag}}->{regex}='';
+ }
+ else
+ {
+ $res{$server->{tag}}->{regex}=$parv[0];
+ }
+
+ $server->send_raw("WHO " . $chan);
+}
+
+#strtok #ribena strtok not.deprecated irc.choopa.net strtok H@ :0 (char *, const char *);
+
+
+sub sig_whos
+{
+ my @who;
+ my ($server, $msg, $nick, $address, $target) = @_;
+
+ @who = split(/\s+/,$msg,9);
+
+ $res{$server->{tag}}->{result}->{$who[5]}=[@who];
+}
+
+sub sig_whosend
+{
+ my ($server, $msg, $nick, $address, $target) = @_;
+ if ($res{$server->{tag}}->{regex} eq '') {
+ $res{$server->{tag}}->{regex}= $nick;
+ }
+ Irssi::printformat(MSGLEVEL_CRAP,'whos_hil','regex:',$res{$server->{tag}}->{regex});
+ foreach (sort keys %{$res{$server->{tag}}->{result}}) {
+ my @r=@{$res{$server->{tag}}->{result}->{$_}};
+ if ($r[4] =~ m/$res{$server->{tag}}->{regex}/ ) {
+ Irssi::printformat(MSGLEVEL_CRAP,'whos',@r[1,5,6,7,2,3,8]);
+ }
+ $res{$server->{tag}}->{server}->{$r[4]}=1;
+ }
+ Irssi::printformat(MSGLEVEL_CRAP, 'whos_end');
+}
+
+sub cmd_whoss {
+ my ($args, $server, $witem) = @_;
+ Irssi::printformat(MSGLEVEL_CRAP,'whos_hil','servers:');
+ foreach (sort keys %{$res{$server->{tag}}->{server}}) {
+ Irssi::print($_,MSGLEVEL_CRAP);
+ }
+}
+
+# vim:set ts=3 sw=3 expandtab:
diff --git a/scripts/wilm.pl b/scripts/wilm.pl
new file mode 100644
index 0000000..59fd1a5
--- /dev/null
+++ b/scripts/wilm.pl
@@ -0,0 +1,54 @@
+# wilm.pl
+# Lam 28.10.2001, 10.3.2002
+# lam@lac.pl
+
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.0.1";
+%IRSSI = (
+ authors => "Leszek Matok",
+ contact => "lam\@lac.pl",
+ name => "wilm",
+ description => "Provides /wilm and /wiilm commands, which do a whois on a person who sent you last private message",
+ license => "Public Domain",
+ changed => "10.3.2002 14:00"
+);
+
+my $last_nick;
+my $last_server;
+
+sub wilm {
+ my @all_servers = Irssi::servers();
+ foreach my $one_server ( @all_servers ) {
+ if ( $one_server = $last_server ) {
+ $one_server->command( "whois $last_nick" );
+ return;
+ }
+ }
+ Irssi::print( "noone to whois" );
+}
+
+sub wiilm {
+ my @all_servers = Irssi::servers();
+ foreach my $one_server ( @all_servers ) {
+ if ( $one_server = $last_server ) {
+ $one_server->command( "whois $last_nick $last_nick" );
+ return;
+ }
+ }
+ Irssi::print( "noone to whois" );
+}
+
+sub privmsg {
+ my ( $server, $data, $nick, $address ) = @_;
+ my ( $target, $text ) = split( / :/, $data, 2 );
+
+ if ( ( lc $target ) eq ( lc $server->{ nick } ) ) {
+ $last_nick = $nick;
+ $last_server = $server;
+ }
+}
+
+Irssi::command_bind( "wilm", "wilm" );
+Irssi::command_bind( "wiilm", "wiilm" );
+Irssi::signal_add( "event privmsg", "privmsg" );
diff --git a/scripts/wkb.pl b/scripts/wkb.pl
new file mode 100644
index 0000000..0bf3a43
--- /dev/null
+++ b/scripts/wkb.pl
@@ -0,0 +1,68 @@
+use strict;
+use Irssi 20020217; # Irssi 0.8.0
+use vars qw($VERSION %IRSSI);
+$VERSION = "1.2";
+%IRSSI = (
+ authors => "Matti 'qvr' Hiljanen",
+ contact => "matti\@hiljanen.com",
+ name => "wkb",
+ description => "A simple word kickbanner",
+ license => "Public Domain",
+ url => "http://matin.maapallo.org/softa/irssi",
+);
+
+use Irssi;
+
+my @channels;
+
+my @words;
+
+my @gods;
+
+sub sig_public {
+ my ($server, $msg, $nick, $address, $target) = @_;
+
+ return if $nick eq $server->{nick};
+
+ $msg =~ s/[\000-\037]//g;
+ my $rmsg = $msg;
+ $msg = lc($msg);
+
+ # bad word
+ my $nono = 0;
+ foreach (@words) { $nono = 1 if $msg =~ /$_/ }
+ return unless $nono;
+
+ # channel?
+ my $react = 0;
+ foreach (@channels) { $react = 1 if lc($target) eq lc($_) }
+ return unless $react;
+
+ # god-like person?
+ my $jumala = 0;
+ foreach (@gods) { $jumala = 1 if lc($nick) =~ /$_/ }
+ return if $jumala;
+
+ # voiced or op'd?
+ return if $server->channel_find($target)->nick_find($nick)->{op} || $server->channel_find($target)->nick_find($nick)->{voice};
+
+ $server->command("kickban $target $nick WKB initiated");
+ Irssi::print("Word kick: Kicking $nick from $target. (He said $rmsg)");
+}
+
+sub sig_setup_changed {
+ @channels= split(/\s+/, Irssi::settings_get_str($IRSSI{name}.'_channels'));
+ @words= split(/\s+/, Irssi::settings_get_str($IRSSI{name}.'_words'));
+ @gods= split(/\s+/, Irssi::settings_get_str($IRSSI{name}.'_gods'));
+}
+
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_channels', '#foo #foo2');
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_words', 'bad_word bad_word2');
+Irssi::settings_add_str($IRSSI{name}, $IRSSI{name}.'_gods', 'qvr other_gods');
+
+Irssi::signal_add_last('message public', 'sig_public');
+Irssi::signal_add('setup changed', 'sig_setup_changed');
+
+sig_setup_changed();
+
+# vim:set ts=4 sw=4 expandtab:
diff --git a/scripts/wlstat.pl b/scripts/wlstat.pl
new file mode 100644
index 0000000..1bac546
--- /dev/null
+++ b/scripts/wlstat.pl
@@ -0,0 +1,669 @@
+use strict; # use warnings;
+
+# FIXME COULD SOMEONE PLEASE TELL ME HOW TO SHUT UP
+#
+# ...
+# Variable "*" will not stay shared at (eval *) line *.
+# Variable "*" will not stay shared at (eval *) line *.
+# ...
+# Can't locate package Irssi::Nick for @Irssi::Irc::Nick::ISA at (eval *) line *.
+# ...
+#
+# THANKS
+
+use Irssi (); # which is the minimum required version of Irssi ?
+use Irssi::TextUI;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '0.5';
+%IRSSI = (
+ authors => 'BC-bd, Veli, Timo \'cras\' Sirainen, Wouter Coekaerts, Nei',
+ contact => 'bd@bc-bd.org, veli@piipiip.net, tss@iki.fi, wouter@coekaerts.be, Nei@QuakeNet',
+ name => 'wlstat',
+ description => 'Adds a window list in the status area. Based on chanact.pl by above authors.',
+ license => 'GNU GPLv2 or later',
+);
+
+# adapted by Nei
+
+###############
+# original comment
+# ###########
+# # Adds new powerful and customizable [Act: ...] item (chanelnames,modes,alias).
+# # Lets you give alias characters to windows so that you can select those with
+# # meta-<char>.
+# #
+# # for irssi 0.8.2 by bd@bc-bd.org
+# #
+# # inspired by chanlist.pl by 'cumol@hammerhart.de'
+# #
+# #########
+# # Contributors
+# #########
+# #
+# # veli@piipiip.net /window_alias code
+# # qrczak@knm.org.pl chanact_abbreviate_names
+# # qerub@home.se Extra chanact_show_mode and chanact_chop_status
+# #
+#
+# FURTHER THANKS TO
+# ############
+# # buu, fxn, Somni, Khisanth, integral, tybalt89 for much support in any aspect perl
+# # and the channel in general ( #perl @ freenode ) and especially the ir_* functions
+# #
+# # Valentin 'senneth' Batz ( vb@g-23.org ) for the pointer to grep.pl, continuous support
+# # and help in digging up ir_strip_codes
+# #
+# # OnetrixNET technology networks for the debian environment
+# #
+# # Monkey-Pirate.com / Spaceman Spiff for the webspace
+# #
+#
+
+######
+# M A I N P R O B L E M
+#####
+#
+# It is impossible to place the wlstat on a statusbar together with other items, because I
+# do not know how to calculate the size that it is going to get granted, and therefore I
+# cannot do the linebreaks properly.
+# This is what is missing to make a nice script out of wlstat.
+# If you have any ideas, please contact me ASAP :).
+#
+######
+
+######
+# UTF-8 PROBLEM
+#####
+#
+# Please help me find a solution to this:
+# this be your statusbar, it is using up the maximum term size
+# [[1=1]#abc [2=2]#defghi]
+#
+# now consider this example: "ascii" characters are marked with ., utf-8 characters with *
+# [[1=1]#... [2=2]#...***]
+#
+# you should think that this is how it would be displayed? WRONG!
+# [[1=1]#... [2=2]#...*** ]
+#
+# this is what Irssi does.. I believe my length calculating code to be correct, however, I'd
+# love to be proven wrong (or receive any other fix, too, of course!)
+#
+######
+
+#########
+# USAGE
+###
+#
+# copy the script to ~/.irssi/scripts/
+#
+# In irssi:
+#
+# /script load wlstat
+#
+#
+# Hint: to get rid of the old [Act:] display
+# /statusbar window remove act
+#
+# to get it back:
+# /statusbar window add -after lag -priority 10 act
+#
+##########
+# OPTIONS
+########
+#
+# /set wlstat_display_nokey <string>
+# /set wlstat_display_key <string>
+# * string : Format String for one window. The following $'s are expanded:
+# $C : Name
+# $N : Number of the Window
+# $Q : meta-Keymap
+# $H : Start highlighting
+# $S : Stop highlighting
+# IMPORTANT: don't forget to use $S if you used $H before!
+#
+# /set wlstat_separator <string>
+# * string : Charater to use between the channel entries
+# you'll need to escape " " space and "$" like this:
+# "/set wlstat_separator \ "
+# "/set wlstat_separator \$"
+# and {}% like this:
+# "/set wlstat_separator %{"
+# "/set wlstat_separator %}"
+# "/set wlstat_separator %%"
+# (reason being, that the separator is used inside a {format })
+#
+# /set wlstat_hide_data <num>
+# * num : hide the window if its data_level is below num
+# set it to 0 to basically disable this feature,
+# 1 if you don't want windows without activity to be shown
+# 2 to show only those windows with channel text or hilight
+# 3 to show only windows with hilight
+#
+# /set wlstat_maxlines <num>
+# * num : number of lines to use for the window list (0 to disable)
+#
+# /set wlstat_sort <-data_level|-last_line|refnum>
+# * you can change the window sort order with this variable
+# -data_level : sort windows with hilight first
+# -last_line : sort windows in order of activity
+# refnum : sort windows by window number
+#
+# /set wlstat_placement <top|bottom>
+# /set wlstat_position <num>
+# * these settings correspond to /statusbar because wlstat will create
+# statusbars for you
+# (see /help statusbar to learn more)
+#
+# /set wlstat_all_disable <ON|OFF>
+# * if you set wlstat_all_disable to ON, wlstat will also remove the
+# last statusbar it created if it is empty.
+# As you might guess, this only makes sense with wlstat_hide_data > 0 ;)
+#
+###
+# WISHES
+####
+#
+# if you fiddle with my mess, provide me with your fixes so I can benefit as well
+#
+# Nei =^.^= ( QuakeNet accountname: ailin )
+#
+
+my $actString = []; # statusbar texts
+my $currentLines = 0;
+my $resetNeeded; # layout/screen has changed, redo everything
+my $needRemake; # "normal" changes
+#my $callcount = 0;
+my $globTime = undef; # timer to limit remake() calls
+
+my %statusbars; # currently active statusbars
+
+# maybe I should just tie the array ?
+sub add_statusbar {
+ for (@_) {
+ # add subs
+ for my $l ($_) { eval {
+ no strict 'refs'; # :P
+ *{"wlstat$l"} = sub { wlstat($l, @_) };
+ }; }
+ Irssi::command("statusbar wl$_ reset");
+ Irssi::command("statusbar wl$_ enable");
+ if (lc Irssi::settings_get_str('wlstat_placement') eq 'top') {
+ Irssi::command("statusbar wl$_ placement top");
+ }
+ if ((my $x = int Irssi::settings_get_int('wlstat_position')) != 0) {
+ Irssi::command("statusbar wl$_ position $x");
+ }
+ Irssi::command("statusbar wl$_ add -priority 100 -alignment left barstar");
+ Irssi::command("statusbar wl$_ add wlstat$_");
+ Irssi::command("statusbar wl$_ add -priority 100 -alignment right barend");
+ Irssi::command("statusbar wl$_ disable");
+ Irssi::statusbar_item_register("wlstat$_", '$0', "wlstat$_");
+ $statusbars{$_} = {};
+ }
+}
+
+sub remove_statusbar {
+ for (@_) {
+ Irssi::command("statusbar wl$_ reset");
+ Irssi::statusbar_item_unregister("wlstat$_"); # XXX does this actually work ?
+ # DO NOT REMOVE the sub before you have unregistered it :))
+ for my $l ($_) { eval {
+ no strict 'refs';
+ undef &{"wlstat$l"};
+ }; }
+ delete $statusbars{$_};
+ }
+}
+
+sub syncLines {
+ my $temp = $currentLines;
+ $currentLines = @$actString;
+ #Irssi::print("current lines: $temp new lines: $currentLines");
+ my $currMaxLines = Irssi::settings_get_int('wlstat_maxlines');
+ if ($currMaxLines > 0 and @$actString > $currMaxLines) {
+ $currentLines = $currMaxLines;
+ }
+ return if ($temp == $currentLines);
+ if ($currentLines > $temp) {
+ for ($temp .. ($currentLines - 1)) {
+ add_statusbar($_);
+ Irssi::command("statusbar wl$_ enable");
+ }
+ }
+ else {
+ for ($_ = ($temp - 1); $_ >= $currentLines; $_--) {
+ Irssi::command("statusbar wl$_ disable");
+ remove_statusbar($_);
+ }
+ }
+}
+
+my %keymap;
+
+sub get_keymap {
+ my ($textDest, undef, $cont_stripped) = @_;
+ if ($textDest->{'level'} == 524288 and $textDest->{'target'} eq '' and !defined($textDest->{'server'})) {
+ if ($cont_stripped =~ m/meta-(.)\s+change_window (\d+)/) { $keymap{$2} = "$1"; }
+ Irssi::signal_stop();
+ }
+}
+
+sub update_keymap {
+ %keymap = ();
+ Irssi::signal_remove('command bind' => 'watch_keymap');
+ Irssi::signal_add_first('print text' => 'get_keymap');
+ Irssi::command('bind'); # stolen from grep
+ Irssi::signal_remove('print text' => 'get_keymap');
+ Irssi::signal_add('command bind' => 'watch_keymap');
+ Irssi::timeout_add_once(100, 'eventChanged', undef);
+}
+
+# watch keymap changes
+sub watch_keymap {
+ Irssi::timeout_add_once(1000, 'update_keymap', undef);
+}
+
+update_keymap();
+
+sub expand {
+ my ($string, %format) = @_;
+ my ($exp, $repl);
+ $string =~ s/\$$exp/$repl/g while (($exp, $repl) = each(%format));
+ return $string;
+}
+
+# FIXME implement $get_size_only check, and user $item->{min|max-size} ??
+sub wlstat {
+ my ($line, $item, $get_size_only) = @_;
+
+ if ($needRemake) {
+ $needRemake = undef;
+ remake();
+ }
+
+ my $text = $actString->[$line]; # DO NOT set the actual $actString->[$line] to '' here or
+ $text = '' unless defined $text; # you'll screw up the statusbar counter ($currentLines)
+ $item->default_handler($get_size_only, $text, '', 1);
+}
+
+my %strip_table = (
+ # fe-common::core::formats.c:format_expand_styles
+ # delete format_backs format_fores bold_fores other stuff
+ (map { $_ => '' } (split //, '04261537' . 'kbgcrmyw' . 'KBGCRMYW' . 'U9_8:|FnN>#[')),
+ # escape
+ (map { $_ => $_ } (split //, '{}%')),
+);
+sub ir_strip_codes { # strip %codes
+ my $o = shift;
+ $o =~ s/(%(.))/exists $strip_table{$2} ? $strip_table{$2} : $1/gex;
+ $o
+}
+
+sub ir_parse_special {
+ my $o; my $i = shift;
+ my $win = Irssi::active_win();
+ my $server = Irssi::active_server();
+ if (ref $win and ref $win->{'active'}) {
+ $o = $win->{'active'}->parse_special($i);
+ }
+ elsif (ref $win and ref $win->{'active_server'}) {
+ $o = $win->{'active_server'}->parse_special($i);
+ }
+ elsif (ref $server) {
+ $o = $server->parse_special($i);
+ }
+ else {
+ $o = Irssi::parse_special($i);
+ }
+ $o
+}
+
+sub sb_expand { # expand {format }s (and apply parse_special for $vars)
+ ir_parse_special(
+ Irssi::current_theme->format_expand(
+ shift,
+ (
+ Irssi::EXPAND_FLAG_IGNORE_REPLACES
+ |
+ Irssi::EXPAND_FLAG_IGNORE_EMPTY
+ )
+ )
+ )
+}
+sub sb_strip {
+ ir_strip_codes(
+ sb_expand(shift)
+ ); # does this get us the actual length of that s*ty bar :P ?
+}
+sub sb_length {
+ # unicode cludge, d*mn broken Irssi
+ # screw it, this will fail from broken joining anyway (and cause warnings)
+ if (lc Irssi::settings_get_str('term_type') eq 'utf-8') {
+ my $temp = sb_strip(shift);
+ # try to switch on utf8
+ eval {
+ no warnings;
+ require Encode;
+ #$temp = Encode::decode_utf8($temp); # thanks for the hint, but I have my reasons for _utf8_on
+ Encode::_utf8_on($temp);
+ };
+ length($temp)
+ }
+ else {
+ length(sb_strip(shift))
+ }
+}
+
+# !!! G*DD*MN Irssi is adding an additional layer of backslashitis per { } layer
+# !!! AND I still don't know what I need to escape.
+# !!! and NOONE else seems to know or care either.
+# !!! f*ck open source. I mean it.
+# XXX any Irssi::print debug statement leads to SEGFAULT - why ?
+
+# major parts of the idea by buu (#perl @ freenode)
+# thanks to fxn and Somni for debugging
+# while ($_[0] =~ /(.)/g) {
+# my $c = $1; # XXX sooo... goto kills $1
+# if ($q eq '%') { goto ESC; }
+
+## <freenode:#perl:tybalt89> s/%(.)|(\{)|(\})|(\\|\$)/$1?$1:$2?($level++,$2):$3?($level>$min_level&&$level--,$3):'\\'x(2**$level-1).$4/ge; # untested...
+sub ir_escape {
+ my $min_level = $_[1] || 0; my $level = $min_level;
+ my $o = shift;
+ $o =~ s/
+ ( %. ) | # $1
+ ( \{ ) | # $2
+ ( \} ) | # $3
+ ( \\ ) | # $4
+ ( \$(?=.) ) | # $5
+ ( \$ ) # $6
+ /
+ if ($1) { $1 } # %. escape
+ elsif ($2) { $level++; $2 } # { nesting start
+ elsif ($3) { if ($level > $min_level) { $level--; } $3 } # } nesting end
+ elsif ($4) { '\\'x(2**$level) } # \ needs \\escaping
+ elsif ($5) { '\\'x(2**$level-1) . '$' . '\\'x(2**$level-1) } # and $ needs even more because of "parse_special"
+ else { '\\'x(2**$level-1) . '$' } # $ needs \$ escaping
+ /gex;
+ $o
+}
+#sub ir_escape {
+# my $min_level = $_[1] || 0; my $level = $min_level;
+# my $o = shift;
+# $o =~ s/
+# ( %. ) | # $1
+# ( \{ ) | # $2
+# ( \} ) | # $3
+# ( \\ | \$ ) # $4
+# /
+# if ($1) { $1 } # %. escape
+# elsif ($2) { $level++; $2 } # { nesting start
+# elsif ($3) { if ($level > $min_level) { $level--; } $3 } # } nesting end
+# else { '\\'x(2**($level-1)-1) . $4 } # \ or $ needs \\escaping
+# /gex;
+# $o
+#}
+
+sub ir_fe { # try to fix format stuff
+ my $x = shift;
+ # XXX why do I have to use two/four % here instead of one/two ?? answer: you screwed up in ir_escape
+ $x =~ s/([%{}])/%$1/g;
+ $x =~ s/(\\|\$)/\\$1/g;
+ #$x =~ s/(\$(?=.))|(\$)/$1?"\\\$\\":"\\\$"/ge; # I think this should be here (logic), but it doesn't work that way :P
+ #$x =~ s/\\/\\\\/g; # that's right, escape escapes
+ $x
+}
+
+sub remake () {
+ #$callcount++;
+ #my $xx = $callcount; Irssi::print("starting remake [ $xx ]");
+ my ($hilight, $number, $display);
+ my $separator = '{sb_act_sep ' . Irssi::settings_get_str('wlstat_separator') . '}';
+ my $custSort = Irssi::settings_get_str('wlstat_sort');
+ my $custSortDir = 1;
+ if ($custSort =~ /^[-!](.*)/) {
+ $custSortDir = -1;
+ $custSort = $1;
+ }
+
+ $actString = [];
+ my ($line, $width) = (0, [Irssi::windows]->[0]{'width'} - sb_length('{sb x}'));
+ foreach my $win (
+ sort {
+ (
+ ( (int($a->{$custSort}) <=> int($b->{$custSort})) * $custSortDir )
+ ||
+ ($a->{'refnum'} <=> $b->{'refnum'})
+ )
+ } Irssi::windows
+ ) {
+ $actString->[$line] = '' unless defined $actString->[$line] or Irssi::settings_get_bool('wlstat_all_disable');
+
+ # all stolen from chanact, what does this code do and why do we need it ?
+ !ref($win) && next;
+
+ my $name = $win->get_active_name;
+ my $active = $win->{'active'};
+ my $colour = $win->{'hilight_color'};
+ if (!defined $colour) { $colour = ''; }
+
+ if ($win->{'data_level'} < Irssi::settings_get_int('wlstat_hide_data')) { next; } # for Geert
+ if ($win->{'data_level'} == 0) { $hilight = '{sb_act_none '; }
+ elsif ($win->{'data_level'} == 1) { $hilight = '{sb_act_text '; }
+ elsif ($win->{'data_level'} == 2) { $hilight = '{sb_act_msg '; }
+ elsif ($colour ne '') { $hilight = "{sb_act_hilight_color $colour "; }
+ elsif ($win->{'data_level'} == 3) { $hilight = '{sb_act_hilight '; }
+ else { $hilight = '{sb_act_special '; }
+
+ $number = $win->{'refnum'};
+ $display = (defined $keymap{$number} and $keymap{$number} ne '')
+ ?
+ (
+ Irssi::settings_get_str('wlstat_display_key')
+ ||
+ Irssi::settings_get_str('wlstat_display_nokey')
+ )
+ :
+ Irssi::settings_get_str('wlstat_display_nokey')
+ ;
+
+ my $add = expand($display,
+ C => ir_fe($name),
+ N => $number,
+ Q => ir_fe($keymap{$number}),
+ H => $hilight,
+ S => '}{sb_background}'
+ );
+ #$temp =~ s/\{\S+?(?:\s(.*?))?\}/$1/g;
+ #$temp =~ s/\\\\\\\\/\\/g; # XXX I'm actually guessing here, someone point me to docs please
+ $actString->[$line] = '' unless defined $actString->[$line];
+
+ # XXX how can I check whether the content still fits in the bar? this would allow
+ # XXX wlstatus to reside on a statusbar together with other items...
+ if (sb_length(ir_escape($actString->[$line] . $add)) >= $width) { # XXX doesn't correctly handle utf-8 multibyte ... help !!?
+ $actString->[$line] .= ' ' x ($width - sb_length(ir_escape($actString->[$line])));
+ $line++;
+ }
+ $actString->[$line] .= $add . $separator;
+ # XXX if I use these prints, output layout gets screwed up... why ?
+ #Irssi::print("line $line: ".$actString->[$line]);
+ #Irssi::print("temp $line: ".$temp);
+ }
+
+ # XXX the Irssi::print statements lead to the MOST WEIRD results
+ # e.g.: the loop gets executed TWICE for p > 0 ?!?
+ for (my $p = 0; $p < @$actString; $p++) { # wrap each line in {sb }, escape it properly, etc.
+ my $x = $actString->[$p];
+ $x =~ s/\Q$separator\E([ ]*)$/$1/;
+ #Irssi::print("[$p]".'current:'.join'.',split//,sb_strip(ir_escape($x,0)));
+ #Irssi::print("assumed length before:".sb_length(ir_escape($x,0)));
+ $x = "{sb $x}";
+ #Irssi::print("[$p]".'new:'.join'.',split//,sb_expand(ir_escape($x,0)));
+ #Irssi::print("[$p]".'new:'.join'.',split//,ir_escape($x,0));
+ #Irssi::print("assumed length after:".sb_length(ir_escape($x,0)));
+ $x = ir_escape($x);
+ #Irssi::print("[$p]".'REALnew:'.join'.',split//,sb_strip($x));
+ $actString->[$p] = $x;
+ # XXX any Irssi::print debug statement leads to SEGFAULT (sometimes) - why ?
+ }
+ #Irssi::print("remake [ $xx ] finished");
+}
+
+sub wlstatHasChanged () {
+ $globTime = undef;
+ my $temp = Irssi::settings_get_str('wlstat_placement').Irssi::settings_get_int('wlstat_position');
+ if ($temp ne $resetNeeded) { wlreset(); return; }
+ #Irssi::print("wlstat has changed, calls to remake so far: $callcount");
+ $needRemake = 1;
+
+ #remake();
+ if (
+ ($needRemake and Irssi::settings_get_bool('wlstat_all_disable'))
+ or
+ (!Irssi::settings_get_bool('wlstat_all_disable') and $currentLines < 1)
+ ) {
+ $needRemake = undef;
+ remake();
+ }
+ # XXX Irssi crashes if I try to do this without timer, why ? What's the minimum delay I need to use in the timer ?
+ Irssi::timeout_add_once(100, 'syncLines', undef);
+
+ for (keys %statusbars) {
+ Irssi::statusbar_items_redraw("wlstat$_");
+ }
+}
+
+sub eventChanged () { # Implement a change queue/blocker -.-)
+ if (defined $globTime) {
+ Irssi::timeout_remove($globTime);
+ } # delay the update further
+ $globTime = Irssi::timeout_add_once(10, 'wlstatHasChanged', undef);
+}
+
+#$needRemake = 1;
+sub resizeTerm () {
+ Irssi::timeout_add_once(100, 'eventChanged', undef);
+}
+
+Irssi::settings_add_str('wlstat', 'wlstat_display_nokey', '[$N]$H$C$S');
+Irssi::settings_add_str('wlstat', 'wlstat_display_key', '[$Q=$N]$H$C$S');
+Irssi::settings_add_str('wlstat', 'wlstat_separator', "\\ ");
+Irssi::settings_add_int('wlstat', 'wlstat_hide_data', 0);
+Irssi::settings_add_int('wlstat', 'wlstat_maxlines', 9);
+Irssi::settings_add_str('wlstat', 'wlstat_sort', 'refnum');
+Irssi::settings_add_str('wlstat', 'wlstat_placement', 'bottom');
+Irssi::settings_add_int('wlstat', 'wlstat_position', 0);
+Irssi::settings_add_bool('wlstat', 'wlstat_all_disable', 0);
+
+# remove old statusbars
+my %killBar;
+sub get_old_status {
+ my ($textDest, $cont, $cont_stripped) = @_;
+ if ($textDest->{'level'} == 524288 and $textDest->{'target'} eq '' and !defined($textDest->{'server'})) {
+ if ($cont_stripped =~ m/^wl(\d+)\s/) { $killBar{$1} = {}; }
+ Irssi::signal_stop();
+ }
+}
+sub killOldStatus {
+ %killBar = ();
+ Irssi::signal_add_first('print text' => 'get_old_status');
+ Irssi::command('statusbar');
+ Irssi::signal_remove('print text' => 'get_old_status');
+ remove_statusbar(keys %killBar);
+}
+#killOldStatus();
+
+sub wlreset {
+ $actString = [];
+ $currentLines = 0; # 1; # mhmmmm .. we actually enable one line down there so let's try this.
+ $resetNeeded = Irssi::settings_get_str('wlstat_placement').Irssi::settings_get_int('wlstat_position');
+ #update_keymap();
+ killOldStatus();
+ # Register statusbar
+ #add_statusbar(0);
+ #Irssi::command('statusbar wl0 enable');
+ resizeTerm();
+}
+
+wlreset();
+
+my $Unload;
+sub unload ($$$) {
+ $Unload = 1;
+ Irssi::timeout_add_once(10, sub { $Unload = undef; }, undef); # pretend we didn't do anything ASAP
+}
+Irssi::signal_add_first('gui exit' => sub { $Unload = undef; }); # last try to catch a sigsegv
+sub UNLOAD {
+ if ($Unload) { # this might well crash Irssi... try /eval /script unload someotherscript ; /quit (= SEGFAULT !)
+ $actString = ['']; # syncLines(); # XXX Irssi crashes when trying to disable all statusbars ?
+ killOldStatus();
+ }
+}
+
+sub addPrintTextHook { # update on print text
+ return if $_[0]->{'level'} == 262144 and $_[0]->{'target'} eq '' and !defined($_[0]->{'server'});
+ if (Irssi::settings_get_str('wlstat_sort') =~ /^[-!]?last_line$/) {
+ Irssi::timeout_add_once(100, 'eventChanged', undef);
+ }
+}
+
+#sub _x { my ($x, $y) = @_; ($x, sub { Irssi::print('-->signal '.$x); eval "$y();"; }) }
+#sub _x { @_ }
+Irssi::signal_add_first(
+ 'command script unload' => 'unload'
+);
+Irssi::signal_add_last({
+ 'setup changed' => 'eventChanged',
+ 'print text' => 'addPrintTextHook',
+ 'terminal resized' => 'resizeTerm',
+ 'setup reread' => 'wlreset',
+ 'window hilight' => 'eventChanged',
+});
+Irssi::signal_add({
+ 'window created' => 'eventChanged',
+ 'window destroyed' => 'eventChanged',
+ 'window name changed' => 'eventChanged',
+ 'window refnum changed' => 'eventChanged',
+ 'window changed' => 'eventChanged',
+ 'window changed automatic' => 'eventChanged',
+});
+
+#Irssi::signal_add('nick mode changed', 'chanactHasChanged'); # relicts
+
+###############
+###
+#
+# Changelog
+#
+# 0.5a
+# - add setting to also hide the last statusbar if empty (wlstat_all_disable)
+# - reverted to old utf8 code to also calculate broken utf8 length correctly
+# - simplified dealing with statusbars in wlreset
+#
+# 0.4d
+# - fixed order of disabling statusbars
+# - several attempts at special chars, without any real success
+# and much more weird new bugs caused by this
+# - setting to specify sort order
+# - reduced timeout values
+# - added wlstat_hide_data for Geert Hauwaerts ( geert@irssi.org ) :)
+# - make it so the dynamic sub is actually deleted
+# - fix a bug with removing of the last separator
+# - take into consideration parse_special
+#
+# 0.3b
+# - automatically kill old statusbars
+# - reset on /reload
+# - position/placement settings
+#
+# 0.2
+# - automated retrieval of key bindings (thanks grep.pl authors)
+# - improved removing of statusbars
+# - got rid of status chop
+#
+# 0.1
+# - rewritten to suit my needs
+# - based on chanact 0.5.5
+
diff --git a/scripts/wordcompletition.pl b/scripts/wordcompletition.pl
new file mode 100644
index 0000000..6dfeb4a
--- /dev/null
+++ b/scripts/wordcompletition.pl
@@ -0,0 +1,144 @@
+#!/usr/bin/perl
+use Irssi;
+use DBI;
+use DBD::SQLite;
+use strict;
+use vars qw($VERSION %IRSSI);
+$VERSION = "0.2";
+%IRSSI = (
+ authors => "Jesper Lindh",
+ contact => "rakblad\@midgard.liu.se",
+ name => "IRC Completion with mysql-database",
+ description => "Adds words from IRC to your tab-completion list",
+ license => "Public Domain",
+ url => "http://midgard.liu.se/~n02jesli/perl/",
+ changed => "2017-03-19",
+ modules => "DBD::SQLite"
+);
+
+my $bd= Irssi::get_irssi_dir();
+my $fndb="wordcompletition.db";
+#my ($dsn) = "DBI:mysql:yourdatabase:databashostname";
+my ($dsn) = "DBI:SQLite:dbname=$bd/$fndb";
+my ($user_name) = "";
+my ($password) = "";
+my ($dbh, $sth);
+my (@ary);
+my $query;
+my $connect = 1;
+$dbh = DBI->connect ($dsn, $user_name, $password, { RaiseError => 1 });
+
+$dbh->do("create table if not exists words (word varchar(30), prio int)");
+
+sub wordsearch
+{
+ my $sw = shift;
+ my @retar;
+ my $i = 0;
+ $query = qq{ select word from words where word like ? order by prio desc };
+ $sth = $dbh->prepare ( $query );
+ $sth->execute($sw.'%');
+ while (@ary = $sth->fetchrow_array ())
+ {
+ push @retar,$ary[0];
+ }
+ $sth->finish();
+ return @retar;
+};
+sub wordfind
+{
+ my $sw = shift;
+ my $ret;
+ $query = qq{ select word from words where word = ? };
+ $sth = $dbh->prepare ( $query );
+ $sth->execute($sw);
+ @ary = $sth->fetchrow_array;
+ $ret = join ("", @ary), "\n";
+ $sth->finish();
+ return $ret;
+};
+
+sub wordupdate
+{
+ my $sw = shift;
+ $query = qq { update words set prio = prio + 1 where word = ? };
+ $sth = $dbh->prepare ( $query );
+ $sth->execute($sw);
+ $sth->finish();
+};
+sub delword
+{
+ my $sw = shift;
+ $query = qq { delete from words where word = ? };
+ $sth = $dbh->prepare ( $query );
+ $sth->execute($sw);
+ $sth->finish();
+};
+sub addword
+{
+ my $sw = shift;
+ $query = qq { insert into words values (?, 1) };
+ $sth = $dbh->prepare ( $query );
+ $sth->execute($sw);
+ $sth->finish();
+};
+sub word_complete
+{
+ my ($complist, $window, $word, $linestart, $want_space) = @_;
+ $word =~ s/([^a-zA-Z0-9åäöÅÄÖ])//g;
+ push @$complist , wordsearch($word);
+};
+sub word_message
+{
+ my ($server, $message) = @_;
+ foreach my $word (split(' ', $message))
+ {
+ $word =~ s/([^a-zA-Z0-9åäöÅÄÖ])//g;
+ if (length($word) >= 4)
+ {
+ my $fword = wordfind($word);
+ if ($fword)
+ {
+ wordupdate($word);
+ }
+ else
+ {
+ addword($word);
+ };
+ };
+ };
+};
+sub cmd_delword
+{
+ my $dword = shift;
+ delword($dword);
+ print "Deleted $dword from database!";
+};
+sub cmd_sql_disconnect
+{
+ $dbh->disconnect();
+ print "Disconnected from sql-server";
+ $connect = 0;
+};
+sub cmd_sql_connect
+{
+ if ($connect != 0)
+ {
+ print "Connecting to sql-server";
+ $dbh = DBI->connect ($dsn, $user_name, $password, { RaiseError => 1 });
+ }
+ else
+ {
+ print "Already connected";
+ };
+};
+
+foreach my $cword ("message own_public", "message own_private")
+{
+ Irssi::signal_add($cword, "word_message");
+};
+Irssi::signal_add_last('complete word', 'word_complete');
+Irssi::command_bind("delword", "cmd_delword");
+Irssi::command_bind("sql_disconnect", "cmd_sql_disconnect");
+Irssi::command_bind("sql_connect", "cmd_sql_connect");
+
diff --git a/scripts/wordscramble.pl b/scripts/wordscramble.pl
new file mode 100644
index 0000000..a05cab3
--- /dev/null
+++ b/scripts/wordscramble.pl
@@ -0,0 +1,160 @@
+use Irssi;
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '0.0.3';
+%IRSSI = (
+ authors => 'Koenraad Heijlen',
+ contact => 'vipie@ulyssis.org',
+ commands => 'ws',
+ name => 'word_scramble',
+ description => 'A script that scrambles all the letters in a word except the first and last.',
+ license => 'GNU GPL version 2',
+ url => 'http://vipie.studentenweb.org/dev/irssi/wordscramble',
+ changed => '2018-05-11'
+);
+
+#--------------------------------------------------------------------
+# Changelog
+#--------------------------------------------------------------------
+#
+# word_scramble.pl 0.0.3 (2018-05-11)- bw1
+# - fixed the help bug
+#
+# word_scramble.pl 0.0.2 (2003-09-17)- Koenraad Heijlen
+# - fixed the four letter word bug
+# - fixed the non alphanummeric characters bug
+# - some improvement in returning \n
+#
+# word_scramble.pl 0.0.1 (2003-09-15) - Koenraad Heijlen
+# - first draft
+#
+#--------------------------------------------------------------------
+
+#--------------------------------------------------------------------
+# Public Variables
+#--------------------------------------------------------------------
+my %myHELP = ();
+
+
+#--------------------------------------------------------------------
+# Help function
+#--------------------------------------------------------------------
+sub cmd_help {
+ my ($about) = @_;
+
+ %myHELP = (
+ ws =>
+"%9ws - wordscramble%9
+
+ /ws <text>
+
+scrambles the text you type,
+and outputs it in the current (active) channel
+or query.
+",
+ );
+
+ if ( $about =~ /(ws)/i ) {
+ Irssi::print($myHELP{ws},MSGLEVEL_CLIENTCRAP);
+ Irssi::signal_stop;
+ }
+}
+
+#--------------------------------------------------------------------
+# scrambles one word
+#--------------------------------------------------------------------
+sub scrambleWord {
+ # 0 : first
+ # length : last-1
+ # length+1 : last
+ #substr EXPR,OFFSET,LENGTH,REPLACEMENT
+ my $l = 0;
+ my $r = 0;
+ my $out = "";
+ my $word = shift;
+ chomp($word);
+
+ if (length($word) <= 3) {
+ return $word;
+ }
+ my $l = length($word)-2;
+ $l = $l;
+ $out = substr($word,0,1);
+ while ($l != 1) {
+ $r = int(rand()*$l+1);
+
+ if ($r == 0) {
+ next;
+ }
+ #$r == $l is no marginalcase.
+
+ $out .= substr($word,$r,1);
+ substr($word,$r,1,substr($word,$l,1));
+ $l--;
+ }
+ $out .= substr($word,$l,1);
+ $out .= substr($word,length($word)-1,1);
+ return $out;
+}
+
+#--------------------------------------------------------------------
+# scrambles line
+#--------------------------------------------------------------------
+sub scrambleLine{
+ my $line = shift;
+ my $outline = "";
+ my $word = "";
+ my $i=0;
+ my @splitLine;
+
+ #we leave the \n at the end, less interference.
+ #chomp($line);
+ @splitLine=split(/(\W)/,$line);
+
+ # every other item in the array is the split string
+ for ($i=0; $i<= $#splitLine;$i++) {
+ $outline .= scrambleWord($splitLine[$i]);
+ $i++;
+ if ($i <= $#splitLine) {
+ $outline .= $splitLine[$i];
+ }
+ }
+ return $outline;
+}
+
+#--------------------------------------------------------------------
+# Defintion of /ws
+#--------------------------------------------------------------------
+sub cmd_ws {
+ my ($args, $server, $witem) = @_;
+
+ if (!$server || !$server->{connected}) {
+ Irssi::print("Not connected to server");
+ return;
+ }
+
+ my $scrambledLine = scrambleLine($args);
+ if ($witem && ($witem->{type} eq "CHANNEL" ||
+ $witem->{type} eq "QUERY")) {
+ # there's query/channel active in window
+ $witem->command("MSG ".$witem->{name}." $scrambledLine");
+ } else {
+ Irssi::print("Nick not given, and no active channel/query in window");
+ }
+}
+
+#--------------------------------------------------------------------
+# Irssi::Settings / Irssi::command_bind
+#--------------------------------------------------------------------
+
+Irssi::command_bind("ws", "cmd_ws", "Scramble Line");
+Irssi::command_bind("help","cmd_help", "Irssi commands");
+
+#--------------------------------------------------------------------
+# This text is printed at Load time.
+#--------------------------------------------------------------------
+
+#nothing
+
+#- end
diff --git a/scripts/xauth.pl b/scripts/xauth.pl
new file mode 100644
index 0000000..c4b13c0
--- /dev/null
+++ b/scripts/xauth.pl
@@ -0,0 +1,546 @@
+# Some code taken from `nickserv.pl' for convenience.
+# Credits Sami Haahtinen / ZaNaGa
+#
+
+# Don't forget to create the necessary chatnets in your irssi config file.
+#
+# Example:
+# ....
+# {
+# address = "irc.undernet.org";
+# chatnet = "Undernet";
+# port = "6668";
+# autoconnect = no;
+# }
+# .....
+#
+#
+# Then connect with the server like this:
+# /server undernet (or set autoconnect to yes)
+
+# Make sure you fill in *all* necessary information without typos.
+#
+# Files you need to edit after first run:
+# x.users -> For your x user/pw information.
+# x.channels -> Channels to join after authing. (optional)
+#
+# Use /xrehash to reload if you edit the files.
+#
+# Var:
+# my (%masks) -> See help there.
+
+# Tested with X versions
+# Undernet P10 Channel Services II Release 1.1pl7
+#
+
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file
+# COPYING (included with this distribution) or the GNU General Public
+# License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+
+use Irssi;
+use Irssi::Irc;
+
+use strict;
+
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.02';
+
+%IRSSI = (
+ authors => 'Toshio R. Spoor',
+ contact => 't.spoor@gmail.com',
+ name => 'xauth',
+ description => 'Undernet X Service Authentication Program',
+ license => 'GNU GPLv2 or later',
+ changed => '$Date: 2004/12/17 08:39:47 $'
+);
+
+my (%CONFIG) = (
+ autostart => '',
+ autojoin => '',
+ hiddenhost => ''
+);
+
+Irssi::theme_register([
+ xauth_rehash => '{comment $0} %KRehashing configuration files and settings%n',
+ xauth_autostart => '{comment $0} %KAuto-Start :%n $1',
+ xauth_autojoin => '{comment $0} %KAuto-Join :%n $1',
+ xauth_hiddenhost=> '{comment $0} %KHiddenhost :%n $1',
+ xauth_auth => '{comment $0} %KAuthorising%n $1 %Kwith%n $2 %Kon%n $3',
+ xauth_load => '{comment $0} %KScript %nv$1 %Kloaded ...%n',
+ xauth_nocon => '{comment $0} %KNot connected to server%n',
+ xauth_noconn => '{comment $0} %KThere does not exist a connection to $1%n',
+ xauth_success => '{comment $0} %KLogged in successfully on %n$1',
+ xauth_failed => '{comment $0} %KFailed to login on %n$1 ($2)',
+ xauth_already => '{comment $0} %KI am already logged in on%n $1',
+ xauth_nouser => '{comment $0} $1 %Kdoes not know who %n$2 %Kis on %n$3',
+ xauth_nohost => '{comment $0} %KNo hostmask found for %n$1%K, to fix this edit this script, see masks',
+ xauth_noentry => '{comment $0} %KI did not find an entry for %n$1 %Kcheck%n $2',
+ xauth_missing => '{comment $0} %KI am missing username, password or authentication host login information%n',
+ xauth_join => '{comment $0} %KJoined on%n $1%K : %n$2-'
+]);
+
+my ($usage) = qq!X-Authentication v$VERSION by Toshio Spoor
+
+Usage:
+/auth <chatnet>
+
+Settings:
+/set xauth Shows current settings
+/toggle xauth_autostart Toggle Auto Start
+/toggle xauth_autojoin Toggle Auto Join
+/toggle xauth_hiddenhost Toggle Hiddenhost (ircu u2.10.11+)
+
+Rehashing settings and user/channel file:
+/xrehash Run this after any changes
+ made to settings/files
+
+/save Make settings permanent
+!;
+
+# The `masks' hash is very important:
+# Here we fill in the masks we need to authenticate with.
+#
+# <chatnet> = <host> <authhost>
+#
+# You can find this very easily:
+# /msg x login
+#
+# 08:49 -!- Irssi: Starting query in Undernet with x
+# 08:49 <Foo> login
+# 08:49 -X(channels@undernet.org)- To use LOGIN, you must /msg X@services.undernet.org
+#
+# Keep the chatnet lowercase
+
+my (%masks) = (
+ undernet => [ 'cservice@undernet.org', 'X@channels.undernet.org' ],
+ worldirc => [ 'cservice@worldirc.org','X@channels.worldirc.org' ]
+);
+
+# 0 = None
+# 1 = Normal
+# 2 = More
+
+my ($verbose) = 1;
+
+# Don't touch these, unless the signature changes.
+#
+my ($success) = "AUTHENTICATION SUCCESSFUL";
+my ($already) = "Sorry, You are already authenticated";
+my ($failed) = "AUTHENTICATION FAILED";
+my ($remind) = "Remember: Nobody from CService will ever ask you for your password, do NOT give";
+my ($nouser) = "I don't know who";
+
+# Global Vars, don't change these.
+#
+my ($x_passfile) = Irssi::get_irssi_dir() ."/x.users";
+my ($x_chanfile) = Irssi::get_irssi_dir() ."/x.channels";
+
+my (@users) = ();
+my (@chans) = ();
+
+# Core Code
+#
+#
+
+sub putlog() {
+
+ my ($window) = Irssi::active_win();
+ Irssi::print("[$IRSSI{'name'}] @_", MSGLEVEL_CLIENTNOTICE);
+
+}
+
+sub haltdef() {
+
+ Irssi::signal_stop();
+
+}
+
+sub conn($) {
+
+ my ($server) = @_;
+
+ if (!$server || !$server->{connected}) {
+ return 0;
+ } else {
+ return 1;
+ }
+
+}
+
+sub join_channels($) {
+
+ my ($chatnet) = @_;
+ my (@channels) = ();
+ my ($server) = Irssi::server_find_tag($chatnet);
+
+ if (!$server) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_nocon", "$IRSSI{'name'}");
+ return;
+ }
+
+ foreach (@chans) {
+
+ my ($channel, $ircnet) = split(/:/);
+
+ if (lc($chatnet) eq lc($ircnet)) {
+ # If we do it like this, the status window stays active.
+ push (@channels, $channel);
+ $server->send_raw("JOIN #$channel");
+ }
+ }
+
+ if ($verbose) {
+ if (@channels) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_join", "$IRSSI{'name'}", $chatnet, @channels);
+ }
+ }
+}
+
+sub mask_check($) {
+
+ my ($address) = @_;
+
+ foreach my $key (keys %masks) {
+ if (lc($masks{$key}->[0]) eq lc($address)) {
+ return $key;
+ last;
+ }
+ }
+
+ return 0;
+
+}
+
+
+sub event_notice() {
+
+ my ($server, $args, $nick, $nickad) = @_;
+
+ return unless (&mask_check($nickad));
+
+ my ($cnet) = $server->{'tag'};
+ my ($version) = $server->{'version'};
+
+ my ($target, $data) = $args =~ /^(\S*)\s+:(.*)$/;
+
+ $_ = $data;
+
+ if (/^$already/i) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_already", "$IRSSI{'name'}", $cnet);
+ &haltdef();
+ }
+
+ if (/^$success/i) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_success", "$IRSSI{'name'}", $cnet);
+
+ if (($version) && ($CONFIG{'hiddenhost'})) {
+
+ my($app,$hi,$lo) = $version =~ /^(..).(..).(..)/;
+ $app =~ s/\D//g;
+
+ if (($app >= 2) && ($lo >= 11)) {
+ &putlog("Found ircu $version, setting umode +x") if ($verbose > 1);
+ $server->command("mode $target +x");
+ }
+ }
+
+ if ($CONFIG{'autojoin'}) {
+ &join_channels($cnet);
+ }
+ &haltdef();
+ }
+
+ if (/^$failed/i) {
+ if (/\((.*?)\)/) { $args = $1 };
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_failed", "$IRSSI{'name'}", $cnet, $args);
+ &haltdef();
+ }
+
+ if (/^$remind/i) {
+ &haltdef();
+ }
+
+ if (/^$nouser/i) {
+ if (/who\s(.*?)\s/) { $args = $1 };
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_nouser", "$IRSSI{'name'}", "$nick", $args, $cnet);
+ &haltdef();
+ }
+}
+
+sub cmd_auth() {
+
+ my ($data, $server, $witem) = @_;
+ my ($username, $ircnet, $password, $xlogin, $xmask, $chatnet, $found);
+
+ if ($data) {
+ $chatnet = $data;
+ } else {
+ &putlog("$usage");
+ return;
+ }
+
+ if (! &conn($server)) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_nocon", "$IRSSI{'name'}");
+ return;
+ }
+
+ my ($authserver) = Irssi::server_find_tag($chatnet);
+
+ if (! $authserver) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_noconn", "$IRSSI{'name'}", $chatnet);
+ return;
+ }
+
+ foreach (@users) {
+
+ ($username, $ircnet, $password) = split(/:/);
+
+ if (lc($ircnet) eq lc($chatnet)) {
+ $xmask = $masks{lc($ircnet)}->[0];
+ $xlogin = $masks{lc($ircnet)}->[1];
+
+ if ((!$xmask) || (!$xlogin)) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_nohost", "$IRSSI{'name'}", $chatnet);
+ return;
+ }
+
+ $found=1;
+ last;
+ }
+ }
+
+ if (! $found ) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_noentry", "$IRSSI{'name'}", $chatnet, qq/"$x_passfile"/);
+ return;
+ }
+
+ if (($username) && ($password) && ($xlogin)) {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_auth", "$IRSSI{'name'}", $username, $xlogin, $chatnet);
+ $authserver->send_raw("PRIVMSG $xlogin :login $username $password");
+ } else {
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_missing", "$IRSSI{'name'}");
+ }
+}
+
+# Code taken from nickserv.pl
+
+sub read_users() {
+ my $count = 0;
+
+ # Lets reset @users so we can call this as a function.
+ @users = ();
+
+ if (!(open XUSERS, "<", $x_passfile)) {
+ &create_users;
+ };
+ &putlog("Running checks on the userfile.") if ($verbose > 1);
+ # first we test the file with mask 066 (we don't actually care if the
+ # file is executable by others.. what could they do with it =)
+
+ # Well, according to my calculations umask 066 should be 54, go figure.
+
+ my $mode = (stat($x_passfile))[2];
+ if ($mode & 54) {
+ &putlog("your password file should be mode 0600. Go fix it!");
+ &putlog("use command: chmod 0600 $x_passfile");
+ }
+
+ # and then we read the userfile.
+ # apparently Irssi resets $/, so we set it here.
+
+ local $/ = "\n";
+ while( my $line = <XUSERS>) {
+ if( $line !~ /^(#|\s*$)/ ) {
+ my ($nick, $ircnet, $password) =
+ $line =~ /^\s*(\S+)\s+(\S+)\s+(.*?)$/;
+ push @users, "$nick:$ircnet:$password";
+ $count++;
+ }
+ }
+ &putlog("Found $count accounts") if ($verbose > 1);
+ close XUSERS;
+}
+
+sub create_users() {
+
+ &putlog("Creating basic userfile in $x_passfile. Edit File.");
+
+ if(!(open XUSERS, ">", $x_passfile)) {
+ &putlog("Unable to create file $x_passfile");
+ }
+
+ print XUSERS "# username and IrcNet Tag are case insensitive\n";
+ print XUSERS "#\n";
+ print XUSERS "# username IrcNet Tag Password\n";
+ print XUSERS "# -------- ---------- --------\n";
+
+ close XUSERS;
+ chmod 0600, $x_passfile;
+}
+
+sub create_chans() {
+ &putlog("Creating basic channelfile in $x_chanfile. Edit File.");
+ if(!(open NICKCHANS, ">", $x_chanfile)) {
+ &putlog("Unable to create file $x_chanfile");
+ }
+
+ print NICKCHANS "# This file should contain a list of all channels\n";
+ print NICKCHANS "# which you don't want to join until after you've\n";
+ print NICKCHANS "# successfully identified with x. This is\n";
+ print NICKCHANS "# useful if you have a hidden host (+x).\n";
+ print NICKCHANS "# Enter Channel without `#'\n";
+ print NICKCHANS "#\n";
+ print NICKCHANS "# Channel IrcNet Tag\n";
+ print NICKCHANS "# -------- ----------\n";
+
+ close NICKCHANS;
+ chmod 0600, $x_chanfile;
+}
+
+sub read_chans() {
+ my $count = 0;
+
+ # Lets reset @users so we can call this as a function.
+ @chans = ();
+
+ if (!(open NICKCHANS, "<", $x_chanfile)) {
+ create_chans;
+ };
+ &putlog("Running checks on the channelfile.") if ($verbose > 1);
+ # first we test the file with mask 066 (we don't actually care if the
+ # file is executable by others.. what could they do with it =)
+
+ # Well, according to my calculations umask 066 should be 54, go figure.
+
+ my $mode = (stat($x_chanfile))[2];
+ if ($mode & 54) {
+ &putlog("your channels file should be mode 0600. Go fix it!");
+ &putlog("use command: chmod 0600 $x_chanfile");
+ }
+
+ # and then we read the channelfile.
+ # apparently Irssi resets $/, so we set it here.
+
+ local $/ = "\n";
+ while( my $line = <NICKCHANS>) {
+ if( $line !~ /^(#|\s*$)/ ) {
+ my ($channel, $ircnet) =
+ $line =~ /\s*(\S+)\s+(\S+)/;
+ push @chans, "$channel:$ircnet";
+ $count++;
+ }
+ }
+ &putlog("Found $count channels") if ($verbose > 1);
+ close NICKCHANS;
+}
+
+# End code from nickserv.pl
+
+sub event_connect() {
+
+ $CONFIG{'autostart'} = Irssi::settings_get_bool('xauth_autostart');
+
+ return unless ($CONFIG{'autostart'});
+
+ my ($server) = @_;
+ my ($cnet) = $server->{'tag'};
+ my ($found);
+
+ foreach my $key (keys %masks) {
+ if (lc($key) eq lc($cnet)) {
+ $found=1;
+ last;
+ }
+ }
+
+ return unless($found);
+
+ $server->command("auth $cnet");
+
+}
+
+sub x_rehash() {
+
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_rehash", "$IRSSI{'name'}") if (($verbose) && (@_));
+
+ &read_users();
+ &read_chans();
+ &get_set(@_);
+
+}
+
+sub init_set() {
+
+ Irssi::settings_add_bool('misc', 'xauth_autostart', '0');
+ Irssi::settings_add_bool('misc', 'xauth_autojoin', '1');
+ Irssi::settings_add_bool('misc', 'xauth_hiddenhost','0');
+
+}
+
+sub onoff($) {
+
+ my ($value) = @_;
+
+ if ($value) {
+ return "On";
+ } else {
+ return "Off";
+ }
+
+}
+
+sub get_set() {
+
+ $CONFIG{'autostart'} = Irssi::settings_get_bool('xauth_autostart');
+ $CONFIG{'autojoin'} = Irssi::settings_get_bool('xauth_autojoin');
+ $CONFIG{'hiddenhost'} = Irssi::settings_get_bool('xauth_hiddenhost');
+
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_autostart", "$IRSSI{'name'}", &onoff("$CONFIG{'autostart'}")) if (($verbose) && (@_));
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_autojoin", "$IRSSI{'name'}", &onoff("$CONFIG{'autojoin'}")) if (($verbose) && (@_));
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_hiddenhost", "$IRSSI{'name'}", &onoff("$CONFIG{'hiddenhost'}")) if (($verbose) && (@_));
+
+}
+
+sub init() {
+
+ &init_set();
+ &x_rehash();
+
+
+}
+
+sub x_help() {
+
+ &putlog("$usage");
+
+}
+
+
+# Main
+#
+#
+
+&init();
+
+Irssi::command_bind("auth", "cmd_auth");
+Irssi::command_bind("xrehash", "x_rehash");
+Irssi::command_bind("xhelp", "x_help");
+
+Irssi::signal_add("event notice", "event_notice");
+Irssi::signal_add("event connected", "event_connect");
+
+Irssi::printformat(MSGLEVEL_CLIENTNOTICE, "xauth_load", "$IRSSI{'name'}", $VERSION);
diff --git a/scripts/xcmd.pl b/scripts/xcmd.pl
new file mode 100644
index 0000000..e4cd7f2
--- /dev/null
+++ b/scripts/xcmd.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+# X is the Undernet bot
+# This script is meant to make X commands easier and faster to use.
+#
+# Copyright 2003 Clément Hermann <clement.hermann@free.fr>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi qw(command_bind signal_add);
+
+$VERSION = '0.2';
+%IRSSI = (
+authors => 'Clément "nodens" Hermann',
+contact => 'clement.hermann@free.fr',
+name => 'Xcmd',
+description => 'makes Undernet\'s X commands easier and faster to use',
+license => 'GPLv2',
+changed => $VERSION,
+commands => 'xcmd',
+);
+
+sub help {
+ Irssi::print("xcmd launch an X command (/MSG X <command>), using the current windows as channel name.");
+ Irssi::print("Any command that have a <channel> parameter can be used.");
+ Irssi::print("/Xcmd showcommands show X commands for the current channel.");
+}
+
+sub xcommand {
+ my ($data, $server, $witem) = @_;
+ my $channel;
+
+ if (! $data) {
+ &help;
+ } else {
+ my @params = split (/ /,$data);
+ my $cmd = shift @params;
+ my $args = join (" ",@params);
+
+ if ($witem && ($witem->{type} eq "CHANNEL")) {
+ $channel = $witem->{name};
+ $witem->command("MSG X $cmd $channel $args");
+ } else {
+ Irssi::print("No active channel in window");
+ }
+ }
+}
+
+Irssi::command_bind('xcmd', 'xcommand');
+
+Irssi::print("Xcmd $VERSION by nodens. Try /xcmd for help");
diff --git a/scripts/xdccget.pl b/scripts/xdccget.pl
new file mode 100644
index 0000000..b6d396c
--- /dev/null
+++ b/scripts/xdccget.pl
@@ -0,0 +1,650 @@
+# Original version by Stefan "tommie" Tomanek <stefan@kann-nix.org>
+# Enhanced with max. download limits, retries, pausing, searching and other neat stuff by Obfuscoder (obfuscoder@obfusco.de)
+# You can find the script on GitHub: https://github.com/obfuscoder/irssi_scripts
+# Please report bugs to https://github.com/obfuscoder/irssi_scripts/issues
+
+use strict;
+use warnings;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "20141016";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek, Obfuscoder",
+ contact => "obfuscoder\@obfusco.de",
+ name => "xdccget",
+ description => "enhanced downloading, queing, searching from XDCC bots",
+ license => "GPLv2",
+ changed => "$VERSION",
+ commands => "xdccget"
+);
+
+use Irssi 20020324;
+
+use vars qw(@queue @completed %offers $timer $debug %lists);
+
+Irssi::settings_add_str($IRSSI{'name'}, 'xdccget_config_path', "$ENV{HOME}/.irssi");
+Irssi::settings_add_int($IRSSI{'name'}, 'xdccget_max_downloads', 2);
+Irssi::settings_add_int($IRSSI{'name'}, 'xdccget_retry_time', 5);
+
+$debug=0;
+my $config_path = Irssi::settings_get_str('xdccget_config_path');
+my $max_downloads = Irssi::settings_get_int('xdccget_max_downloads');
+my $queue_file = "$config_path/xdccget.queue";
+sub saveQueue {
+ if (!open (QUEUE, q{>}, $queue_file)) {
+ print CLIENTCRAP "XDCCGET - ERROR! Cannot open queue file for saving at $queue_file. $!";
+ return;
+ }
+ foreach (@queue) {
+ print QUEUE $_->{net}."\t".$_->{nick}."\t".$_->{pack}."\t".$_->{filename}."\t".$_->{xdcc}."\n";
+ }
+ if (!close QUEUE) {
+ print CLIENTCRAP "XDCCGET - ERROR! Could not close queue file after saving at $queue_file. $!";
+ }
+}
+
+sub loadQueue {
+ @queue = ();
+ if (!open (QUEUE, q{<}, $queue_file)) {
+ print CLIENTCRAP "XDCCGET - Warning: Could open queue file for loading from $queue_file: $!";
+ return;
+ }
+ while (<QUEUE>) {
+ chomp;
+ my ($net, $nick, $pack, $desc, $xdcc) = split (/\t/);
+ if ($xdcc eq "") {
+ $xdcc = "xdcc";
+ }
+ my %transfer = (
+ 'nick' => $nick,
+ 'pack' => $pack,
+ 'status' => 'waiting',
+ 'net' => $net,
+ 'pos' => 0,
+ 'try' => 0,
+ 'etr' => 0,
+ 'timer' => undef,
+ 'xdcc' => $xdcc,
+ 'filename' => $desc,
+ );
+ push @queue, \%transfer;
+ }
+ if (!close QUEUE) {
+ print CLIENTCRAP "XDCCGET - ERROR! Could not close queue file after loading at $queue_file. $!";
+ }
+}
+
+sub debugFunc {
+ return unless ($debug);
+ my $funcname = shift (@_);
+ print CLIENTCRAP "XDCC-DEBUG - $funcname (". join(",",@_).")\n";
+}
+
+sub show_help() {
+ my $help="XDCCget $VERSION
+ Commands:
+
+ /xdccget queue <nickname> <number> [[-xdcc=<method>] <description>]
+ Queue the specified pack of the currently selected server and 'Nickname'.
+ The description will be shown in the queue.
+ With -xdcc=<method> it is possible to specify the method to be used in the request.
+ Default is 'xdcc' as in /msg <nickname> xdcc send <number>
+
+ /xdccget stat
+ /xdccget
+ /xdccget -l
+ List the download queue
+
+ /xdccget list <nickname>
+ Request the XDCC list of <nickname>
+
+ /xdccget cancel <number>
+ Cancel the download if currently downloading, request to being removed from queue
+ if queued by the XDCC offerer, or remove pack <number> from the download queue
+
+ /xdccget pause <number>
+ Pause pack <number> within the local queue. Resume with reset
+
+ /xdccget reset <number>
+ Reset pack <number> so that it is unpaused and --
+ if download slots are still available -- triggers a download request
+
+ /xdccget offers [<options>] <description search pattern>
+ Display all the announced offers matching the given pattern or options.
+ The announcements are continuously monitored by this script throughout all joined channels.
+
+ Options:
+ One or more of the following options can be used. Each option must start with a '-':
+
+ -server=<server pattern> only show offers announced by bots on servers matching this pattern
+ -channel=<channel pattern> only show offers announced by bots on channels matching this pattern
+ -nick=<nick pattern> only show offers announced by bots with nicks matching this pattern
+
+ Examples:
+ /xdccget offers iron.*bluray
+ /xdccget offers -nick=bot iron.*bluray
+ /xdccget offers -channel=beast-xdcc iron.*bluray
+
+ Regular expressions are used to match each of the parameters.
+
+ /xdccget help
+ Display this help
+
+ You can also simply use /x instead of /xdccget ;-)
+
+ Configuration:
+
+ xdccget_config_path
+ Path where this script is storing its files (queue and finished downloads).
+ Default is '\$HOME/.irssi'.
+
+ xdccget_max_downloads
+ Maximum number of parallel downloads. Default is 2. A download request which is queued
+ by the XDCC offer bot does not count against the limit. The next item in the download queue
+ is being requested as long as download slots are available. Also other downloads not controlled
+ by this script do not count either. It is also possible to exceed this limit if a bot sends the
+ previously requested and queued file while there are downloads running already.
+
+ xdccget_retry_time
+ Time in minutes between retries. Default is 5. Retries are necessary for full
+ offer queues of bots, bots being/becoming offline, or not getting the requested download or any
+ understandable message regarding the request. Please DO NOT set this value to less than 300
+ (5 minutes) or risk being banned from the channels for spamming the bots.
+
+ Please report bugs to https://github.com/obfuscoder/irssi_scripts/issues
+";
+ my $text = '';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP &draw_box("XDCCget", $text, "help", 1);
+}
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ my $exp_flags = Irssi::EXPAND_FLAG_IGNORE_EMPTY | Irssi::EXPAND_FLAG_IGNORE_REPLACES;
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ if (defined($text)) {
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub contains {
+ my ($item, @list) = @_;
+ foreach (@list) {
+ ($item eq $_) && return 1;
+ }
+ return 0;
+}
+
+sub event_message_irc_notice {
+ debugFunc ("event_message_irc_notice", @_);
+ my ($server, $msg, $nick, $address, $target) = @_;
+ my $i;
+ $_ = $msg;
+ for ($i=0; $i<= $#queue; $i++) {
+ if ($queue[$i] && lc($nick) eq lc($queue[$i]->{'nick'})) {
+ if (/Closing Connection/) {
+ print CLIENTCRAP "%R>>%n XDCC-Transfer closed";
+ # Is it a canceled transfer?
+ if ($queue[$i]->{'status'} eq 'canceling') {
+ $queue[$i]->{'status'} = 'cancelled';
+ } elsif ($queue[$i]->{'status'} ne 'paused') {
+ # We should try again unless we paused the queue item
+ $queue[$i]->{'status'} = 'waiting';
+ }
+ } elsif (/Transfer Completed/i) {
+ print CLIENTCRAP "%R>>%n XDCC-Transfer completed";
+ # Mark the transfer as completed
+ $queue[$i]->{'status'} = 'completed';
+ } elsif (/You already requested that pack/i) {
+ $queue[$i]->{'status'} = 'transferring';
+ } elsif (/You already have that item queued/i) {
+ $queue[$i]->{'status'} = 'queued';
+ } elsif (/Sending (?:You|u) (?:Your Queued )?Pack/i) {
+ $queue[$i]->{'status'} = 'transferring';
+ print CLIENTCRAP "%R>>%n XDCC-Transfer starting";
+ } elsif (/All Slots Full, Added (|you to the main )queue in position ([0-9]*)/i) {
+ $queue[$i]->{'pos'} = $2;
+ $queue[$i]->{'etr'} = 0;
+ $queue[$i]->{'status'} = 'queued';
+ } elsif (/You have been queued for ([0-9]*?) hr ([0-9]*?) min, currently in main queue position ([0-9]*?) of ([0-9]*?)\. Estimated remaining time is ([0-9]*?) hr ([0-9]*?) min or (less|more)\./i) {
+ $queue[$i]->{'pos'} = $3;
+ $queue[$i]->{'etr'} = time() + (($5*60)+$6)*60;
+ $queue[$i]->{'status'} = 'queued';
+ } elsif (/You have been queued for ([0-9]*?) hours ([0-9]*?) minutes, currently in main queue position ([0-9]*?) of ([0-9]*?)\./i) {
+ $queue[$i]->{'pos'} = $3;
+ $queue[$i]->{'status'} = 'queued';
+ } elsif (/You have been queued for ([0-9]*?) minutes, currently in main queue position ([0-9]*?) of ([0-9]*?)\./i) {
+ $queue[$i]->{'status'} = 'queued';
+ # FIXME unite somehow with regexp above
+ $queue[$i]->{'pos'} = $2;
+ } elsif (/It has been placed in queue slot #(\d+), it will send when sends are available/i) {
+ $queue[$i]->{'pos'} = $1;
+ $queue[$i]->{'status'} = 'queued';
+ } elsif (/Invalid Pack Number/i) {
+ $queue[$i]->{'status'} = 'invalid';
+ } elsif (/The Owner Has Requested That No New Connections Are Made/i ||
+ /All Slots Full,( Main)? queue of size [0-9]* is Full, Try Again Later/i ||
+ /You can only have 1 transfer at a time/i ||
+ /you must be on a known channel/i) {
+ print CLIENTCRAP "Retrying ....\n";
+ my $retry = Irssi::settings_get_int('xdccget_retry_time')*60000;
+ $queue[$i]->{'status'} = 'retrying';
+ $queue[$i]->{'timer'} = Irssi::timeout_add($retry, 'retry_transfer', $i);
+ $queue[$i]->{'etr'} = time()+$retry/1000;
+ } elsif (/must be on a known channel/i) {
+ $server->command("WHOIS $nick");
+ $queue[$i]->{'status'} = 'joining';
+ } else { Irssi::print($_) if ($debug); }
+ process_queue();
+ last;
+ }
+ }
+ if (/#(\d+).+?\d+x \[ *(<?\d+.*?)\] +(.*)$/) {
+ my ($pack, $size, $name) = ($1, $2, $3);
+ if (defined $lists{lc $server->{tag}}{lc $nick}) {
+ $lists{lc $server->{tag}}{lc $nick}{$pack} = $name;
+ }
+ foreach (@queue) {
+ next unless lc $nick eq lc $_->{nick};
+ next unless lc $server->{tag} eq lc $_->{net};
+ next unless $_->{pack} eq $pack;
+ $_->{filename} = $name;
+ }
+ }
+}
+
+sub process_queue {
+ debugFunc ("process_queue", @_);
+ my ($i, $j, $numdls);
+ $numdls = 0;
+ my $process;
+ unless (scalar(@queue) > 0) {return 0};
+ for ($i=0; $i<= $#queue; $i++) {
+ debugFunc (" - Item: $i -> ".$queue[$i]{'status'});
+ if ($queue[$i]{'status'} eq 'completed' ||
+ $queue[$i]{'status'} eq 'cancelled') {
+ push (@completed, $queue[$i]);
+ my $done_file = "$config_path/xdccdone.txt";
+ if (!open (DONEFILE, q{>>}, $done_file)) {
+ print CLIENTCRAP "XDCCGET - Warning: Could not open file for appending done queue entry at $done_file. $!";
+ } else {
+ print DONEFILE $queue[$i]{net}."\t".$queue[$i]{nick}."\t".$queue[$i]{pack}."\t".$queue[$i]{filename}."\t".$queue[$i]{'status'}."\n";
+ if (!close (DONEFILE)) {
+ print CLIENTCRAP "XDCCGET - Warning: Could not close file after appending done queue entry at $done_file. $!";
+ }
+ }
+ splice (@queue, $i, 1);
+ } else {
+ if ($queue[$i]{'status'} eq 'waiting') {
+ $process = 1;
+ for ($j=0; $j<$i; $j++) {
+ if ($queue[$i]{'nick'} eq $queue[$j]{'nick'}) {
+ $process = 0;
+ }
+ }
+ if ($numdls >= $max_downloads) {
+ $process = 0;
+ }
+ if ($process) {
+ my $server = Irssi::server_find_tag($queue[$i]{'net'});
+ if (defined($server)) {
+ $server->command('MSG '.$queue[$i]{'nick'}.' '.$queue[$i]{'xdcc'}.' send '.$queue[$i]{'pack'});
+ print CLIENTCRAP "%R>>%n XDCC Requesting queue item ".($i+1);
+ $queue[$i]->{'try'}++;
+ $queue[$i]->{'status'} = 'requested';
+ }
+ }
+ }
+ if ($queue[$i]{'status'} eq 'requested' ||
+ $queue[$i]{'status'} eq 'transferring') {
+ $numdls ++;
+ }
+ }
+ }
+ saveQueue();
+}
+
+sub retry_transfer {
+ my ($numdls,$i);
+ $numdls = 0;
+ for ($i=0; $i<= $#queue; $i++) {
+ if ($queue[$i]{'status'} eq 'requested' ||
+ $queue[$i]{'status'} eq 'transferring') {
+ $numdls ++;
+ }
+ if (defined ($queue[$i]->{'timer'})) {
+ Irssi::timeout_remove($queue[$i]->{'timer'});
+ undef ($queue[$i]->{'timer'});
+ if ($queue[$i]->{'status'} eq 'retrying' && $numdls < $max_downloads) {
+ $queue[$i]->{'status'} = 'waiting';
+ process_queue();
+ }
+ }
+ }
+}
+
+sub queue_pack {
+ debugFunc ("queue_pack", @_);
+ my ($args, $server, $witem) = @_;
+ my @args = split(/ /, $args, 3);
+ my $xdcc = "xdcc";
+ my ($nick, $pack, $desc);
+ if (ref $witem && $witem->{type} eq 'QUERY' && $args[0] =~ /^\d+$/) {
+ ($nick, $pack, $desc) = ($witem->{name}, $args[0], $args[1]);
+ } else {
+ ($nick, $pack, $desc) = @args;
+ }
+ if ($desc =~ /^-xdcc=(.+?) (.+)$/) {
+ $xdcc = $1;
+ $desc = $2;
+ }
+ my $status = 'waiting';
+ my $chatnet = $server->{tag};
+ my %transfer = ('nick' => $nick,
+ 'pack' => $pack,
+ 'status' => $status,
+ 'net' => $chatnet,
+ 'pos' => 0,
+ 'try' => 0,
+ 'etr' => 0,
+ 'timer' => undef,
+ 'xdcc' => $xdcc
+ );
+ if (defined $server->{tag} && defined $lists{lc $server->{tag}} && defined $lists{lc $server->{tag}}{lc $nick}{$_}) {
+ $transfer{filename} = $lists{lc $server->{tag}}{lc $nick}{$_};
+ }
+ if (defined ($desc)) {
+ $transfer{filename} = $desc;
+ }
+ push @queue, \%transfer;
+ process_queue();
+}
+
+sub list_xdcc_queue {
+ my $text;
+ my $i = 1;
+ foreach (@queue) {
+ my $current = $_;
+ my $botname = $current->{'nick'};
+ my $ircnet = $current->{'net'};
+ my $pack = $current->{'pack'};
+ my $status = $current->{'status'};
+ my $info = '';
+ my $etr = '';
+ if ($current->{'status'} eq 'queued') {
+ my $time = $current->{'etr'}-time();
+ my $hours = int($time / (60*60));
+ my $minutes = int( ($time-($hours*60*60))/60 );
+ my $seconds = int( ($time-($hours*60*60)-($minutes*60)) );
+
+ $etr = '('.$hours.' hours, '.$minutes.' minutes and '.$seconds.' seconds remaining)' if ($current->{'etr'} > 0);
+ $info = "[".$current->{'pos'}."]".' '.$etr;
+ } elsif ($current->{'status'} eq 'retrying') {
+ my $time = $current->{'etr'}-time();
+ my $hours = int($time / (60*60));
+ my $minutes = int( ($time-($hours*60*60))/60 );
+ my $seconds = int( ($time-($hours*60*60)-($minutes*60)) );
+
+ $etr = '('.$hours.' hours, '.$minutes.' minutes and '.$seconds.' seconds remaining)' if ($current->{'etr'} > 0);
+ $info = '['.$current->{'try'}.']'.' '.$etr;
+ }
+ $text .= "%9".$i."%9 ".$botname."<".$ircnet.">: Pack ".$pack;
+ $text .= " (".$current->{filename}.")" if defined $current->{filename};
+ $text .= " => ".$status.' '.$info;
+ $text .= "\n";
+ $i++;
+ }
+ print CLIENTCRAP draw_box("XDCCget", $text, "queued packs", 1);
+}
+
+sub cancel_pack {
+ my (@numbers) = @_;
+ @numbers = sort {$b cmp $a} @numbers;
+ foreach (@numbers) {
+ my $item = $queue[$_-1];
+ next if (!defined($item));
+
+ if ($item->{'status'} eq 'queued') {
+ # Remove the request from the bots queue
+ my $server = Irssi::server_find_tag($item->{'net'});
+ $server->command('MSG '.$item->{'nick'}.' xdcc remove');
+ print CLIENTCRAP "%R>>>%n Removing pack ".$_." from server queue";
+ $item->{'status'} = 'canceling';
+ #splice(@queue, $_,$_+1);
+ } elsif ($item->{'status'} eq 'transferring') {
+ $item->{'status'} = 'cancelled';
+ Irssi::command('dcc close get '.$item->{'nick'});
+ print CLIENTCRAP "%R>>>%n Transfer aborted";
+
+ } else {
+ debugFunc ("splice", $_);
+ splice(@queue, $_-1,1);
+ }
+ process_queue();
+ }
+}
+
+sub reset_pack {
+ foreach (@_) {
+ next if ($#queue < $_ || $_ < 0);
+ $queue[$_-1]->{'status'} = 'waiting';
+ }
+ process_queue();
+}
+
+sub pause_pack {
+ my $server = shift;
+ foreach (@_) {
+ next if ($#queue < $_ || $_ < 0);
+ if ($queue[$_-1]->{'status'} eq 'queued') {
+ $server->command('msg '.$queue[$_-1]->{'nick'}.' xdcc remove');
+ } elsif ($queue[$_-1]->{'status'} eq 'transferring') {
+ Irssi::command('dcc close get '.$queue[$_-1]->{'nick'});
+ }
+ $queue[$_-1]->{'status'} = 'paused';
+ }
+ process_queue();
+}
+
+sub list_packs ($$) {
+ my ($server, $bot) = @_;
+ $server->command('MSG '.$bot.' xdcc list');
+ $lists{lc $server->{tag}}{lc $bot} = {};
+}
+
+sub cmd_xdccget {
+ my ($args, $server, $witem) = @_;
+ my @arg = split(/ /, $args);
+
+ if ((scalar(@arg) == 0) or ($arg[0] eq '-l') or ($arg[0] eq 'stat')) {
+ list_xdcc_queue();
+ } elsif ($arg[0] eq 'queue') {
+ # queue files
+ shift @arg;
+ queue_pack("@arg", $server, $witem);
+ } elsif ($arg[0] eq 'list' && defined $arg[1]) {
+ list_packs($server, $arg[1]);
+ } elsif ($arg[0] eq 'cancel') {
+ shift @arg;
+ cancel_pack(@arg);
+ } elsif ($arg[0] eq 'reset') {
+ shift @arg;
+ reset_pack(@arg);
+ } elsif ($arg[0] eq 'pause') {
+ shift @arg;
+ pause_pack($server, @arg);
+ } elsif ($arg[0] eq 'help') {
+ show_help();
+ } elsif ($arg[0] eq 'offers') {
+ shift @arg;
+ show_offers(@arg);
+ }
+}
+
+sub event_private_message {
+ debugFunc ("event_private_message", @_);
+ my ($server, $text, $nick, $address) = @_;
+ event_message_irc_notice($server, $text, $nick, $address, undef);
+}
+
+sub event_no_such_nick {
+ debugFunc ("event_private_message", @_);
+ my ($server, $args, $sender_nick, $sender_address) = @_;
+ my ($myself, $nick) = split(/ /, $args, 3);
+
+ my $i;
+ for ($i=0; $i<= $#queue; $i++) {
+ if ($nick eq $queue[$i]->{'nick'}) {
+ if ($queue[$i]->{'status'} eq 'requested' || $queue[$i]->{'status'} eq 'joining') {
+ my $retry = Irssi::settings_get_int('xdccget_retry_time')*60000;
+ $queue[$i]->{'status'} = 'retrying';
+ $queue[$i]->{'timer'} = Irssi::timeout_add($retry, 'retry_transfer', $i);
+ $queue[$i]->{'etr'} = time()+$retry/1000;
+ }
+ }
+ process_queue();
+ }
+}
+
+sub event_server_connected {
+ my ($server) = @_;
+ debugFunc ("SERVER CONNECTED: " . $server->{'tag'});
+
+ my $i;
+ for ($i=0; $i<= $#queue; $i++) {
+ $queue[$i]->{'status'} = 'waiting' if (lc($queue[$i]->{'net'}) eq lc($server->{'tag'}));
+ }
+ process_queue();
+}
+
+sub event_server_disconnected {
+ my ($server) = @_;
+ debugFunc ("SERVER DISCONNECTED: " . $server->{'tag'});
+
+ my $i;
+ for ($i=0; $i<= $#queue; $i++) {
+ $queue[$i]->{'status'} = 'waiting' if (lc($queue[$i]->{'net'}) eq lc($server->{'tag'}));
+ }
+ process_queue();
+}
+
+sub show_offers {
+ my $server;
+ my $channel;
+ my $nick;
+ my $desc;
+ foreach (@_) {
+ if (/^-server=(.*?)$/) {
+ $server = $1;
+ } elsif (/^-channel=(.*?)$/) {
+ $channel = $1;
+ } elsif (/^-nick=(.*?)$/) {
+ $nick = $1;
+ } else {
+ $desc = $_;
+ }
+ }
+ my $text;
+ $text = "";
+ foreach my $s (keys %offers) {
+ next unless (!defined($server) || $s =~ /$server/i);
+ foreach my $c (keys %{$offers{$s}}) {
+ next unless (!defined($channel) || $c =~ /$channel/i);
+ foreach my $n (keys %{$offers{$s}{$c}}) {
+ next unless (defined($offers{$s}{$c}{$n}{'numpacks'}));
+ next unless (!defined($nick) || $n =~ /$nick/i);
+ my $text1 = "";
+ $text1 .= "$s $c $n - #$offers{$s}{$c}{$n}{'numpacks'}, Slots: $offers{$s}{$c}{$n}{'freeslots'}/$offers{$s}{$c}{$n}{'numslots'}";
+ $text1 .= ", Q: $offers{$s}{$c}{$n}{'posqueue'}/$offers{$s}{$c}{$n}{'numqueue'}" if (defined($offers{$s}{$c}{$n}{'posqueue'}));
+ $text1 .= ", Min: $offers{$s}{$c}{$n}{'minspeed'}" if (defined($offers{$s}{$c}{$n}{'minspeed'}));
+ $text1 .= ", Max: $offers{$s}{$c}{$n}{'maxspeed'}" if (defined($offers{$s}{$c}{$n}{'maxspeed'}));
+ $text1 .= ", Rec: $offers{$s}{$c}{$n}{'recspeed'}" if (defined($offers{$s}{$c}{$n}{'recspeed'}));
+ $text1 .= ", BW: $offers{$s}{$c}{$n}{'bwcurrent'}" if (defined($offers{$s}{$c}{$n}{'bwcurrent'}));
+ $text1 .= ", Rec: $offers{$s}{$c}{$n}{'bwrecord'}" if (defined($offers{$s}{$c}{$n}{'bwrecord'}));
+ $text1 .= ", Cap: $offers{$s}{$c}{$n}{'bwcapacity'}" if (defined($offers{$s}{$c}{$n}{'bwcapacity'}));
+ $text1 .= "\n";
+ my $text2 = "";
+ foreach my $p (sort {$a <=> $b} keys %{$offers{$s}{$c}{$n}{'packs'}}) {
+ next unless (!defined($desc) || $offers{$s}{$c}{$n}{'packs'}{$p}{'desc'} =~ /$desc/i);
+ $text2 .= " #$p x$offers{$s}{$c}{$n}{'packs'}{$p}{'numdl'} [$offers{$s}{$c}{$n}{'packs'}{$p}{'size'}] $offers{$s}{$c}{$n}{'packs'}{$p}{'desc'}\n";
+ }
+ next if (length($text2) == 0);
+ $text .= $text1.$text2;
+ }
+ }
+ }
+ print CLIENTCRAP draw_box("XDCCget", $text, "offers", 1);
+}
+
+sub event_message_public {
+ my ($server, $msg, $nick, $address, $target) = @_;
+
+ if ($msg =~ /.*?\*\*.*? (\d+) packs? .*?\*\*.*? (\d+) of (\d+) slots? open(?:, Queue: (\d+)\/(\d+))?(?:, Min: ((?:\d+|\.)+KB\/s))?(?:, Max: ((?:\d+|\.)+KB\/s))?(?:, Record: ((?:\d|\.)+KB\/s))?/i) {
+ $offers{$server->{'tag'}} = {} unless (defined($offers{$server->{'tag'}}));
+ $offers{$server->{'tag'}}{$target} = {} unless (defined($offers{$server->{'tag'}}{$target}));
+ $offers{$server->{'tag'}}{$target}{$nick} = {} unless (defined($offers{$server->{'tag'}}{$target}{$nick}));
+ $offers{$server->{'tag'}}{$target}{$nick}{'packs'} = {} unless (defined($offers{$server->{'tag'}}{$target}{$nick}{'packs'}));
+ $offers{$server->{'tag'}}{$target}{$nick}{'numpacks'} = $1 if (defined($1));
+ $offers{$server->{'tag'}}{$target}{$nick}{'freeslots'} = $2 if (defined($2));
+ $offers{$server->{'tag'}}{$target}{$nick}{'numslots'} = $3 if (defined($3));
+ $offers{$server->{'tag'}}{$target}{$nick}{'posqueue'} = $4 if (defined($4));
+ $offers{$server->{'tag'}}{$target}{$nick}{'numqueue'} = $5 if (defined($5));
+ $offers{$server->{'tag'}}{$target}{$nick}{'minspeed'} = $6 if (defined($6));
+ $offers{$server->{'tag'}}{$target}{$nick}{'maxspeed'} = $7 if (defined($7));
+ $offers{$server->{'tag'}}{$target}{$nick}{'recspeed'} = $8 if (defined($8));
+ }
+ if ($msg =~ /.*?\*\*.*? Bandwidth Usage .*?\*\*.*? Current: ((?:\d|\.)+KB\/s)(?:, Cap: ((?:\d|\.)+KB\/s))?(?:, Record: ((?:\d|\.)+KB\/s))?/) {
+ $offers{$server->{'tag'}} = {} unless (defined($offers{$server->{'tag'}}));
+ $offers{$server->{'tag'}}{$target} = {} unless (defined($offers{$server->{'tag'}}{$target}));
+ $offers{$server->{'tag'}}{$target}{$nick} = {} unless (defined($offers{$server->{'tag'}}{$target}{$nick}));
+ $offers{$server->{'tag'}}{$target}{$nick}{'packs'} = {} unless (defined($offers{$server->{'tag'}}{$target}{$nick}{'packs'}));
+ $offers{$server->{'tag'}}{$target}{$nick}{'bwcurrent'} = $1 if (defined($1));
+ $offers{$server->{'tag'}}{$target}{$nick}{'bwcapacity'} = $2 if (defined($2));
+ $offers{$server->{'tag'}}{$target}{$nick}{'bwrecord'} = $3 if (defined($3));
+ }
+
+ if ($msg =~ /\.*?#(\d+).*?\s+(\d+)x\s+\[\s*?((?:\d|\.)*(?:M|K|G))\]\s+(.+)/) {
+ $offers{$server->{'tag'}} = {} unless (defined($offers{$server->{'tag'}}));
+ $offers{$server->{'tag'}}{$target} = {} unless (defined($offers{$server->{'tag'}}{$target}));
+ $offers{$server->{'tag'}}{$target}{$nick} = {} unless (defined($offers{$server->{'tag'}}{$target}{$nick}));
+ $offers{$server->{'tag'}}{$target}{$nick}{'packs'} = {} unless (defined($offers{$server->{'tag'}}{$target}{$nick}{'packs'}));
+ $offers{$server->{'tag'}}{$target}{$nick}{'packs'}{$1} = {} unless (defined($offers{$server->{'tag'}}{$target}{$nick}{'packs'}{$1}));
+ $offers{$server->{'tag'}}{$target}{$nick}{'packs'}{$1}{'numdl'} = $2;
+ $offers{$server->{'tag'}}{$target}{$nick}{'packs'}{$1}{'size'} = $3;
+ $offers{$server->{'tag'}}{$target}{$nick}{'packs'}{$1}{'desc'} = $4;
+ }
+}
+
+Irssi::command_bind('xdccget', \&cmd_xdccget);
+
+loadQueue();
+
+foreach my $cmd ('queue', 'cancel', 'list', 'help', 'stat','reset','offers', 'pause') {
+ Irssi::command_bind('xdccget '.$cmd => sub {
+ cmd_xdccget("$cmd ".$_[0], $_[1], $_[2]);
+ });
+}
+
+Irssi::signal_add('message public', 'event_message_public');
+Irssi::signal_add('message irc notice', 'event_message_irc_notice');
+Irssi::signal_add("message private", "event_private_message");
+Irssi::signal_add("event 401", "event_no_such_nick");
+Irssi::signal_add("event connected", "event_server_connected");
+Irssi::signal_add("server disconnected", "event_server_disconnected");
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /xdccget help for help';
+
+print "Configuration files are stored in $config_path";
+
+if ($#queue >= 0) {
+ process_queue();
+}
diff --git a/scripts/xetra.pl b/scripts/xetra.pl
new file mode 100644
index 0000000..ae28266
--- /dev/null
+++ b/scripts/xetra.pl
@@ -0,0 +1,209 @@
+# by Stefan 'tommie' Tomanek <stefan@pico.ruhr.de>
+use strict;
+
+use vars qw($VERSION %IRSSI);
+$VERSION = "20030208";
+%IRSSI = (
+ authors => "Stefan 'tommie' Tomanek",
+ contact => "stefan\@pico.ruhr.de",
+ name => "Xetra",
+ description => "brings the stock exchanges of the world to your irssi",
+ license => "GPLv2",
+ changed => "$VERSION",
+ sbitems => "xetra",
+ commands => "xetra"
+);
+
+
+use Irssi 20020324;
+use Irssi::TextUI;
+use LWP::Simple;
+use vars qw($forked @ticker $shift $timer);
+
+sub draw_box ($$$$) {
+ my ($title, $text, $footer, $colour) = @_;
+ my $box = '';
+ $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
+ foreach (split(/\n/, $text)) {
+ $box .= '%R|%n '.$_."\n";
+ }
+ $box .= '%R`--<%n'.$footer.'%R>->%n';
+ $box =~ s/%.//g unless $colour;
+ return $box;
+}
+
+sub show_help() {
+ my $help=$IRSSI{name}." ".$VERSION."
+/xetra update
+ Retrieve new stock information for ticker
+/xetra get WKN/EXC
+ Retrieve data for stock <WKN> at stock exchange <EXC>
+";
+ my $text = '';
+ foreach (split(/\n/, $help)) {
+ $_ =~ s/^\/(.*)$/%9\/$1%9/;
+ $text .= $_."\n";
+ }
+ print CLIENTCRAP draw_box($IRSSI{name}." help", $text, "help", 1) ;
+}
+
+sub stock ($) {
+ if ($_[0] =~ /^(.*?)\/(.*?)$/) {
+ return $_[0];
+ } elsif ($_[0] =~ /^(.*?)\.(.*?)$/) {
+ return $_[0].'/'.$2;
+ } else {
+ my $exchange = Irssi::settings_get_str('xetra_default_stock_exchange');
+ return $_[0].'/'.$exchange if ($_[0] =~ /^\d+$/);
+ return $_[0].'.'.$exchange.'/'.$exchange;
+ }
+}
+
+sub get_stock ($$) {
+ my ($wkn, $exchange) = @_;
+ #my $data = get('http://informer2.comdirect.de/de/default/_pages/fokus/main.html?sSymbol='.$symbol);
+ my $data = get('http://informer2.comdirect.de/de/suche/main.html?nop=0&searchButton=Exakt&searchfor='.$wkn.'&XsearchBoersen='.$exchange);
+ my $stock;
+ if ($data =~ /&nbsp;WKN:&nbsp;(.*?)&nbsp;/) {
+ $stock->{wkn} = $1;
+ }
+ if ($data =~ /<th class="right">(&nbsp;|<img src="\/_common\/images\/pfeil_.*?\.gif" width=11 height=10 alt="">)&nbsp;(.*?)<\/th>/) {
+ $stock->{current} = $2;
+ }
+ if ($data =~ /<td align="right"><b><div class="color.*?"><nobr>&nbsp;(.*?)&nbsp;<\/nobr><\/div><\/b><\/td>/) {
+ $stock->{change} = $1;
+ }
+ if ($data =~ /Symbol:&nbsp;(.*?)</) {
+ $stock->{symbol} = $1;
+ }
+ if ($data =~ /B&ouml;rse:&nbsp;(.*?)&nbsp;/) {
+ $stock->{exchange} = $1;
+ }
+ if ($data =~ /<nobr>&nbsp;([0-9,+-]+\%)&nbsp;<\/nobr>/) {
+ $stock->{percent} = $1;
+ }
+ if ($data =~ /<td align="right">(\d+)\.(\d+)\.&nbsp;<\/td><td align="right">(\d+):(\d+)&nbsp;<\/td>/) {
+ $stock->{date} = $1.'.'.$2.'.';
+ $stock->{time} = $3.':'.$4;
+ }
+ return $stock;
+}
+
+sub bg_fetch ($$) {
+ my ($symbols, $job) = @_;
+ my ($rh, $wh);
+ pipe($rh, $wh);
+ return if $forked > 3;
+ $forked++;
+ my $pid = fork();
+ if ($pid > 0) {
+ close $wh;
+ Irssi::pidwait_add($pid);
+ my ($pipetag);
+ my @args = ($rh, \$pipetag, $job);
+ $pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
+ } else {
+ my $result;
+ foreach (@$symbols) {
+ $_ = stock($_);
+ my ($wkn, $exchange) = split('/', $_);
+ my $item = get_stock($wkn, $exchange);
+ push @$result, $item;
+ }
+ my $dumper = Data::Dumper->new([$result]);
+ $dumper->Purity(1)->Deepcopy(1);
+ my $data = $dumper->Dump;
+ print($wh $data);
+ close($wh);
+ POSIX::_exit(1);
+ }
+}
+
+sub pipe_input ($$$) {
+ my ($rh, $pipetag, $job) = @{$_[0]};
+ $forked--;
+ my $text;
+ $text .= $_ foreach (<$rh>);
+ close($rh);
+ Irssi::input_remove($$pipetag);
+ return unless($text);
+ no strict;
+ my $result = eval "$text";
+ return unless ref $result;
+ if ($job eq 'ticker') {
+ @ticker = @$result;
+ Irssi::statusbar_items_redraw('xetra');
+ } elsif ($job eq 'get') {
+ foreach (@$result) {
+ show_stock($_);
+ }
+ }
+}
+
+sub show_stock ($) {
+ my ($stock) = @_;
+ my $text;
+ $text .= '%9WKN:%9 '.$stock->{wkn}." (".$stock->{exchange}.")\n";
+ $text .= '%9Current:%9 '.$stock->{current}."\n";
+ $text .= '%9Change:%9 '.$stock->{change}.' ('.$stock->{percent}.")\n\n";
+ $text .= $stock->{date}.", ".$stock->{time}."\n";
+ print CLIENTCRAP &draw_box('Xetra stockinfo', $text, $stock->{symbol}, 1);
+}
+
+sub update_ticker {
+ my @stocks = split(/ /, Irssi::settings_get_str('xetra_ticker_stocks'));
+ bg_fetch(\@stocks, 'ticker');
+}
+
+sub show_ticker ($$) {
+ my ($item, $get_size_only) = @_;
+ $shift = 0 if $shift+1 > scalar(@ticker);
+ return unless defined $ticker[$shift];
+ my $tape;
+ $_ = $ticker[$shift];
+ $tape .= $_->{symbol}.': ';
+ $tape .= $_->{current}.' ';
+ if ($_->{change} =~ /^\+/) {
+ $tape .= '%g';
+ } elsif ($_->{change} =~ /^\-/) {
+ $tape .= '%r';
+ }
+ $tape .= $_->{change}.'%n';
+
+ $shift++ unless $get_size_only;
+ my $format = "{sb ".$tape."}";
+ $item->{min_size} = $item->{max_size} = length($tape);
+ $item->default_handler($get_size_only, $format, 0, 1);
+ Irssi::timeout_remove($timer);
+ $timer = Irssi::timeout_add(Irssi::settings_get_int('xetra_ticker_interval')*1000, 'update_ticker', undef);
+}
+
+sub cmd_xetra ($$$) {
+ my ($args, $server, $witem) = @_;
+ my @arg = split(/ /, $args);
+ return unless defined $arg[0];
+ if ($arg[0] eq 'get' && defined $arg[1]) {
+ shift(@arg);
+ bg_fetch(\@arg, 'get');
+ } elsif ($arg[0] eq 'update') {
+ update_ticker();
+ } elsif ($arg[0] eq 'help') {
+ show_help();
+ }
+}
+
+Irssi::statusbar_item_register('xetra', 0, 'show_ticker');
+
+Irssi::settings_add_str($IRSSI{name}, 'xetra_default_stock_exchange', 'ETR');
+Irssi::settings_add_str($IRSSI{name}, 'xetra_ticker_stocks', '');
+Irssi::settings_add_int($IRSSI{name}, 'xetra_ticker_interval', 3);
+
+Irssi::command_bind('xetra' => \&cmd_xetra);
+foreach my $cmd ('get', 'update', 'help') {
+ Irssi::command_bind('xetra '.$cmd => sub { cmd_xetra("$cmd ".$_[0], $_[1], $_[2]);});
+}
+
+$timer = Irssi::timeout_add(Irssi::settings_get_int('xetra_ticker_interval')*1000, 'update_ticker', undef);
+update_ticker();
+
+print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /xetra help for help';
diff --git a/scripts/xlist.pl b/scripts/xlist.pl
new file mode 100644
index 0000000..ace8ca6
--- /dev/null
+++ b/scripts/xlist.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+# (c) Matthäus 'JonnyBG' Wander <jbg@swznet.de>
+
+# Usage: Simply use /list as you always do
+
+use strict;
+use vars qw($VERSION %IRSSI);
+
+$VERSION = '1.00';
+%IRSSI = (
+ authors => 'Matthäus \'JonnyBG\' Wander',
+ contact => 'jbg@swznet.de',
+ name => 'xlist',
+ description => 'Better readable listing of channel names',
+ license => 'GPLv2',
+ url => 'http://jbg.swznet.de/xlist/',
+);
+
+use Irssi;
+
+my %xlist = ();
+
+sub collect {
+ my ($server, $data) = @_;
+
+ my (undef, $channel, $users, $topic) = split(/\s/, $data, 4);
+ $topic = substr($topic, 1);
+
+ $xlist{$channel} = [ $users, $topic ];
+}
+
+sub list {
+ my ($data, $server) = @_;
+ %xlist = ();
+
+ print "%K[%n".$server->{'tag'}."%K]%n %B<-->%n xlist";
+}
+
+sub show {
+ my ($server) = @_;
+ my ($printstring, $channel);
+
+ for $channel ( sort { ${ $xlist{$b} }[0] <=> ${ $xlist{$a} }[0] } keys %xlist ) {
+ $printstring = "%K[%n" . $server->{'tag'} . "%K]%n " .
+ sprintf("%4d", ${ $xlist{$channel} }[0]) .
+ " " . $channel;
+
+ if (length ${ $xlist{$channel} }[1] > 0 ) {
+ $printstring .= " %B->%n ". ${ $xlist{$channel} }[1];
+ }
+
+ print $printstring;
+ }
+
+ %xlist = ();
+
+ print "%K[%n".$server->{'tag'}."%K]%n %B<-->%n End of xlist";
+}
+
+Irssi::command_bind('list', \&list);
+Irssi::signal_add('event 322', \&collect);
+Irssi::signal_add('event 323', \&show);
+
+print "%B<-->%n xlist v$VERSION: Simply use /list as you always do";
diff --git a/scripts/xmms.pl b/scripts/xmms.pl
new file mode 100644
index 0000000..a18c2b9
--- /dev/null
+++ b/scripts/xmms.pl
@@ -0,0 +1,161 @@
+# XMMS-InfoPipe front-end - allow /np [dest]
+#
+# Thanks to ak for suggestions and even changes.
+#
+# /set xmms_fifo <dest of xmms-infopipe fifo>
+# /set xmms_format <format of printed text>
+# /set xmms_format_streaming <format for streams>
+# /set xmms_print_if_stopped <ON|OFF>
+# /set xmms_format_time <time format> - default is %m:%s
+#
+# xmms_format* takes these arguments:
+# Variable Name Example
+# ----------------------------------------------------
+# Song specific:
+# %status Status Playing
+# %title Title Blue Planet Corporation - Open Sea
+# %file File /mp3s/blue planet corporation - open sea.mp3
+# %length Length 9:13
+# %pos Position 0:08
+# %bitrate Bitrate 160kbps
+# %freq Sampling freq. 44.1kHz
+# %pctdone Percent done 1.4%
+# %channels Channels 2
+# Playlist specific:
+# %pl_total Total entries
+# %pl_current Position in playlist
+# ¤pl_pctdone Playlist Percent done
+use strict;
+use Irssi;
+use vars qw($VERSION %IRSSI);
+$VERSION = "2.0";
+%IRSSI = (
+ authors => 'Simon Shine',
+ contact => 'simon@blueshell.dk',
+ name => 'xmms',
+ description => 'XMMS-InfoPipe front-end - allow /np [-help] [dest]',
+ license => 'Public Domain',
+ changed => '2004-01-15'
+);
+
+Irssi::settings_add_str('xmms', 'xmms_fifo', '/tmp/xmms-info');
+Irssi::settings_add_str('xmms', 'xmms_format', 'np: %title at %bitrate [%pos of %length]');
+Irssi::settings_add_str('xmms', 'xmms_format_streaming', 'streaming: %title at %bitrate [%file]');
+Irssi::settings_add_str('xmms', 'xmms_format_time', '%m:%s');
+Irssi::settings_add_bool('xmms', 'xmms_print_if_stopped', 'yes');
+
+Irssi::command_bind('np', \&cmd_xmms);
+Irssi::command_bind('xmms', \&cmd_xmms);
+# Tab completition
+Irssi::command_bind('np help', \&cmd_xmms);
+Irssi::command_bind('xmms help', \&cmd_xmms);
+
+sub cmd_xmms {
+ my ($args, $server, $witem) = @_;
+
+ $args =~ s/^\s+//;
+ $args =~ s/\s+$//;
+
+ if ($args =~ /^help/) {
+ print CRAP q{
+Valid format strings for xmms_format and xmms_format_streaming:
+ %%status, %%title, %%file, %%length, %%pos, %%bitrate,
+ %%freq, %%pctdone, %%channels, %%pl_total, %%pl_current
+
+Example: /set xmms_format np: %%title at %%bitrate [%%pctdone]
+
+Valid format string for xmms_format_time:
+ %%m, %%s
+
+Example: /set xmms_format_time %%m minutes, %%s seconds
+};
+ return;
+ }
+
+ my ($xf) = Irssi::settings_get_str('xmms_fifo');
+ if (!-r $xf) {
+ if (!-r '/tmp/xmms-info') {
+ Irssi::print "Couldn't find a valid XMMS-InfoPipe FIFO.";
+ return;
+ }
+ $xf = '/tmp/xmms-info';
+ }
+
+ my %xi;
+
+ open(XMMS, "<", $xf);
+ while (<XMMS>) {
+ chomp;
+ my ($key, $value) = split /: /, $_, 2;
+ $xi{$key} = $value;
+ }
+ close(XMMS);
+
+ my %fs;
+
+ # %status
+ $fs{'status'} = $xi{'Status'};
+ # %title
+ if ($fs{'status'} ne "Playing") {
+ if (Irssi::settings_get_bool('xmms_print_if_stopped')) {
+ $fs{'title'} = sprintf('(%s) %s', $fs{'status'}, $xi{'Title'});
+ } else {
+ Irssi::print "XMMS is currently not playing.";
+ return;
+ }
+ } else {
+ $fs{'title'} = $xi{'Title'};
+ }
+ # %file
+ $fs{'file'} = $xi{'File'};
+ # %length
+ $fs{'length'} = &format_time($xi{'Time'});
+ # %pos
+ $fs{'pos'} = &format_time($xi{'Position'});
+ # %bitrate
+ $fs{'bitrate'} = sprintf("%.0fkbps", $xi{'Current bitrate'} / 1000);
+ # %freq
+ $fs{'freq'} = sprintf("%.1fkHz", $xi{'Samping Frequency'} / 1000);
+ # %pctdone
+ if ($xi{'uSecTime'} > 0) {
+ $fs{'pctdone'} = sprintf("%.1f%%%%", ($xi{'uSecPosition'} / $xi{'uSecTime'}) * 100);
+ } else {
+ $fs{'pctdone'} = "0.0%%";
+ }
+ # %channels
+ $fs{'channels'} = $xi{'Channels'};
+ # %pl_total
+ $fs{'pl_total'} = $xi{'Tunes in playlist'};
+ # %pl_current
+ $fs{'pl_current'} = $xi{'Currently playing'};
+ # %pl_pctdone
+ $fs{'pl_pctdone'} = sprintf("%.1f%%%%", ($fs{'pl_current'} / ($fs{'pl_total'} ? $fs{'pl_total'} : 1)) * 100);
+
+
+ my ($format) = ($xi{'uSecTime'} == "-1") ?
+ Irssi::settings_get_str('xmms_format_streaming') :
+ Irssi::settings_get_str('xmms_format');
+ foreach (keys %fs) {
+ $format =~ s/\%$_/$fs{$_}/g;
+ }
+
+ # sending it.
+ if ($server && $server->{connected} && $witem &&
+ ($witem->{type} eq "CHANNEL" || $witem->{type} eq "QUERY")) {
+ if ($args eq "") {
+ $witem->command("/SAY $format");
+ } else {
+ $witem->command("/MSG $args $format");
+ }
+ } else {
+ Irssi::print($format);
+ }
+}
+
+sub format_time {
+ my ($m, $s) = split /:/, @_[0], 2;
+ my ($format) = Irssi::settings_get_str('xmms_format_time');
+ $format =~ s/\%m/$m/g;
+ $format =~ s/\%s/$s/g;
+ return $format;
+}
diff --git a/scripts/xmms2.pl b/scripts/xmms2.pl
new file mode 100644
index 0000000..ce2c9d8
--- /dev/null
+++ b/scripts/xmms2.pl
@@ -0,0 +1,86 @@
+# XMMS/InfoPipe script for the Irssi client. You need a few things
+# installed before this script will work...
+# 1) Irssi, http://irssi.org/
+# 2) XMMS, http://www.xmms.org/
+# 3) InfoPipe, http://www.beastwithin.org
+# /users/wwwwolf/code/xmms/infopipe.html
+#
+# xmms2.pl is a version of xmms.pl slightly modified by Sir Robin,
+# sir@robsku.cjb.net / http://robsku.cjb.net/
+#
+# The script now outputs by default to the active window, instead of
+# status window. Also removed percentage meter as it didn't work. Only
+# two lines were modified and the original lines still exist, just
+# commented out.
+#
+# If you have trouble installing any of these, consult the READMEs that
+# come with the software, thank you.
+#
+# Fixed a few vital things adviced by kodgehopper at netscape dot net.
+# Very appreciated as I had no chance of testing a few of these things
+# myself. I hope everything works as it should now.
+#
+# Visit http://scripts.irssi.de/
+#
+# simon at blueshell dot dk
+use Irssi;
+use vars qw($VERSION %IRSSI);
+use strict;
+
+$VERSION = '1.1.3+1';
+%IRSSI = (
+ authors => 'simon',
+ contact => 'simon\@blueshell.dk',
+ name => 'XMMS-InfoPipe Script',
+ description => 'Returns XMMS-InfoPipe data',
+ license => 'Public Domain',
+ url => 'http://irssi.dk/',
+ changed => 'Mon Nov 27 18:00:00 CET 2006',
+ commands => '/np',
+ note => 'Make sure InfoPipe is configured!'
+);
+
+sub cmd_xmms {
+ my ($args, $server, $target) = @_;
+ $args =~ s/\s+$//; #fix unneeded whitespaces after output dest.
+
+ my (@t, $t, $ttotal, @pos, $pos, $postotal, $title);
+ open xmms, "<", '/tmp/xmms-info' || die; # if nothing happens, it probably
+ # failed here!
+
+ while(<xmms>) {
+ if(/^Time: (.*)$/) {
+ @t = split(/:/, $1);
+ $t = $1;
+ $t =~ s/^([0-9]*):([0-9]{2})$/\1m\2s/; # convert to nice format
+ $ttotal = $t[0] + $t[1]*60;
+ }
+ if(/^Position: (.*)$/) {
+ @pos = split(/:/, $1);
+ $postotal = $pos[0] + $pos[1]*60;
+ }
+ if(/^Title: (.*)$/) { $title = $1; }
+ }
+ close xmms;
+
+ if(!$ttotal || !$postotal) {
+ Irssi::print "An error occurred. Check if XMMS is running and your";
+ Irssi::print "InfoPipe module is running properly. If not, read how";
+ Irssi::print "to get these up and running by reading the script source";
+ die;
+ }
+
+ $pos = sprintf("%.0f", $postotal / $ttotal * 100); # calc. position
+# my $output = "np: $title ($pos% of $t)";
+ my $output = "np: $title ($t)";
+ $output =~ s/[\r\n]/ /g; # remove newline characters
+ if(!$server || !$server->{connected}) { # are we even connected?
+ Irssi::print $output;
+ return
+ }
+ if($args) { $server->command("msg $args $output"); }
+ else { Irssi::active_win()->command('say ' . $output); }
+# else { Irssi::print $output; }
+}
+
+Irssi::command_bind('np', 'cmd_xmms');
diff --git a/scripts/xmmsinfo.pl b/scripts/xmmsinfo.pl
new file mode 100644
index 0000000..46fd842
--- /dev/null
+++ b/scripts/xmmsinfo.pl
@@ -0,0 +1,116 @@
+#!/usr/bin/perl
+
+# $Id: xmmsinfo.pl,v 1.1.1.1 2002/03/24 21:00:55 tj Exp $
+#
+# Copyright (0) 2002 Tuomas Jormola <tjormola@cc.hut.fi
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# The complete text of the GNU General Public License can be found
+# on the World Wide Web: <URL:http://www.gnu.org/licenses/gpl.html>
+#
+# $Log: xmmsinfo.pl,v $
+# Revision 1.1.1.1 2002/03/24 21:00:55 tj
+# Initial import.
+#
+#
+# TODO:
+# * Configurable string to print (%t = title, %a = artist ...)
+
+use strict;
+use Irssi;
+use Irssi::XMMSInfo;
+use vars qw($VERSION %IRSSI);
+
+# global variables
+$VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.2 $ =~ /^.+?(\d+)\.(\d+)/);
+%IRSSI = (
+ authors => 'Tuomas Jormola',
+ contact => 'tjormola@cc.hut.fi',
+ name => 'XMMSInfo',
+ description => '/xmmsinfo to tell what you\'re currently playing',
+ license => 'GPLv2',
+ url => 'http://shakti.tky.hut.fi/stuff.xml#irssi',
+ changed => '2006-1027T18:00+0300',
+);
+
+if(runningUnderIrssi()) {
+ Irssi::settings_add_str('misc', 'xmms_info_pipe', '/tmp/xmms-info');
+ Irssi::command_bind('xmmsinfo', 'commandXmmsInfo');
+ Irssi::print("$IRSSI{name} $VERSION loaded, /xmmsinfo -help");
+} else {
+ (my $s = $0) =~ s/.*\///;
+ $ARGV[0] || die("Usage: $s <file>\n");
+ commandXmmsInfo();
+}
+
+# command handler
+sub commandXmmsInfo {
+ my($args, $server, $target) = @_;
+
+ if(lc($args) eq "-help") {
+ Irssi::print("XMMSInfo $VERSION by $IRSSI{authors} <$IRSSI{contact}>");
+ Irssi::print("");
+ Irssi::print("Displays what your XMMS is playing using information");
+ Irssi::print("provided by the XMMS InfoPipe plugin");
+ Irssi::print("<URL:www.iki.fi/wwwwolf/code/xmms/infopipe.html");
+ Irssi::print("");
+ Irssi::print("Usage: /xmmsinfo [TARGET]");
+ Irssi::print("If TARGET is given, the info is sent there, othwerwise to");
+ Irssi::print("the current active channel/query or Irssi status window");
+ Irssi::print("if you have no channel/query window active.");
+ Irssi::print("Target can be nick name or channel name");
+ Irssi::print("");
+ Irssi::print("Configuration: /set xmms_info_pipe <file>");
+ Irssi::print("Define filename of the pipe where from the InfoPipe output is read");
+ Irssi::print("Default is /tmp/xmms-info");
+ return;
+ }
+
+ my($p) = runningUnderIrssi() ? Irssi::settings_get_str('xmms_info_pipe') : $ARGV[0];
+ my($i) = XMMSInfo->new;
+ $i->getInfo(pipe => $p);
+
+ my($o) = "XMMS: " . $i->getStatusString;
+
+ if($i->isFatalError) {
+ $o .= ": " . $i->getError;
+ } elsif($i->isXmmsRunning) {
+ my($t) = $i->infoTitle || "(unknown song)";
+ my($a) = $i->infoArtist || "(unknown artist)";
+ my($g) = lc($i->infoGenre) || "(unknown genre)";
+ my($pos) = $i->infoMinutesNow . "m" . $i->infoSecondsNowLeftover."s";
+ my($tot) = $i->infoMinutesTotal . "m" . $i->infoSecondsTotalLeftover."s";
+ my($per) = $i->infoPercentage;
+ my($b) = $i->infoBitrate . "kbps";
+ my($f) = $i->infoFrequency . "kHz";
+ $o .= " $g tune $t by $a." if ($i->isPlaying || $i->isPaused);
+ $o .= " Played $pos of total $tot ($per%)." if $i->isPlaying;
+ $o .= " [$b/$f]" if ($i->isPlaying || $i->isPaused);
+ }
+
+ if(!runningUnderIrssi()) {
+ print "$o\n";
+ } elsif($i->isFatalError || !$server || !$server->{connected} || (!$args && !$target)) {
+ Irssi::print($o);
+ } else {
+ $o =~ s/[\r\n]/ /g; # remove newline characters
+ my($t) = $args || $target->{name};
+ $server->command("msg $t $o");
+ }
+
+}
+
+sub runningUnderIrssi {
+ $0 eq '-e';
+}
+
+# END OF SCRIPT
diff --git a/scripts/xqf.pl b/scripts/xqf.pl
new file mode 100644
index 0000000..2ea7a30
--- /dev/null
+++ b/scripts/xqf.pl
@@ -0,0 +1,238 @@
+# $Id: xqf.pl,v 0.14 2004/07/03 14:52:50 mizerou Exp $
+#
+# XQF to Irssi/Licq script. Idea from an X-Chat script (xqf-xchat).
+#
+# Portions of away_verbose used with permission from Koenraad Heijlen.
+#
+# ChangeLog:
+# 0.14:
+# - !aping lookups coded (uses Socket)
+# - bugfix: when passing stuff to licq_fifo and licq not running
+# 0.13:
+# - first public release, updates to follow.
+# - remove control codes in licq away message
+# 0.12:
+# - incorporated a lightweight hack of away_verbose
+# - no longer uses 'awe' and 'gone', all internally handled
+# - some servers use whitespace in beginning of name, fixed
+# - case-insensitive variables in setting 'xqfAwayMessage'
+# - redundant settings removed, code cleanups
+# 0.11:
+# - licq support added
+# - uses the 'awe' and 'gone' commands from away_verbose for now
+# 0.10:
+# - basics completed
+#
+# TODO:
+# - a way to detect when you're back from the game?
+# - timer checks to update licq and irssi (compare server addr)?
+# - plans to convert mIRC script 'autoping' to perl (parts of it)
+#
+# Bugs/Ideas/Improvements:
+# - report the above to mizerou @ irc.freenode.net/#fiend
+# or irc.enterthegame.com/#fiend
+#
+use strict;
+use Socket;
+
+use vars qw($VERSION %IRSSI);
+use Irssi qw(command_bind active_win);
+
+$VERSION = '0.14';
+%IRSSI = (
+ authors => 'mizerou',
+ contact => 'mizerou@telus.net',
+ name => 'XQF',
+ description => 'automatically sends xqf data to irssi and optionally licq',
+ license => 'GPLv2',
+ url => 'none',
+ changed => 'Sat June 05 05:12 MST 2004',
+ modules => 'Socket',
+ commands => 'xqf'
+);
+
+# setup irssi settings
+Irssi::settings_add_str('xqf', 'xqfLaunchInfo' => $ENV{HOME}.'/.qf/LaunchInfo.txt');
+Irssi::settings_add_str('xqf', 'xqfLicqFifo' => $ENV{HOME}.'/.licq/licq_fifo');
+Irssi::settings_add_str('xqf', 'xqfChannels', 'foo|bar');
+Irssi::settings_add_str('xqf', 'xqfAwayMessage', 'Playing $game ($mod) @ $name ($addr)');
+Irssi::settings_add_bool('xqf', 'xqfSetLicq', 0);
+Irssi::signal_add_last("message public", "xqfPing");
+
+# global vars
+my ($game, $name, $addr, $mod);
+my %xqfAway;
+my $timeout = Irssi::timeout_add_once(4000, 'checkLaunchInfo', undef);
+
+# remove LaunchInfo on startup
+if (-e Irssi::settings_get_str('xqfLaunchInfo')) {
+ unlink Irssi::settings_get_str('xqfLaunchInfo');
+}
+
+# /xqf: handles returning from games
+command_bind xqf => sub {
+ if ($xqfAway{'away'}) {
+ my (@servers) = Irssi::servers();
+ if (-e Irssi::settings_get_str('xqfLaunchInfo')) {
+ unlink Irssi::settings_get_str('xqfLaunchInfo');
+ }
+ $timeout = Irssi::timeout_add_once(4000, 'checkLaunchInfo', undef);
+ $servers[0]->command("AWAY");
+ xqfBack();
+ return;
+ } else {
+ active_win->print("XQF\\ You aren't currently playing a game.");
+ return;
+ }
+ return 0;
+};
+
+# checks if user has launched a game from xqf
+sub checkLaunchInfo {
+ if (!-e Irssi::settings_get_str('xqfLaunchInfo')) {
+ $timeout = Irssi::timeout_add_once(4000, 'checkLaunchInfo' , undef);
+ return;
+ } else {
+ my (@servers) = Irssi::servers();
+ Irssi::timeout_remove($timeout);
+ my $xqfMessage = fetchLaunchInfo();
+ $servers[0]->command("AWAY " . $xqfMessage);
+ xqfAway($xqfMessage);
+ active_win->print("XQF\\ Please type /xqf when you have finished playing.");
+ return;
+ }
+ return 0;
+}
+
+# parses and returns data from LaunchInfo.txt
+sub fetchLaunchInfo {
+ my $reply;
+
+ open(FH, "<", Irssi::settings_get_str('xqfLaunchInfo'));
+ my @LaunchInfo = <FH>;
+ close (FH);
+
+ foreach my $line (@LaunchInfo) {
+ ($game = $line) =~ s/^GameType (.+)\n/$1/ if ($line =~ /^GameType/);
+ ($name = $line) =~ s/^ServerName (.+)\n/$1/ if ($line =~ /^ServerName/);
+ ($addr = $line) =~ s/^ServerAddr (.+)\n/$1/ if ($line =~ /^ServerAddr/);
+ ($mod = $line) =~ s/^ServerMod (.+)\n/$1/ if ($line =~ /^ServerMod/);
+ }
+ s/^\s+// for ($game, $name, $addr, $mod);
+
+ $reply = Irssi::settings_get_str('xqfAwayMessage');
+ $reply =~ s/(\$\w+)/lc($1)/eego; # case insensitive
+ return ($reply); # return the users custom reply
+}
+
+#
+# functions below were borrowed from away_verbose.pl and modified to suit my needs
+# used with permission from Koenraad Heijlen <koenraad@ulyssis.org>
+#
+
+# converts unix time into human readable format
+sub xqfSecs2Text {
+ my $xqfAwayTexts = "wk,wks,day,days,hr,hrs,min,mins,sec,secs";
+ my ($secs) = @_;
+ my ($wk_,$wks_,$day_,$days_,$hr_,$hrs_,$min_,$mins_,$sec_,$secs_) = (0,1,2,3,4,5,6,7,8,9,10);
+ my @texts = split(/,/, $xqfAwayTexts);
+
+ my $mins = int($secs / 60); $secs -= ($mins * 60);
+ my $hrs = int($mins / 60); $mins -= ($hrs * 60);
+ my $days = int($hrs / 24); $hrs -= ($days * 24);
+ my $wks = int($days / 7); $days -= ($wks * 7);
+ my $text = (($wks > 0) ? (($wks > 1) ? "$wks $texts[$wks_] " : "$wks $texts[$wk_] ") : "");
+ $text .= (($days > 0) ? (($days > 1) ? "$days $texts[$days_] " : "$days $texts[$day_] ") : "");
+ $text .= (($hrs > 0) ? (($hrs > 1) ? "$hrs $texts[$hrs_] " : "$hrs $texts[$hr_] ") : "");
+ $text .= (($mins > 0) ? (($mins > 1) ? "$mins $texts[$mins_] " : "$mins $texts[$min_] ") : "");
+ $text .= (($secs > 0) ? (($secs > 1) ? "$secs $texts[$secs_] " : "$secs $texts[$sec_] ") : "");
+ $text =~ s/ $//;
+ return ($text);
+}
+
+# sets away status on irssi and licq
+sub xqfAway {
+ my ($text, $witem) = @_;
+ my $xqfChannels = Irssi::settings_get_str('xqfChannels');
+
+ $xqfAway{'time'} = time;
+ $xqfAway{'reason'} = "$text";
+ $xqfAway{'away'} = 1;
+ foreach my $server (Irssi::servers) {
+ foreach my $chan ($server->channels) {
+ if ((($server->{chatnet} .":". $chan->{name}) =~ /$xqfChannels/i)) {
+ $server->command("DESCRIBE $chan->{name} is away: $text");
+ }
+ }
+ }
+
+ if (Irssi::settings_get_bool('xqfSetLicq')) {
+ $text =~ s/\p{IsCntrl}//g;
+ active_win->command("exec -name xqfLicq echo 'status na \"$text\"' > " . Irssi::settings_get_str('xqfLicqFifo')); # 0.14: bugfix
+ active_win->command("exec -close xqfLicq");
+ }
+}
+
+# returns from away status on irssi and licq
+sub xqfBack {
+ my ($text) = @_;
+ my $xqfChannels = Irssi::settings_get_str('xqfChannels');
+
+ foreach my $server (Irssi::servers) {
+ foreach my $chan ($server->channels) {
+ if ((($server->{chatnet} .":". $chan->{name}) =~ /$xqfChannels/i)) {
+ $server->command("DESCRIBE $chan->{name} has returned from: $xqfAway{'reason'} after " . xqfSecs2Text(time - $xqfAway{'time'}));
+ }
+ }
+ }
+ if (Irssi::settings_get_bool('xqfSetLicq')) {
+ active_win->command("exec -name xqfLicq echo 'status online' > " . Irssi::settings_get_str('xqfLicqFifo')); # 0.14: bugfix
+ active_win->command("exec -close xqfLicq");
+ }
+ $xqfAway{'time'} = 0;
+ $xqfAway{'reason'} = "";
+ $xqfAway{'away'} = 0;
+}
+
+# handle !aping requests
+sub xqfPing {
+ my ($server, $host, $nick, $address, $channel) = @_;
+ my ($xqfChannels) = Irssi::settings_get_str('xqfChannels');
+ my ($average_ping);
+
+ if ($channel !~ /$xqfChannels/i) { return; }
+ if ($host !~ /^!aping/) { return; }
+ $host =~ s/^!aping //;
+
+ if ($xqfAway{'away'}) {
+ $server->command("msg $channel No pinging while gaming");
+ return;
+ }
+
+ # we make sure the host is real
+ my ($inetaddr) = gethostbyname($host);
+ if (!$inetaddr) {
+ $server->command("msg $channel I can't find $host");
+ return;
+ }
+ my $addr = inet_ntoa(scalar gethostbyname($host));
+
+ my @ping = `/bin/ping -w 2 -i .5 -c 3 $addr`;
+ my $average_line = $ping[-1];
+
+ if ($average_line !~ m#^.+= \S+/(\S+)/\S+/.*#) {
+ if ($average_line !~ /^rtt.*/) {
+ $server->command("msg $channel Could not connect to $host");
+ return;
+ } else {
+ $server->command("msg $channel Could not parse results from ping");
+ return;
+ }
+ } else {
+ $average_ping = "${1}ms";
+ }
+ $server->command("msg $channel $host = $average_ping");
+ return;
+}
+
+# EOF