summaryrefslogtreecommitdiff
path: root/.irssi
diff options
context:
space:
mode:
authorMike Crute <mcrute@gmail.com>2009-11-19 10:08:55 -0500
committerMike Crute <mike@crute.us>2009-11-19 10:08:55 -0500
commit2bdf49fbbc53a31bc2f217f7a9e40c77dd0f9529 (patch)
tree0d1b345e264db8209fa69858b0020686b8612fcc /.irssi
parent1ca63ba5d960863ecb76ea7ad850e46bdb06302b (diff)
downloaddotfiles-2bdf49fbbc53a31bc2f217f7a9e40c77dd0f9529.tar.bz2
dotfiles-2bdf49fbbc53a31bc2f217f7a9e40c77dd0f9529.tar.xz
dotfiles-2bdf49fbbc53a31bc2f217f7a9e40c77dd0f9529.zip
Adding new IRSSI config
Diffstat (limited to '.irssi')
-rw-r--r--.irssi/config.clean (renamed from .irssi/config)123
-rw-r--r--.irssi/default.theme294
-rw-r--r--.irssi/scripts/adv_windowlist.pl2478
l---------.irssi/scripts/autorun/twirssi.pl1
-rw-r--r--.irssi/scripts/twirssi.pl1901
-rw-r--r--.irssi/startup1
6 files changed, 4746 insertions, 52 deletions
diff --git a/.irssi/config b/.irssi/config.clean
index 1e9d49e..e6c64a3 100644
--- a/.irssi/config
+++ b/.irssi/config.clean
@@ -1,67 +1,75 @@
1servers = ( 1servers = (
2 { address = "irc.ubuntu.com"; chatnet = "Ubuntu"; port = "6667"; },
3 { address = "irc.stealth.net"; chatnet = "IRCnet"; port = "6668"; },
4 { address = "irc.efnet.org"; chatnet = "EFNet"; port = "6667"; },
5 { 2 {
6 address = "irc.undernet.org"; 3 address = "irc.freenode.com";
7 chatnet = "Undernet"; 4 chatnet = "FreeNode";
8 port = "6667"; 5 port = "6667";
9 }, 6 },
10 { address = "irc.dal.net"; chatnet = "DALnet"; port = "6667"; }, 7 {
11 { 8 address = "localhost";
12 address = "irc.quakenet.org"; 9 chatnet = "AIM";
13 chatnet = "QuakeNet";
14 port = "6667"; 10 port = "6667";
11 autoconnect = "yes";
15 }, 12 },
16 { address = "silc.silcnet.org"; chatnet = "SILC"; port = "706"; },
17 { 13 {
18 address = "work"; 14 address = "chat.ops.ag.com";
19 port = "0"; 15 chatnet = "AGJabber";
20 password = "5222"; 16 port = "5223";
21 use_ssl = "no"; 17 use_ssl = "yes";
22 ssl_verify = "no"; 18 autoconnect = "yes";
19 password = "[REDACTED]";
23 } 20 }
24); 21);
25 22
26chatnets = { 23chatnets = {
27 IRCnet = { 24 FreeNode = {
28 type = "IRC";
29 max_kicks = "4";
30 max_msgs = "5";
31 max_whois = "4";
32 max_query_chans = "5";
33 };
34 EFNet = {
35 type = "IRC";
36 max_kicks = "4";
37 max_msgs = "3";
38 max_whois = "1";
39 };
40 Undernet = {
41 type = "IRC";
42 max_kicks = "1";
43 max_msgs = "3";
44 max_whois = "30";
45 };
46 DALnet = {
47 type = "IRC";
48 max_kicks = "4";
49 max_msgs = "3";
50 max_whois = "30";
51 };
52 QuakeNet = {
53 type = "IRC"; 25 type = "IRC";
54 max_kicks = "1"; 26 autosendcmd = "/^msg nickserv identify [REDACTED];wait 2000";
55 max_msgs = "3";
56 max_whois = "30";
57 }; 27 };
58 SILC = { type = "SILC"; }; 28 AIM = { type = "IRC"; };
59 Ubuntu = { type = "IRC"; }; 29 AGJabber = { type = "XMPP"; nick = "mcrute@chat.ops.ag.com"; };
60}; 30};
61 31
62channels = ( 32channels = (
63 { name = "#irssi"; chatnet = "ircnet"; autojoin = "No"; }, 33 {
64 { name = "silc"; chatnet = "silc"; autojoin = "No"; } 34 name = "content@conference.chat.ops.ag.com";
35 chatnet = "AGJabber";
36 autojoin = "yes";
37 },
38 {
39 name = "endeca@conference.chat.ops.ag.com";
40 chatnet = "AGJabber";
41 autojoin = "yes";
42 },
43 {
44 name = "no-bs@conference.chat.ops.ag.com";
45 chatnet = "AGJabber";
46 autojoin = "yes";
47 },
48 {
49 name = "ag@conference.chat.ops.ag.com";
50 chatnet = "AGJabber";
51 autojoin = "yes";
52 },
53 {
54 name = "opshelp@conference.chat.ops.ag.com";
55 chatnet = "AGJabber";
56 autojoin = "yes";
57 },
58 {
59 name = "focus@conference.chat.ops.ag.com";
60 chatnet = "AGJabber";
61 autojoin = "yes";
62 },
63 {
64 name = "testing@conference.chat.ops.ag.com";
65 chatnet = "AGJabber";
66 autojoin = "yes";
67 },
68 {
69 name = "opensource@conference.chat.ops.ag.com";
70 chatnet = "AGJabber";
71 autojoin = "yes";
72 },
65); 73);
66 74
67aliases = { 75aliases = {
@@ -152,7 +160,6 @@ statusbar = {
152 # the "default statusbar" to be displayed at the bottom of the window. 160 # the "default statusbar" to be displayed at the bottom of the window.
153 # contains all the normal items. 161 # contains all the normal items.
154 window = { 162 window = {
155 disabled = "no";
156 163
157 # window, root 164 # window, root
158 type = "window"; 165 type = "window";
@@ -172,6 +179,7 @@ statusbar = {
172 window_empty = { }; 179 window_empty = { };
173 lag = { priority = "-1"; }; 180 lag = { priority = "-1"; };
174 act = { priority = "10"; }; 181 act = { priority = "10"; };
182 "act." = { priority = "10"; };
175 more = { priority = "-1"; alignment = "right"; }; 183 more = { priority = "-1"; alignment = "right"; };
176 barend = { priority = "100"; alignment = "right"; }; 184 barend = { priority = "100"; alignment = "right"; };
177 }; 185 };
@@ -225,9 +233,20 @@ statusbar = {
225}; 233};
226settings = { 234settings = {
227 core = { 235 core = {
228 real_name = "Michael Crute"; 236 real_name = "Mike Crute";
229 user_name = "mcrute"; 237 user_name = "cruteme";
230 nick = "mcrute"; 238 nick = "cruteme";
231 }; 239 };
232 "fe-text" = { actlist_sort = "refnum"; }; 240 "fe-text" = { actlist_sort = "refnum"; };
241 "fe-common/core" = {
242 autolog = "yes";
243 autolog_path = "~/.irssi/logs/$tag/$0.log";
244 };
245 "irc/core" = { channels_rejoin_unavailable = "yes"; };
246 "perl/core/scripts" = {
247 awl_display_key = "$Q%K|%n$H$C$S";
248 awl_block = "-15";
249 twirssi_first_run = "no";
250 };
233}; 251};
252logs = { };
diff --git a/.irssi/default.theme b/.irssi/default.theme
new file mode 100644
index 0000000..98af18b
--- /dev/null
+++ b/.irssi/default.theme
@@ -0,0 +1,294 @@
1# When testing changes, the easiest way to reload the theme is with /RELOAD.
2# This reloads the configuration file too, so if you did any changes remember
3# to /SAVE it first. Remember also that /SAVE overwrites the theme file with
4# old data so keep backups :)
5
6# TEMPLATES:
7
8# The real text formats that irssi uses are the ones you can find with
9# /FORMAT command. Back in the old days all the colors and texts were mixed
10# up in those formats, and it was really hard to change the colors since you
11# might have had to change them in tens of different places. So, then came
12# this templating system.
13
14# Now the /FORMATs don't have any colors in them, and they also have very
15# little other styling. Most of the stuff you need to change is in this
16# theme file. If you can't change something here, you can always go back
17# to change the /FORMATs directly, they're also saved in these .theme files.
18
19# So .. the templates. They're those {blahblah} parts you see all over the
20# /FORMATs and here. Their usage is simply {name parameter1 parameter2}.
21# When irssi sees this kind of text, it goes to find "name" from abstracts
22# block below and sets "parameter1" into $0 and "parameter2" into $1 (you
23# can have more parameters of course). Templates can have subtemplates.
24# Here's a small example:
25# /FORMAT format hello {colorify {underline world}}
26# abstracts = { colorify = "%G$0-%n"; underline = "%U$0-%U"; }
27# When irssi expands the templates in "format", the final string would be:
28# hello %G%Uworld%U%n
29# ie. underlined bright green "world" text.
30# and why "$0-", why not "$0"? $0 would only mean the first parameter,
31# $0- means all the parameters. With {underline hello world} you'd really
32# want to underline both of the words, not just the hello (and world would
33# actually be removed entirely).
34
35# COLORS:
36
37# You can find definitions for the color format codes in docs/formats.txt.
38
39# There's one difference here though. %n format. Normally it means the
40# default color of the terminal (white mostly), but here it means the
41# "reset color back to the one it was in higher template". For example
42# if there was /FORMAT test %g{foo}bar, and foo = "%Y$0%n", irssi would
43# print yellow "foo" (as set with %Y) but "bar" would be green, which was
44# set at the beginning before the {foo} template. If there wasn't the %g
45# at start, the normal behaviour of %n would occur. If you _really_ want
46# to use the terminal's default color, use %N.
47
48#############################################################################
49
50# default foreground color (%N) - -1 is the "default terminal color"
51default_color = "-1";
52
53# print timestamp/servertag at the end of line, not at beginning
54info_eol = "false";
55
56# these characters are automatically replaced with specified color
57# (dark grey by default)
58replaces = { "[]=" = "%K$*%n"; };
59
60abstracts = {
61 ##
62 ## generic
63 ##
64
65 # text to insert at the beginning of each non-message line
66 line_start = "%B-%W!%B-%n ";
67
68 # timestamp styling, nothing by default
69 timestamp = "$*";
70
71 # any kind of text that needs hilighting, default is to bold
72 hilight = "%_$*%_";
73
74 # any kind of error message, default is bright red
75 error = "%R$*%n";
76
77 # channel name is printed
78 channel = "%_$*%_";
79
80 # nick is printed
81 nick = "%_$*%_";
82
83 # nick host is printed
84 nickhost = "[$*]";
85
86 # server name is printed
87 server = "%_$*%_";
88
89 # some kind of comment is printed
90 comment = "[$*]";
91
92 # reason for something is printed (part, quit, kick, ..)
93 reason = "{comment $*}";
94
95 # mode change is printed ([+o nick])
96 mode = "{comment $*}";
97
98 ##
99 ## channel specific messages
100 ##
101
102 # highlighted nick/host is printed (joins)
103 channick_hilight = "%C$*%n";
104 chanhost_hilight = "{nickhost %c$*%n}";
105
106 # nick/host is printed (parts, quits, etc.)
107 channick = "%c$*%n";
108 chanhost = "{nickhost $*}";
109
110 # highlighted channel name is printed
111 channelhilight = "%c$*%n";
112
113 # ban/ban exception/invite list mask is printed
114 ban = "%c$*%n";
115
116 ##
117 ## messages
118 ##
119
120 # the basic styling of how to print message, $0 = nick mode, $1 = nick
121 msgnick = "%K<%n$0$1-%K>%n %|";
122
123 # message from you is printed. "msgownnick" specifies the styling of the
124 # nick ($0 part in msgnick) and "ownmsgnick" specifies the styling of the
125 # whole line.
126
127 # Example1: You want the message text to be green:
128 # ownmsgnick = "{msgnick $0 $1-}%g";
129 # Example2.1: You want < and > chars to be yellow:
130 # ownmsgnick = "%Y{msgnick $0 $1-%Y}%n";
131 # (you'll also have to remove <> from replaces list above)
132 # Example2.2: But you still want to keep <> grey for other messages:
133 # pubmsgnick = "%K{msgnick $0 $1-%K}%n";
134 # pubmsgmenick = "%K{msgnick $0 $1-%K}%n";
135 # pubmsghinick = "%K{msgnick $1 $0$2-%n%K}%n";
136 # ownprivmsgnick = "%K{msgnick $*%K}%n";
137 # privmsgnick = "%K{msgnick %R$*%K}%n";
138
139 # $0 = nick mode, $1 = nick
140 ownmsgnick = "{msgnick $0 $1-}";
141 ownnick = "%W$*%n";
142
143 # public message in channel, $0 = nick mode, $1 = nick
144 pubmsgnick = "{msgnick $0 $1-}";
145 pubnick = "%N$*%n";
146
147 # public message in channel meant for me, $0 = nick mode, $1 = nick
148 pubmsgmenick = "{msgnick $0 $1-}";
149 menick = "%Y$*%n";
150
151 # public highlighted message in channel
152 # $0 = highlight color, $1 = nick mode, $2 = nick
153 pubmsghinick = "{msgnick $1 $0$2-%n}";
154
155 # channel name is printed with message
156 msgchannel = "%K:%c$*%n";
157
158 # private message, $0 = nick, $1 = host
159 privmsg = "[%R$0%K(%r$1-%K)%n] ";
160
161 # private message from you, $0 = "msg", $1 = target nick
162 ownprivmsg = "[%r$0%K(%R$1-%K)%n] ";
163
164 # own private message in query
165 ownprivmsgnick = "{msgnick $*}";
166 ownprivnick = "%W$*%n";
167
168 # private message in query
169 privmsgnick = "{msgnick %R$*%n}";
170
171 ##
172 ## Actions (/ME stuff)
173 ##
174
175 # used internally by this theme
176 action_core = "%W * $*%n";
177
178 # generic one that's used by most actions
179 action = "{action_core $*} ";
180
181 # own action, both private/public
182 ownaction = "{action $*}";
183
184 # own action with target, both private/public
185 ownaction_target = "{action_core $0}%K:%c$1%n ";
186
187 # private action sent by others
188 pvtaction = "%W (*) $*%n ";
189 pvtaction_query = "{action $*}";
190
191 # public action sent by others
192 pubaction = "{action $*}";
193
194
195 ##
196 ## other IRC events
197 ##
198
199 # whois
200 whois = "%# $[8]0 : $1-";
201
202 # notices
203 ownnotice = "[%r$0%K(%R$1-%K)]%n ";
204 notice = "%K-%M$*%K-%n ";
205 pubnotice_channel = "%K:%m$*";
206 pvtnotice_host = "%K(%m$*%K)";
207 servernotice = "%g!$*%n ";
208
209 # CTCPs
210 ownctcp = "[%r$0%K(%R$1-%K)] ";
211 ctcp = "%g$*%n";
212
213 # wallops
214 wallop = "%W$*%n: ";
215 wallop_nick = "%n$*";
216 wallop_action = "%W * $*%n ";
217
218 # netsplits
219 netsplit = "%R$*%n";
220 netjoin = "%C$*%n";
221
222 # /names list
223 names_prefix = "";
224 names_nick = "[%_$0%_$1-] ";
225 names_nick_op = "{names_nick $*}";
226 names_nick_halfop = "{names_nick $*}";
227 names_nick_voice = "{names_nick $*}";
228 names_users = "[%g$*%n]";
229 names_channel = "%G$*%n";
230
231 # DCC
232 dcc = "%g$*%n";
233 dccfile = "%_$*%_";
234
235 # DCC chat, own msg/action
236 dccownmsg = "[%r$0%K($1-%K)%n] ";
237 dccownnick = "%R$*%n";
238 dccownquerynick = "%W$*%n";
239 dccownaction = "{action $*}";
240 dccownaction_target = "{action_core $0}%K:%c$1%n ";
241
242 # DCC chat, others
243 dccmsg = "[%G$1-%K(%g$0%K)%n] ";
244 dccquerynick = "%G$*%n";
245 dccaction = "%W (*dcc*) $*%n %|";
246
247 ##
248 ## statusbar
249 ##
250
251 # default background for all statusbars. You can also give
252 # the default foreground color for statusbar items.
253 sb_background = "%4%w";
254
255 # default backround for "default" statusbar group
256 #sb_default_bg = "%4";
257 # background for prompt / input line
258 sb_prompt_bg = "%n";
259 # background for info statusbar
260 sb_info_bg = "%8";
261 # background for topicbar (same default)
262 #sb_topic_bg = "%4";
263
264 # text at the beginning of statusbars. sb-item already puts
265 # space there,so we don't use anything by default.
266 sbstart = "";
267 # text at the end of statusbars. Use space so that it's never
268 # used for anything.
269 sbend = " ";
270
271 topicsbstart = "{sbstart $*}";
272 topicsbend = "{sbend $*}";
273
274 prompt = "[$*] ";
275
276 sb = " %c[%n$*%c]%n";
277 sbmode = "(%c+%n$*)";
278 sbaway = " (%GzZzZ%n)";
279 sbservertag = ":$0 (change with ^X)";
280 sbnickmode = "$0";
281
282 # activity in statusbar
283
284 # ',' separator
285 sb_act_sep = "%c$*";
286 # normal text
287 sb_act_text = "%c$*";
288 # public message
289 sb_act_msg = "%W$*";
290 # hilight
291 sb_act_hilight = "%M$*";
292 # hilight with specified color, $0 = color, $1 = text
293 sb_act_hilight_color = "$0$1-%n";
294};
diff --git a/.irssi/scripts/adv_windowlist.pl b/.irssi/scripts/adv_windowlist.pl
new file mode 100644
index 0000000..780ab35
--- /dev/null
+++ b/.irssi/scripts/adv_windowlist.pl
@@ -0,0 +1,2478 @@
1use strict; # use warnings;
2
3# {{{ debug
4
5#BEGIN {
6# open STDERR, '>', '/home/ailin/wlstatwarnings';
7#};
8
9# FIXME COULD SOMEONE PLEASE TELL ME HOW TO SHUT UP
10#
11# ...
12# Variable "*" will not stay shared at (eval *) line *.
13# Variable "*" will not stay shared at (eval *) line *.
14# ...
15# Can't locate package Irssi::Nick for @Irssi::Irc::Nick::ISA at (eval *) line *.
16# ...
17#
18# THANKS
19
20# }}}
21
22# if you don't know how to operate folds, type zn
23
24# {{{ header
25
26use Irssi (); # which is the minimum required version of Irssi ?
27use Irssi::TextUI;
28
29use vars qw($VERSION %IRSSI);
30
31$VERSION = '0.6ca';
32%IRSSI = (
33 original_authors => q(BC-bd, Veli, Timo Sirainen, ).
34 q(Wouter Coekaerts, Jean-Yves Lefort), # (decadix)
35 original_contact => q(bd@bc-bd.org, veli@piipiip.net, tss@iki.fi, ).
36 q(wouter@coekaerts.be, jylefort@brutele.be),
37 authors => q(Nei),
38 contact => q(Nei @ anti@conference.jabber.teamidiot.de),
39 url => "http://anti.teamidiot.de/",
40 name => q(awl),
41 description => q(Adds a permanent advanced window list on the right or ).
42 q(in a statusbar.),
43 description2 => q(Based on chanact.pl which was apparently based on ).
44 q(lightbar.c and nicklist.pl with various other ideas ).
45 q(from random scripts.),
46 license => q(GNU GPLv2 or later),
47);
48
49# }}}
50
51# {{{ *** D O C U M E N T A T I O N ***
52
53# adapted by Nei
54
55###############
56# {{{ original comment
57# ###########
58# # Adds new powerful and customizable [Act: ...] item (chanelnames,modes,alias).
59# # Lets you give alias characters to windows so that you can select those with
60# # meta-<char>.
61# #
62# # for irssi 0.8.2 by bd@bc-bd.org
63# #
64# # inspired by chanlist.pl by 'cumol@hammerhart.de'
65# #
66# #########
67# # {{{ Contributors
68# #########
69# #
70# # veli@piipiip.net /window_alias code
71# # qrczak@knm.org.pl chanact_abbreviate_names
72# # qerub@home.se Extra chanact_show_mode and chanact_chop_status
73# # }}}
74# }}}
75#
76# {{{ FURTHER THANKS TO
77# ############
78# # buu, fxn, Somni, Khisanth, integral, tybalt89 for much support in any aspect perl
79# # and the channel in general ( #perl @ freenode ) and especially the ir_* functions
80# #
81# # Valentin 'senneth' Batz ( vb@g-23.org ) for the pointer to grep.pl, continuous support
82# # and help in digging up ir_strip_codes
83# #
84# # OnetrixNET technology networks for the debian environment
85# #
86# # Monkey-Pirate.com / Spaceman Spiff for the webspace
87# #
88# }}}
89
90######
91# {{{ M A I N P R O B L E M
92#####
93#
94# It is impossible to place the awl on a statusbar together with other items,
95# because I do not know how to calculate the size that it is going to get
96# granted, and therefore I cannot do the linebreaks properly.
97# This is what is missing to make a nice script out of awl.
98# If you have any ideas, please contact me ASAP :).
99# }}}
100######
101
102######
103# {{{ UTF-8 PROBLEM
104#####
105#
106# Please help me find a solution to this:
107# this be your statusbar, it is using up the maximum term size
108# [[1=1]#abc [2=2]#defghi]
109#
110# now consider this example:i
111# "ascii" characters are marked with ., utf-8 characters with *
112# [[1=1]#... [2=2]#...***]
113#
114# you should think that this is how it would be displayed? WRONG!
115# [[1=1]#... [2=2]#...*** ]
116#
117# this is what Irssi does.. I believe my length calculating code to be correct,
118# however, I'd love to be proven wrong (or receive any other fix, too, of
119# course!)
120# }}}
121######
122
123#########
124# {{{ USAGE
125###
126#
127# copy the script to ~/.irssi/scripts/
128#
129# In irssi:
130#
131# /script load awl
132#
133#
134# Hint: to get rid of the old [Act:] display
135# /statusbar window remove act
136#
137# to get it back:
138# /statusbar window add -after lag -priority 10 act
139# }}}
140##########
141# {{{ OPTIONS
142########
143#
144# {{{ /set awl_display_nokey <string>
145# /set awl_display_key <string>
146# /set awl_display_nokey_active <string>
147# /set awl_display_key_active <string>
148# * string : Format String for one window. The following $'s are expanded:
149# $C : Name
150# $N : Number of the Window
151# $Q : meta-Keymap
152# $H : Start highlighting
153# $S : Stop highlighting
154# /+++++++++++++++++++++++++++++++++,
155# | **** I M P O R T A N T : **** |
156# | |
157# | don't forget to use $S if you |
158# | used $H before! |
159# | |
160# '+++++++++++++++++++++++++++++++++/
161# XXX NOTE ON *_active: there is a BUG somewhere in the length
162# XXX calculation. currently it's best to NOT remove $H/$S from those
163# XXX settings if you use it in the non-active settings.
164# }}}
165# {{{ /set awl_separator <string>
166# * string : Charater to use between the channel entries
167# you'll need to escape " " space and "$" like this:
168# "/set awl_separator \ "
169# "/set awl_separator \$"
170# and {}% like this:
171# "/set awl_separator %{"
172# "/set awl_separator %}"
173# "/set awl_separator %%"
174# (reason being, that the separator is used inside a {format })
175# }}}
176# {{{ /set awl_prefer_name <ON|OFF>
177# * this setting decides whether awl will use the active_name (OFF) or the
178# window name as the name/caption in awl_display_*.
179# That way you can rename windows using /window name myownname.
180# }}}
181# {{{ /set awl_hide_data <num>
182# * num : hide the window if its data_level is below num
183# set it to 0 to basically disable this feature,
184# 1 if you don't want windows without activity to be shown
185# 2 to show only those windows with channel text or hilight
186# 3 to show only windows with hilight
187# }}}
188# {{{ /set awl_maxlines <num>
189# * num : number of lines to use for the window list (0 to disable, negative
190# lock)
191# }}}
192# {{{ /set awl_columns <num>
193# * num : number of columns to use in screen mode (0 for unlimited)
194# }}}
195# {{{ /set awl_block <num>
196# * num : width of a column in screen mode (negative values = block display)
197# /+++++++++++++++++++++++++++++++++,
198# | ****** W A R N I N G ! ****** |
199# | |
200# | If your block display looks |
201# | DISTORTED, you need to add the |
202# | following line to your .theme |
203# | file under |
204# | abstracts = { : |
205# | |
206# | sb_act_none = "%n$*"; |
207# | |
208# '+++++++++++++++++++++++++++++++++/
209#.02:08:26. < shi> Irssi::current_theme()->get_format <.. can this be used?
210# }}}
211# {{{ /set awl_sbar_maxlength <ON|OFF>
212# * if you enable the maxlength setting, the block width will be used as a
213# maximum length for the non-block statusbar mode too.
214# }}}
215# {{{ /set awl_height_adjust <num>
216# * num : how many lines to leave empty in screen mode
217# }}}
218# {{{ /set awl_sort <-data_level|-last_line|refnum>
219# * you can change the window sort order with this variable
220# -data_level : sort windows with hilight first
221# -last_line : sort windows in order of activity
222# refnum : sort windows by window number
223# }}}
224# {{{ /set awl_placement <top|bottom>
225# /set awl_position <num>
226# * these settings correspond to /statusbar because awl will create
227# statusbars for you
228# (see /help statusbar to learn more)
229# }}}
230# {{{ /set awl_all_disable <ON|OFF>
231# * if you set awl_all_disable to ON, awl will also remove the
232# last statusbar it created if it is empty.
233# As you might guess, this only makes sense with awl_hide_data > 0 ;)
234# }}}
235# {{{ /set awl_automode <sbar|screen|emulate_lightbar>
236# * this setting defines whether the window list is shown in statusbars or
237# whether the screen hack is used (from nicklist.pl)
238# }}}
239# }}}
240##########
241# {{{ COMMANDS
242########
243# {{{ /awl paste <ON|OFF|TOGGLE>
244# * enables or disables the screen hack windowlist. This is useful when you
245# want to mark & copy text that you want to paste somewhere (hence the
246# name). (ON means AWL disabled!)
247# This is nicely bound to a function key for example.
248# }}}
249# {{{ /awl redraw
250# * redraws the screen hack windowlist. There are many occasions where the
251# screen hack windowlist can get destroyed so you can use this command to
252# fix it.
253# }}}
254# }}}
255###
256# {{{ WISHES
257####
258#
259# if you fiddle with my mess, provide me with your fixes so I can benefit as well
260#
261# Nei =^.^= ( anti@conference.jabber.teamidiot.de )
262# }}}
263
264# }}}
265
266# {{{ modules
267
268#use Class::Classless;
269#use Term::Info;
270
271# }}}
272
273# {{{ global variables
274
275my $replaces = '[=]'; # AARGH!!! (chars that are always surrounded by weird
276 # colour codes by Irssi)
277
278my $actString = []; # statusbar texts
279my $currentLines = 0;
280my $resetNeeded; # layout/screen has changed, redo everything
281my $needRemake; # "normal" changes
282#my $callcount = 0;
283sub GLOB_QUEUE_TIMER () { 100 }
284my $globTime = undef; # timer to limit remake() calls
285
286
287my $SCREEN_MODE;
288my $DISABLE_SCREEN_TEMP;
289my $currentColumns = 0;
290my $screenResizing;
291my ($screenHeight, $screenWidth);
292my $screenansi = bless {
293 NAME => 'Screen::ANSI',
294 PARENTS => [],
295 METHODS => {
296 dcs => sub { "\033P" },
297 st => sub { "\033\\"},
298 }
299}, 'Class::Classless::X';
300#my $terminfo = new Term::Info 'xterm'; # xterm here, make this modular
301# {{{{{{{{{{{{{{{
302my $terminfo = bless { # xterm here, make this modular
303 NAME => 'Term::Info::xterm',
304 PARENTS => [],
305 METHODS => {
306 # civis=\E[?25l,
307 civis => sub { "\033[?25l" },
308 # sc=\E7,
309 sc => sub { "\0337" },
310 # cup=\E[%i%p1%d;%p2%dH,
311 cup => sub { shift;shift; "\033[" . ($_[0] + 1) . ';' . ($_[1] + 1) . 'H' },
312 # el=\E[K,
313 el => sub { "\033[K" },
314 # rc=\E8,
315 rc => sub { "\0338" },
316 # cnorm=\E[?25h,
317 cnorm => sub { "\033[?25h" },
318 # setab=\E[4%p1%dm,
319 setab => sub { shift;shift; "\033[4" . $_[0] . 'm' },
320 # setaf=\E[3%p1%dm,
321 setaf => sub { shift;shift; "\033[3" . $_[0] . 'm' },
322 # bold=\E[1m,
323 bold => sub { "\033[1m" },
324 # blink=\E[5m,
325 blink => sub { "\033[5m" },
326 # rev=\E[7m,
327 rev => sub { "\033[7m" },
328 # op=\E[39;49m,
329 op => sub { "\033[39;49m" },
330 }
331}, 'Class::Classless::X';
332# }}}}}}}}}}}}}}}
333
334
335sub setc () {
336 $IRSSI{'name'}
337}
338sub set ($) {
339 setc . '_' . shift
340}
341
342# }}}
343
344
345# {{{ sbar mode
346
347my %statusbars; # currently active statusbars
348
349# maybe I should just tie the array ?
350sub add_statusbar {
351 for (@_) {
352 # add subs
353 for my $l ($_) { {
354 no strict 'refs'; # :P
355 *{set$l} = sub { awl($l, @_) };
356 }; }
357 Irssi::command('statusbar ' . (set$_) . ' reset');
358 Irssi::command('statusbar ' . (set$_) . ' enable');
359 if (lc Irssi::settings_get_str(set 'placement') eq 'top') {
360 Irssi::command('statusbar ' . (set$_) . ' placement top');
361 }
362 if ((my $x = int Irssi::settings_get_int(set 'position')) != 0) {
363 Irssi::command('statusbar ' . (set$_) . ' position ' . $x);
364 }
365 Irssi::command('statusbar ' . (set$_) . ' add -priority 100 -alignment left barstart');
366 Irssi::command('statusbar ' . (set$_) . ' add ' . (set$_));
367 Irssi::command('statusbar ' . (set$_) . ' add -priority 100 -alignment right barend');
368 Irssi::command('statusbar ' . (set$_) . ' disable');
369 Irssi::statusbar_item_register(set$_, '$0', set$_);
370 $statusbars{$_} = {};
371 }
372}
373
374sub remove_statusbar {
375 for (@_) {
376 Irssi::command('statusbar ' . (set$_) . ' reset');
377 Irssi::statusbar_item_unregister(set$_); # XXX does this actually work ?
378 # DO NOT REMOVE the sub before you have unregistered it :))
379 for my $l ($_) { {
380 no strict 'refs';
381 undef &{set$l};
382 }; }
383 delete $statusbars{$_};
384 }
385}
386
387sub syncLines {
388 my $temp = $currentLines;
389 $currentLines = @$actString;
390 #Irssi::print("current lines: $temp new lines: $currentLines");
391 my $currMaxLines = Irssi::settings_get_int(set 'maxlines');
392 if ($currMaxLines > 0 and @$actString > $currMaxLines) {
393 $currentLines = $currMaxLines;
394 }
395 elsif ($currMaxLines < 0) {
396 $currentLines = abs($currMaxLines);
397 }
398 return if ($temp == $currentLines);
399 if ($currentLines > $temp) {
400 for ($temp .. ($currentLines - 1)) {
401 add_statusbar($_);
402 Irssi::command('statusbar ' . (set$_) . ' enable');
403 }
404 }
405 else {
406 for ($_ = ($temp - 1); $_ >= $currentLines; $_--) {
407 Irssi::command('statusbar ' . (set$_) . ' disable');
408 remove_statusbar($_);
409 }
410 }
411}
412
413# FIXME implement $get_size_only check, and user $item->{min|max-size} ??
414sub awl {
415 my ($line, $item, $get_size_only) = @_;
416
417 if ($needRemake) {
418 $needRemake = undef;
419 remake();
420 }
421
422 my $text = $actString->[$line]; # DO NOT set the actual $actString->[$line] to '' here or
423 $text = '' unless defined $text; # you'll screw up the statusbar counter ($currentLines)
424 $item->default_handler($get_size_only, $text, '', 1);
425}
426
427# remove old statusbars
428my %killBar;
429sub get_old_status {
430 my ($textDest, $cont, $cont_stripped) = @_;
431 if ($textDest->{'level'} == 524288 and $textDest->{'target'} eq ''
432 and !defined($textDest->{'server'})
433 ) {
434 my $name = quotemeta(set '');
435 if ($cont_stripped =~ m/^$name(\d+)\s/) { $killBar{$1} = {}; }
436 Irssi::signal_stop();
437 }
438}
439sub killOldStatus {
440 %killBar = ();
441 Irssi::signal_add_first('print text' => 'get_old_status');
442 Irssi::command('statusbar');
443 Irssi::signal_remove('print text' => 'get_old_status');
444 remove_statusbar(keys %killBar);
445}
446#killOldStatus();
447
448# end sbar mode }}}
449
450
451# {{{ keymaps
452
453my %keymap;
454
455sub get_keymap {
456 my ($textDest, undef, $cont_stripped) = @_;
457 if ($textDest->{'level'} == 524288 and $textDest->{'target'} eq ''
458 and !defined($textDest->{'server'})
459 ) {
460 if ($cont_stripped =~ m/((?:meta-)+)(.)\s+change_window (\d+)/) {
461 my ($level, $key, $window) = ($1, $2, $3);
462 my $numlevel = ($level =~ y/-//) - 1;
463 $keymap{$window} = ('-' x $numlevel) . "$key";
464 }
465 Irssi::signal_stop();
466 }
467}
468
469sub update_keymap {
470 %keymap = ();
471 Irssi::signal_remove('command bind' => 'watch_keymap');
472 Irssi::signal_add_first('print text' => 'get_keymap');
473 Irssi::command('bind'); # stolen from grep
474 Irssi::signal_remove('print text' => 'get_keymap');
475 Irssi::signal_add('command bind' => 'watch_keymap');
476 Irssi::timeout_add_once(100, 'eventChanged', undef);
477}
478
479# watch keymap changes
480sub watch_keymap {
481 Irssi::timeout_add_once(1000, 'update_keymap', undef);
482}
483
484update_keymap();
485
486# end keymaps }}}
487
488# {{{ format handling
489
490# a bad way do do expansions but who cares
491sub expand {
492 my ($string, %format) = @_;
493 my ($exp, $repl);
494 $string =~ s/\$$exp/$repl/g while (($exp, $repl) = each(%format));
495 return $string;
496}
497
498my %strip_table = (
499 # fe-common::core::formats.c:format_expand_styles
500 # delete format_backs format_fores bold_fores other stuff
501 (map { $_ => '' } (split //, '04261537' . 'kbgcrmyw' . 'KBGCRMYW' . 'U9_8:|FnN>#[')),
502 # escape
503 (map { $_ => $_ } (split //, '{}%')),
504);
505sub ir_strip_codes { # strip %codes
506 my $o = shift;
507 $o =~ s/(%(.))/exists $strip_table{$2} ? $strip_table{$2} : $1/gex;
508 $o
509}
510
511sub ir_parse_special {
512 my $o; my $i = shift;
513 #if ($_[0]) { # for the future?!?
514 # eval {
515 # $o = $_[0]->parse_special($i);
516 # };
517 # unless ($@) {
518 # return $o;
519 # }
520 #}
521 my $win = shift || Irssi::active_win();
522 my $server = Irssi::active_server();
523 if (ref $win and ref $win->{'active'}) {
524 $o = $win->{'active'}->parse_special($i);
525 }
526 elsif (ref $win and ref $win->{'active_server'}) {
527 $o = $win->{'active_server'}->parse_special($i);
528 }
529 elsif (ref $server) {
530 $o = $server->parse_special($i);
531 }
532 else {
533 $o = Irssi::parse_special($i);
534 }
535 $o
536}
537sub ir_parse_special_protected {
538 my $o; my $i = shift;
539 $i =~ s/
540 ( \\. ) | # skip over escapes (maybe)
541 ( \$[^% $\]+ ) # catch special variables
542 /
543 if ($1) { $1 }
544 elsif ($2) { my $i2 = $2; ir_fe(ir_parse_special($i2, @_)) }
545 else { $& }
546 /gex;
547 $i
548}
549
550
551sub sb_ctfe { # Irssi::current_theme->format_expand wrapper
552 Irssi::current_theme->format_expand(
553 shift,
554 (
555 Irssi::EXPAND_FLAG_IGNORE_REPLACES
556 |
557 ($_[0]?0:Irssi::EXPAND_FLAG_IGNORE_EMPTY)
558 )
559 )
560}
561sub sb_expand { # expand {format }s (and apply parse_special for $vars)
562 ir_parse_special(
563 sb_ctfe(shift)
564 )
565}
566sub sb_strip {
567 ir_strip_codes(
568 sb_expand(shift)
569 ); # does this get us the actual length of that s*ty bar :P ?
570}
571sub sb_length {
572 # unicode cludge, d*mn broken Irssi
573 # screw it, this will fail from broken joining anyway (and cause warnings)
574 my $term_type = 'term_type';
575 if (Irssi::version > 20040819) { # this is probably wrong, but I don't know
576 # when the setting name got changed
577 $term_type = 'term_charset';
578 }
579 #if (lc Irssi::settings_get_str($term_type) eq '8bit'
580 # or Irssi::settings_get_str($term_type) =~ /^iso/i
581 #) {
582 # length(sb_strip(shift))
583 #}
584 #else {
585 my $temp = sb_strip(shift);
586 # try to get the displayed width
587 my $length;
588 eval {
589 require Text::CharWidth;
590 $length = Text::CharWidth::mbswidth($temp);
591 };
592 unless ($@) {
593 return $length;
594 }
595 else {
596 if (lc Irssi::settings_get_str($term_type) eq 'utf-8') {
597 # try to switch on utf8
598 eval {
599 no warnings;
600 require Encode;
601 #$temp = Encode::decode_utf8($temp); # thanks for the hint, but I have my
602 # # reasons for _utf8_on
603 Encode::_utf8_on($temp);
604 };
605 }
606 # there is nothing more I can do
607 length($temp)
608 }
609 #}
610}
611
612# !!! G*DD*MN Irssi is adding an additional layer of backslashitis per { } layer
613# !!! AND I still don't know what I need to escape.
614# !!! and NOONE else seems to know or care either.
615# !!! f*ck open source. I mean it.
616# XXX any Irssi::print debug statement leads to SEGFAULT - why ?
617
618# major parts of the idea by buu (#perl @ freenode)
619# thanks to fxn and Somni for debugging
620# while ($_[0] =~ /(.)/g) {
621# my $c = $1; # XXX sooo... goto kills $1
622# if ($q eq '%') { goto ESC; }
623
624## <freenode:#perl:tybalt89> s/%(.)|(\{)|(\})|(\\|\$)/$1?$1:$2?($level++,$2):$3?($level>$min_level&&$level--,$3):'\\'x(2**$level-1).$4/ge; # untested...
625sub ir_escape {
626 my $min_level = $_[1] || 0; my $level = $min_level;
627 my $o = shift;
628 $o =~ s/
629 ( %. ) | # $1
630 ( \{ ) | # $2
631 ( \} ) | # $3
632 ( \\ ) | # $4
633 ( \$(?=[^\\]) ) | # $5
634 ( \$ ) # $6
635 /
636 if ($1) { $1 } # %. escape
637 elsif ($2) { $level++; $2 } # { nesting start
638 elsif ($3) { if ($level > $min_level) { $level--; } $3 } # } nesting end
639 elsif ($4) { '\\'x(2**$level) } # \ needs \\escaping
640 elsif ($5) { '\\'x(2**$level-1) . '$' . '\\'x(2**$level-1) } # and $ needs even more because of "parse_special"
641 else { '\\'x(2**$level-1) . '$' } # $ needs \$ escaping
642 /gex;
643 $o
644}
645#sub ir_escape {
646# my $min_level = $_[1] || 0; my $level = $min_level;
647# my $o = shift;
648# $o =~ s/
649# ( %. ) | # $1
650# ( \{ ) | # $2
651# ( \} ) | # $3
652# ( \\ | \$ ) # $4
653# /
654# if ($1) { $1 } # %. escape
655# elsif ($2) { $level++; $2 } # { nesting start
656# elsif ($3) { if ($level > $min_level) { $level--; } $3 } # } nesting end
657# else { '\\'x(2**($level-1)-1) . $4 } # \ or $ needs \\escaping
658# /gex;
659# $o
660#}
661
662sub ir_fe { # try to fix format stuff
663 my $x = shift;
664 # XXX why do I have to use two/four % here instead of one/two ??
665 # answer: you screwed up in ir_escape
666 $x =~ s/([%{}])/%$1/g;
667 #$x =~ s/(\\|\$|[ ])/\\$1/g; # XXX HOW CAN I HANDLE THE SPACES CORRECTLY XXX
668 $x =~ s/(\\|\$)/\\$1/g;
669 #$x =~ s/(\$(?=.))|(\$)/$1?"\\\$\\":"\\\$"/ge; # I think this should be here
670 # # (logic), but it doesn't work
671 # # that way :P
672 #$x =~ s/\\/\\\\/g; # that's right, escape escapes
673 $x
674}
675sub ir_ve { # escapes special vars but leave colours alone
676 my $x = shift;
677 #$x =~ s/([%{}])/%$1/g;
678 $x =~ s/(\\|\$|[ ])/\\$1/g;
679 $x
680}
681
682my %ansi_table;
683{
684 my ($i, $j, $k) = (0, 0, 0);
685 %ansi_table = (
686 # fe-common::core::formats.c:format_expand_styles
687 # do format_backs
688 (map { $_ => $terminfo->setab($i++) } (split //, '01234567' )),
689 # do format_fores
690 (map { $_ => $terminfo->setaf($j++) } (split //, 'krgybmcw' )),
691 # do bold_fores
692 (map { $_ => $terminfo->bold() .
693 $terminfo->setaf($k++) } (split //, 'KRGYBMCW')),
694 # reset
695 #(map { $_ => $terminfo->op() } (split //, 'nN')),
696 (map { $_ => $terminfo->op() } (split //, 'n')),
697 (map { $_ => "\033[0m" } (split //, 'N')), # XXX quick and DIRTY
698 # flash/bright
699 F => $terminfo->blink(),
700 # reverse
701 8 => $terminfo->rev(),
702 # bold
703 (map { $_ => $terminfo->bold() } (split //, '9_')),
704 # delete other stuff
705 (map { $_ => '' } (split //, ':|>#[')),
706 # escape
707 (map { $_ => $_ } (split //, '{}%')),
708 )
709}
710sub formats_to_ansi_basic {
711 my $o = shift;
712 $o =~ s/(%(.))/exists $ansi_table{$2} ? $ansi_table{$2} : $1/gex;
713 $o
714}
715
716sub lc1459 ($) { my $x = shift; $x =~ y/A-Z][\^/a-z}{|~/; $x }
717Irssi::settings_add_str(setc, 'banned_channels', '');
718Irssi::settings_add_bool(setc, 'banned_channels_on', 0);
719my %banned_channels = map { lc1459($_) => undef }
720split ' ', Irssi::settings_get_str('banned_channels');
721Irssi::settings_add_str(setc, 'fancy_abbrev', 'fancy');
722
723# }}}
724
725# {{{ main
726
727sub remake () {
728 #$callcount++;
729 #my $xx = $callcount; Irssi::print("starting remake [ $xx ]");
730 my ($hilight, $number, $display);
731 my $separator = '{sb_act_sep ' . Irssi::settings_get_str(set 'separator') .
732 '}';
733 my $custSort = Irssi::settings_get_str(set 'sort');
734 my $custSortDir = 1;
735 if ($custSort =~ /^[-!](.*)/) {
736 $custSortDir = -1;
737 $custSort = $1;
738 }
739
740 my @wins =
741 sort {
742 (
743 ( (int($a->{$custSort}) <=> int($b->{$custSort})) * $custSortDir )
744 ||
745 ($a->{'refnum'} <=> $b->{'refnum'})
746 )
747 } Irssi::windows;
748 my $block = Irssi::settings_get_int(set 'block');
749 my $columns = $currentColumns;
750 my $oldActString = $actString if $SCREEN_MODE;
751 $actString = $SCREEN_MODE ? [' A W L'] : [];
752 my $line = $SCREEN_MODE ? 1 : 0;
753 my $width = $SCREEN_MODE
754 ?
755 $screenWidth - abs($block)*$columns + 1
756 :
757 ([Irssi::windows]->[0]{'width'} - sb_length('{sb x}'));
758 my $height = $screenHeight - abs(Irssi::settings_get_int(set
759 'height_adjust'));
760 my ($numPad, $keyPad) = (0, 0);
761 my %abbrevList;
762 if ($SCREEN_MODE or Irssi::settings_get_bool(set 'sbar_maxlength')
763 or ($block < 0)
764 ) {
765 %abbrevList = ();
766 if (Irssi::settings_get_str('fancy_abbrev') !~ /^(no|off|head)/i) {
767 my @nameList = map { ref $_ ? $_->get_active_name : '' } @wins;
768 for (my $i = 0; $i < @nameList - 1; ++$i) {
769 my ($x, $y) = ($nameList[$i], $nameList[$i + 1]);
770 for ($x, $y) { s/^[+#!=]// }
771 my $res = Algorithm::LCSS::LCSS($x, $y);
772 if (defined $res) {
773 #Irssi::print("common pattern $x $y : $res");
774 #Irssi::print("found at $nameList[$i] ".index($nameList[$i],
775 # $res));
776 $abbrevList{$nameList[$i]} = int (index($nameList[$i], $res) +
777 (length($res) / 2));
778 #Irssi::print("found at ".$nameList[$i+1]." ".index($nameList[$i+1],
779 # $res));
780 $abbrevList{$nameList[$i+1]} = int (index($nameList[$i+1], $res) +
781 (length($res) / 2));
782 }
783 }
784 }
785 if ($SCREEN_MODE or ($block < 0)) {
786 $numPad = length((sort { length($b) <=> length($a) } keys %keymap)[0]);
787 $keyPad = length((sort { length($b) <=> length($a) } values %keymap)[0]);
788 }
789 }
790 if ($SCREEN_MODE) {
791 print STDERR $screenansi->dcs().
792 $terminfo->civis().
793 $terminfo->sc().
794 $screenansi->st();
795 if (@$oldActString < 1) {
796 print STDERR $screenansi->dcs().
797 $terminfo->cup(0, $width).
798 $actString->[0].
799 $terminfo->el().
800 $screenansi->st();
801 }
802 }
803 foreach my $win (@wins) {
804 unless ($SCREEN_MODE) {
805 $actString->[$line] = '' unless defined $actString->[$line]
806 or Irssi::settings_get_bool(set 'all_disable');
807 }
808
809 # all stolen from chanact, what does this code do and why do we need it ?
810 !ref($win) && next;
811
812 my $name = $win->get_active_name;
813 $name = '*' if (Irssi::settings_get_bool('banned_channels_on') and exists
814 $banned_channels{lc1459($name)});
815 $name = $win->{'name'} if $name ne '*' and $win->{'name'} ne ''
816 and Irssi::settings_get_bool(set 'prefer_name');
817 my $active = $win->{'active'};
818 my $colour = $win->{'hilight_color'};
819 if (!defined $colour) { $colour = ''; }
820
821 if ($win->{'data_level'} < Irssi::settings_get_int(set 'hide_data')) {
822 next; } # for Geert
823 if ($win->{'data_level'} == 0) { $hilight = '{sb_act_none '; }
824 elsif ($win->{'data_level'} == 1) { $hilight = '{sb_act_text '; }
825 elsif ($win->{'data_level'} == 2) { $hilight = '{sb_act_msg '; }
826 elsif ($colour ne '') { $hilight = "{sb_act_hilight_color $colour "; }
827 elsif ($win->{'data_level'} == 3) { $hilight = '{sb_act_hilight '; }
828 else { $hilight = '{sb_act_special '; }
829
830 $number = $win->{'refnum'};
831 my @display = ('display_nokey');
832 if (defined $keymap{$number} and $keymap{$number} ne '') {
833 unshift @display, map { (my $cpy = $_) =~ s/_no/_/; $cpy } @display;
834 }
835 if (Irssi::active_win->{'refnum'} == $number) {
836 unshift @display, map { my $cpy = $_; $cpy .= '_active'; $cpy } @display;
837 }
838 #Irssi::print("win $number [@display]: " . join '.', split //, join '<<', map {
839 # Irssi::settings_get_str(set $_) } @display);
840 $display = (grep { $_ }
841 map { Irssi::settings_get_str(set $_) }
842 @display)[0];
843 #Irssi::print("win $number : " . join '.', split //, $display);
844
845 if ($SCREEN_MODE or Irssi::settings_get_bool(set 'sbar_maxlength')
846 or ($block < 0)
847 ) {
848 my $baseLength = sb_length(ir_escape(ir_ve(ir_parse_special_protected(sb_ctfe(
849 '{sb_background}' . expand($display,
850 C => ir_fe('x'),
851 N => $number . (' 'x($numPad - length($number))),
852 Q => ir_fe((' 'x($keyPad - length($keymap{$number}))) . $keymap{$number}),
853 H => $hilight,
854 S => '}{sb_background}'
855 ), 1), $win)))) - 1;
856 my $diff = abs($block) - (length($name) + $baseLength);
857 if ($diff < 0) { # too long
858 if (abs($diff) >= length($name)) { $name = '' } # forget it
859 elsif (abs($diff) + 1 >= length($name)) { $name = substr($name,
860 0, 1); }
861 else {
862 my $middle = exists $abbrevList{$name} ?
863 (($abbrevList{$name} + (2*(length($name) / 2)))/3) :
864 ((Irssi::settings_get_str('fancy_abbrev') =~ /^head/i) ?
865 length($name) :
866 (length($name) / 2));
867 my $cut = int($middle - (abs($diff) / 2) + .55);
868 $cut = 1 if $cut < 1;
869 $cut = length($name) - abs($diff) - 1 if $cut > (length($name) -
870 abs($diff) - 1);
871 $name = substr($name, 0, $cut) . '~' . substr($name, $cut +
872 abs($diff) + 1);
873 }
874 }
875 elsif ($SCREEN_MODE or ($block < 0)) {
876 $name .= (' ' x $diff);
877 }
878 }
879
880 my $add = ir_ve(ir_parse_special_protected(sb_ctfe('{sb_background}' . expand($display,
881 C => ir_fe($name),
882 N => $number . (' 'x($numPad - length($number))),
883 Q => ir_fe((' 'x($keyPad - length($keymap{$number}))) . $keymap{$number}),
884 H => $hilight,
885 S => '}{sb_background}'
886 ), 1), $win));
887 if ($SCREEN_MODE) {
888 $actString->[$line] = $add;
889 if ((!defined $oldActString->[$line]
890 or $oldActString->[$line] ne $actString->[$line])
891 and
892 $line <= ($columns * $height)
893 ) {
894 print STDERR $screenansi->dcs().
895 $terminfo->cup(($line-1) % $height+1, $width + (
896 abs($block) * int(($line-1) / $height))).
897 formats_to_ansi_basic(sb_expand(ir_escape($actString->[$line]))).
898 #$terminfo->el().
899 $screenansi->st();
900 }
901 $line++;
902 }
903 else {
904 #$temp =~ s/\{\S+?(?:\s(.*?))?\}/$1/g;
905 #$temp =~ s/\\\\\\\\/\\/g; # XXX I'm actually guessing here, someone point me
906 # # XXX to docs please
907 $actString->[$line] = '' unless defined $actString->[$line];
908
909 # XXX how can I check whether the content still fits in the bar? this would
910 # XXX allow awlstatus to reside on a statusbar together with other items...
911 if (sb_length(ir_escape($actString->[$line] . $add)) >= $width) {
912 # XXX doesn't correctly handle utf-8 multibyte ... help !!?
913 $actString->[$line] .= ' ' x ($width - sb_length(ir_escape(
914 $actString->[$line])));
915 $line++;
916 }
917 $actString->[$line] .= $add . $separator;
918 # XXX if I use these prints, output layout gets screwed up... why ?
919 #Irssi::print("line $line: ".$actString->[$line]);
920 #Irssi::print("temp $line: ".$temp);
921 }
922 }
923
924 if ($SCREEN_MODE) {
925 while ($line <= ($columns * $height)) {
926 print STDERR $screenansi->dcs().
927 $terminfo->cup(($line-1) % $height+1, $width + (
928 abs($block) * int(($line-1) / $height))).
929 $terminfo->el().
930 $screenansi->st();
931 $line++;
932 }
933 print STDERR $screenansi->dcs().
934 $terminfo->rc().
935 $terminfo->cnorm().
936 $screenansi->st();
937 }
938 else {
939 # XXX the Irssi::print statements lead to the MOST WEIRD results
940 # e.g.: the loop gets executed TWICE for p > 0 ?!?
941 for (my $p = 0; $p < @$actString; $p++) { # wrap each line in {sb }, escape it
942 my $x = $actString->[$p]; # properly, etc.
943 $x =~ s/\Q$separator\E([ ]*)$/$1/;
944 #Irssi::print("[$p]".'current:'.join'.',split//,sb_strip(ir_escape($x,0)));
945 #Irssi::print("assumed length before:".sb_length(ir_escape($x,0)));
946 $x = "{sb $x}";
947 #Irssi::print("[$p]".'new:'.join'.',split//,sb_expand(ir_escape($x,0)));
948 #Irssi::print("[$p]".'new:'.join'.',split//,ir_escape($x,0));
949 #Irssi::print("assumed length after:".sb_length(ir_escape($x,0)));
950 $x = ir_escape($x);
951 #Irssi::print("[$p]".'REALnew:'.join'.',split//,sb_strip($x));
952 $actString->[$p] = $x;
953 # XXX any Irssi::print debug statement leads to SEGFAULT (sometimes) - why ?
954 }
955 }
956 #Irssi::print("remake [ $xx ] finished");
957}
958
959sub awlHasChanged () {
960 $globTime = undef;
961 my $temp = ($SCREEN_MODE ?
962 "\\\n" . Irssi::settings_get_int(set 'block').
963 Irssi::settings_get_int(set 'height_adjust')
964 : "!\n" . Irssi::settings_get_str(set 'placement').
965 Irssi::settings_get_int(set 'position')).
966 Irssi::settings_get_str(set 'automode');
967 if ($temp ne $resetNeeded) { wlreset(); return; }
968 #Irssi::print("awl has changed, calls to remake so far: $callcount");
969 $needRemake = 1;
970
971 #remake();
972 if (
973 ($SCREEN_MODE and !$DISABLE_SCREEN_TEMP)
974 or
975 ($needRemake and Irssi::settings_get_bool(set 'all_disable'))
976 or
977 (!Irssi::settings_get_bool(set 'all_disable') and $currentLines < 1)
978 ) {
979 $needRemake = undef;
980 remake();
981 }
982
983 unless ($SCREEN_MODE) {
984 # XXX Irssi crashes if I try to do this without timer, why ? What's the minimum
985 # XXX delay I need to use in the timer ?
986 Irssi::timeout_add_once(100, 'syncLines', undef);
987
988 for (keys %statusbars) {
989 Irssi::statusbar_items_redraw(set$_);
990 }
991 }
992 else {
993 Irssi::timeout_add_once(100, 'syncColumns', undef);
994 }
995}
996
997sub eventChanged () { # Implement a change queue/blocker -.-)
998 if (defined $globTime) {
999 Irssi::timeout_remove($globTime);
1000 } # delay the update further
1001 $globTime = Irssi::timeout_add_once(GLOB_QUEUE_TIMER, 'awlHasChanged', undef);
1002}
1003
1004# }}}
1005
1006
1007# {{{ screen mode
1008
1009sub screenFullRedraw {
1010 my ($window) = @_;
1011 if (!ref $window or $window->{'refnum'} == Irssi::active_win->{'refnum'}) {
1012 $actString = [];
1013 eventChanged();
1014 }
1015}
1016
1017sub screenSize { # from nicklist.pl
1018 $screenResizing = 1;
1019 # fit screen
1020 system 'screen -x '.$ENV{'STY'}.' -X fit';
1021 # get size
1022 my ($row, $col) = split ' ', `stty size`;
1023 # set screen width
1024 $screenWidth = $col-1;
1025 $screenHeight = $row-1;
1026
1027 # on some recent systems, "screen -X fit; screen -X width -w 50" doesn't work, needs a sleep in between the 2 commands
1028 # so we wait a second before setting the width
1029 Irssi::timeout_add_once(100, sub {
1030 my ($new_irssi_width) = @_;
1031 $new_irssi_width -= abs(Irssi::settings_get_int(set
1032 'block'))*$currentColumns - 1;
1033 system 'screen -x '.$ENV{'STY'}.' -X width -w ' . $new_irssi_width;
1034 # and then we wait another second for the resizing, and then redraw.
1035 Irssi::timeout_add_once(10,sub {$screenResizing = 0; screenFullRedraw()}, []);
1036 }, $screenWidth);
1037}
1038
1039sub screenOff {
1040 my ($unloadMode) = @_;
1041 Irssi::signal_remove('gui print text finished' => 'screenFullRedraw');
1042 Irssi::signal_remove('gui page scrolled' => 'screenFullRedraw');
1043 Irssi::signal_remove('window changed' => 'screenFullRedraw');
1044 Irssi::signal_remove('window changed automatic' => 'screenFullRedraw');
1045 if ($unloadMode) {
1046 Irssi::signal_remove('terminal resized' => 'resizeTerm');
1047 }
1048 system 'screen -x '.$ENV{'STY'}.' -X fit';
1049}
1050
1051sub syncColumns {
1052 return if (@$actString == 0);
1053 my $temp = $currentColumns;
1054 #Irssi::print("current columns $temp");
1055 my $height = $screenHeight - abs(Irssi::settings_get_int(set
1056 'height_adjust'));
1057 $currentColumns = int(($#$actString-1) / $height) + 1;
1058 #Irssi::print("objects in actstring:".scalar(@$actString).", screen height:".
1059 # $height);
1060 my $currMaxColumns = Irssi::settings_get_int(set 'columns');
1061 if ($currMaxColumns > 0 and $currentColumns > $currMaxColumns) {
1062 $currentColumns = $currMaxColumns;
1063 }
1064 elsif ($currMaxColumns < 0) {
1065 $currentColumns = abs($currMaxColumns);
1066 }
1067 return if ($temp == $currentColumns);
1068 screenSize();
1069}
1070
1071#$needRemake = 1;
1072sub resizeTerm () {
1073 if ($SCREEN_MODE and !$screenResizing) {
1074 $screenResizing = 1;
1075 Irssi::timeout_add_once(10, 'screenSize', undef);
1076 }
1077 Irssi::timeout_add_once(100, 'eventChanged', undef);
1078}
1079
1080# }}}
1081
1082
1083# {{{ settings add
1084
1085Irssi::settings_add_str(setc, set 'display_nokey', '[$N]$H$C$S');
1086Irssi::settings_add_str(setc, set 'display_key', '[$Q=$N]$H$C$S');
1087Irssi::settings_add_str(setc, set 'display_nokey_active', '');
1088Irssi::settings_add_str(setc, set 'display_key_active', '');
1089Irssi::settings_add_str(setc, set 'separator', "\\ ");
1090Irssi::settings_add_bool(setc, set 'prefer_name', 0);
1091Irssi::settings_add_int(setc, set 'hide_data', 0);
1092Irssi::settings_add_int(setc, set 'maxlines', 9);
1093Irssi::settings_add_int(setc, set 'columns', 1);
1094Irssi::settings_add_int(setc, set 'block', 20);
1095Irssi::settings_add_bool(setc, set 'sbar_maxlength', 0);
1096Irssi::settings_add_int(setc, set 'height_adjust', 2);
1097Irssi::settings_add_str(setc, set 'sort', 'refnum');
1098Irssi::settings_add_str(setc, set 'placement', 'bottom');
1099Irssi::settings_add_int(setc, set 'position', 0);
1100Irssi::settings_add_bool(setc, set 'all_disable', 0);
1101Irssi::settings_add_str(setc, set 'automode', 'sbar');
1102
1103# }}}
1104
1105
1106# {{{ init
1107
1108sub wlreset {
1109 $actString = [];
1110 $currentLines = 0; # 1; # mhmmmm .. we actually enable one line down there so
1111 # let's try this.
1112 #update_keymap();
1113 killOldStatus();
1114 # Register statusbar
1115 #add_statusbar(0);
1116 #Irssi::command('statusbar wl0 enable');
1117 my $was_screen_mode = $SCREEN_MODE;
1118 if ($SCREEN_MODE = (Irssi::settings_get_str(set 'automode') =~ /screen/i)
1119 and
1120 !$was_screen_mode
1121 ) {
1122 if (!defined $ENV{'STY'}) {
1123 Irssi::print('Screen mode can only be used in GNU screen but no '.
1124 'screen was found.', MSGLEVEL_CLIENTERROR);
1125 $SCREEN_MODE = undef;
1126 }
1127 else {
1128 Irssi::signal_add_last('gui print text finished' => 'screenFullRedraw');
1129 Irssi::signal_add_last('gui page scrolled' => 'screenFullRedraw');
1130 Irssi::signal_add('window changed' => 'screenFullRedraw');
1131 Irssi::signal_add('window changed automatic' => 'screenFullRedraw');
1132 }
1133 }
1134 elsif ($was_screen_mode and !$SCREEN_MODE) {
1135 screenOff();
1136 }
1137 $resetNeeded = ($SCREEN_MODE ?
1138 "\\\n" . Irssi::settings_get_int(set 'block').
1139 Irssi::settings_get_int(set 'height_adjust')
1140 : "!\n" . Irssi::settings_get_str(set 'placement').
1141 Irssi::settings_get_int(set 'position')).
1142 Irssi::settings_get_str(set 'automode');
1143 resizeTerm();
1144}
1145
1146wlreset();
1147
1148# }}}
1149
1150
1151# {{{ unload/deinit
1152
1153my $Unload;
1154sub unload ($$$) {
1155 $Unload = 1;
1156 # pretend we didn't do anything ASAP
1157 Irssi::timeout_add_once(10, sub { $Unload = undef; }, undef);
1158}
1159# last try to catch a sigsegv
1160Irssi::signal_add_first('gui exit' => sub { $Unload = undef; });
1161sub UNLOAD {
1162 # this might well crash Irssi... try /eval /script unload someotherscript ;
1163 # /quit (= SEGFAULT !)
1164 if ($Unload) {
1165 $actString = ['']; # syncLines(); # XXX Irssi crashes when trying to disable
1166 killOldStatus(); # XXX all statusbars ?
1167 if ($SCREEN_MODE) {
1168 screenOff('unload mode');
1169 }
1170 }
1171}
1172
1173# }}}
1174
1175
1176# {{{ signals
1177
1178sub addPrintTextHook { # update on print text
1179 return if $_[0]->{'level'} == 262144 and $_[0]->{'target'} eq ''
1180 and !defined($_[0]->{'server'});
1181 if (Irssi::settings_get_str(set 'sort') =~ /^[-!]?last_line$/) {
1182 Irssi::timeout_add_once(100, 'eventChanged', undef);
1183 }
1184}
1185
1186#sub _x { my ($x, $y) = @_; ($x, sub { Irssi::print('-->signal '.$x); eval "$y();"; }) }
1187#sub _x { @_ }
1188Irssi::signal_add_first(
1189 'command script unload' => 'unload'
1190);
1191Irssi::signal_add_last({
1192 'setup changed' => 'eventChanged',
1193 'print text' => 'addPrintTextHook',
1194 'terminal resized' => 'resizeTerm',
1195 'setup reread' => 'wlreset',
1196 'window hilight' => 'eventChanged',
1197});
1198Irssi::signal_add({
1199 'window created' => 'eventChanged',
1200 'window destroyed' => 'eventChanged',
1201 'window name changed' => 'eventChanged',
1202 'window refnum changed' => 'eventChanged',
1203 'window changed' => 'eventChanged',
1204 'window changed automatic' => 'eventChanged',
1205});
1206
1207#Irssi::signal_add('nick mode changed', 'chanactHasChanged'); # relicts
1208
1209# }}}
1210
1211# {{{ commands
1212
1213
1214sub runsub {
1215 my ($cmd) = @_;
1216 sub {
1217 my ($data, $server, $item) = @_;
1218 Irssi::command_runsub($cmd, $data, $server, $item);
1219 };
1220}
1221Irssi::command_bind( setc() => runsub(setc()) );
1222Irssi::command_bind( setc() . ' paste' => runsub(setc() . ' paste') );
1223Irssi::command_bind(
1224 setc() . ' paste on' => sub {
1225 return unless $SCREEN_MODE;
1226 my $was_disabled = $DISABLE_SCREEN_TEMP;
1227 $DISABLE_SCREEN_TEMP = 1;
1228 Irssi::print('Paste mode is now ON, '.uc(setc()).' is temporarily '.
1229 'disabled.');
1230 if (!$was_disabled) {
1231 $screenResizing = 1;
1232 screenOff();
1233 }
1234 }
1235);
1236Irssi::command_bind(
1237 setc() . ' paste off' => sub {
1238 return unless $SCREEN_MODE;
1239 my $was_disabled = $DISABLE_SCREEN_TEMP;
1240 $DISABLE_SCREEN_TEMP = undef;
1241 Irssi::print('Paste mode is now OFF, '.uc(setc()).' is enabled.');
1242 if ($was_disabled) {
1243 $SCREEN_MODE = undef;
1244 $screenResizing = 0;
1245 wlreset();
1246 }
1247 }
1248);
1249Irssi::command_bind(
1250 setc() . ' paste toggle' => sub {
1251 if ($DISABLE_SCREEN_TEMP) {
1252 Irssi::command(setc() . ' paste off');
1253 }
1254 else {
1255 Irssi::command(setc() . ' paste on');
1256 }
1257 }
1258);
1259Irssi::command_bind(
1260 setc() . ' redraw' => sub {
1261 return unless $SCREEN_MODE;
1262 screenFullRedraw();
1263 }
1264);
1265
1266
1267# }}}
1268
1269# {{{ Algorithm::LCSS module
1270{
1271 package Algorithm::Diff;
1272 # Skip to first "=head" line for documentation.
1273 use strict;
1274
1275 use integer; # see below in _replaceNextLargerWith() for mod to make
1276 # if you don't use this
1277
1278 # McIlroy-Hunt diff algorithm
1279 # Adapted from the Smalltalk code of Mario I. Wolczko, <mario@wolczko.com>
1280 # by Ned Konz, perl@bike-nomad.com
1281 # Updates by Tye McQueen, http://perlmonks.org/?node=tye
1282
1283 # Create a hash that maps each element of $aCollection to the set of
1284 # positions it occupies in $aCollection, restricted to the elements
1285 # within the range of indexes specified by $start and $end.
1286 # The fourth parameter is a subroutine reference that will be called to
1287 # generate a string to use as a key.
1288 # Additional parameters, if any, will be passed to this subroutine.
1289 #
1290 # my $hashRef = _withPositionsOfInInterval( \@array, $start, $end, $keyGen );
1291
1292 sub _withPositionsOfInInterval
1293 {
1294 my $aCollection = shift; # array ref
1295 my $start = shift;
1296 my $end = shift;
1297 my $keyGen = shift;
1298 my %d;
1299 my $index;
1300 for ( $index = $start ; $index <= $end ; $index++ )
1301 {
1302 my $element = $aCollection->[$index];
1303 my $key = &$keyGen( $element, @_ );
1304 if ( exists( $d{$key} ) )
1305 {
1306 unshift ( @{ $d{$key} }, $index );
1307 }
1308 else
1309 {
1310 $d{$key} = [$index];
1311 }
1312 }
1313 return wantarray ? %d : \%d;
1314 }
1315
1316 # Find the place at which aValue would normally be inserted into the
1317 # array. If that place is already occupied by aValue, do nothing, and
1318 # return undef. If the place does not exist (i.e., it is off the end of
1319 # the array), add it to the end, otherwise replace the element at that
1320 # point with aValue. It is assumed that the array's values are numeric.
1321 # This is where the bulk (75%) of the time is spent in this module, so
1322 # try to make it fast!
1323
1324 sub _replaceNextLargerWith
1325 {
1326 my ( $array, $aValue, $high ) = @_;
1327 $high ||= $#$array;
1328
1329 # off the end?
1330 if ( $high == -1 || $aValue > $array->[-1] )
1331 {
1332 push ( @$array, $aValue );
1333 return $high + 1;
1334 }
1335
1336 # binary search for insertion point...
1337 my $low = 0;
1338 my $index;
1339 my $found;
1340 while ( $low <= $high )
1341 {
1342 $index = ( $high + $low ) / 2;
1343
1344 # $index = int(( $high + $low ) / 2); # without 'use integer'
1345 $found = $array->[$index];
1346
1347 if ( $aValue == $found )
1348 {
1349 return undef;
1350 }
1351 elsif ( $aValue > $found )
1352 {
1353 $low = $index + 1;
1354 }
1355 else
1356 {
1357 $high = $index - 1;
1358 }
1359 }
1360
1361 # now insertion point is in $low.
1362 $array->[$low] = $aValue; # overwrite next larger
1363 return $low;
1364 }
1365
1366 # This method computes the longest common subsequence in $a and $b.
1367
1368 # Result is array or ref, whose contents is such that
1369 # $a->[ $i ] == $b->[ $result[ $i ] ]
1370 # foreach $i in ( 0 .. $#result ) if $result[ $i ] is defined.
1371
1372 # An additional argument may be passed; this is a hash or key generating
1373 # function that should return a string that uniquely identifies the given
1374 # element. It should be the case that if the key is the same, the elements
1375 # will compare the same. If this parameter is undef or missing, the key
1376 # will be the element as a string.
1377
1378 # By default, comparisons will use "eq" and elements will be turned into keys
1379 # using the default stringizing operator '""'.
1380
1381 # Additional parameters, if any, will be passed to the key generation
1382 # routine.
1383
1384 sub _longestCommonSubsequence
1385 {
1386 my $a = shift; # array ref or hash ref
1387 my $b = shift; # array ref or hash ref
1388 my $counting = shift; # scalar
1389 my $keyGen = shift; # code ref
1390 my $compare; # code ref
1391
1392 if ( ref($a) eq 'HASH' )
1393 { # prepared hash must be in $b
1394 my $tmp = $b;
1395 $b = $a;
1396 $a = $tmp;
1397 }
1398
1399 # Check for bogus (non-ref) argument values
1400 if ( !ref($a) || !ref($b) )
1401 {
1402 my @callerInfo = caller(1);
1403 die 'error: must pass array or hash references to ' . $callerInfo[3];
1404 }
1405
1406 # set up code refs
1407 # Note that these are optimized.
1408 if ( !defined($keyGen) ) # optimize for strings
1409 {
1410 $keyGen = sub { $_[0] };
1411 $compare = sub { my ( $a, $b ) = @_; $a eq $b };
1412 }
1413 else
1414 {
1415 $compare = sub {
1416 my $a = shift;
1417 my $b = shift;
1418 &$keyGen( $a, @_ ) eq &$keyGen( $b, @_ );
1419 };
1420 }
1421
1422 my ( $aStart, $aFinish, $matchVector ) = ( 0, $#$a, [] );
1423 my ( $prunedCount, $bMatches ) = ( 0, {} );
1424
1425 if ( ref($b) eq 'HASH' ) # was $bMatches prepared for us?
1426 {
1427 $bMatches = $b;
1428 }
1429 else
1430 {
1431 my ( $bStart, $bFinish ) = ( 0, $#$b );
1432
1433 # First we prune off any common elements at the beginning
1434 while ( $aStart <= $aFinish
1435 and $bStart <= $bFinish
1436 and &$compare( $a->[$aStart], $b->[$bStart], @_ ) )
1437 {
1438 $matchVector->[ $aStart++ ] = $bStart++;
1439 $prunedCount++;
1440 }
1441
1442 # now the end
1443 while ( $aStart <= $aFinish
1444 and $bStart <= $bFinish
1445 and &$compare( $a->[$aFinish], $b->[$bFinish], @_ ) )
1446 {
1447 $matchVector->[ $aFinish-- ] = $bFinish--;
1448 $prunedCount++;
1449 }
1450
1451 # Now compute the equivalence classes of positions of elements
1452 $bMatches =
1453 _withPositionsOfInInterval( $b, $bStart, $bFinish, $keyGen, @_ );
1454 }
1455 my $thresh = [];
1456 my $links = [];
1457
1458 my ( $i, $ai, $j, $k );
1459 for ( $i = $aStart ; $i <= $aFinish ; $i++ )
1460 {
1461 $ai = &$keyGen( $a->[$i], @_ );
1462 if ( exists( $bMatches->{$ai} ) )
1463 {
1464 $k = 0;
1465 for $j ( @{ $bMatches->{$ai} } )
1466 {
1467
1468 # optimization: most of the time this will be true
1469 if ( $k and $thresh->[$k] > $j and $thresh->[ $k - 1 ] < $j )
1470 {
1471 $thresh->[$k] = $j;
1472 }
1473 else
1474 {
1475 $k = _replaceNextLargerWith( $thresh, $j, $k );
1476 }
1477
1478 # oddly, it's faster to always test this (CPU cache?).
1479 if ( defined($k) )
1480 {
1481 $links->[$k] =
1482 [ ( $k ? $links->[ $k - 1 ] : undef ), $i, $j ];
1483 }
1484 }
1485 }
1486 }
1487
1488 if (@$thresh)
1489 {
1490 return $prunedCount + @$thresh if $counting;
1491 for ( my $link = $links->[$#$thresh] ; $link ; $link = $link->[0] )
1492 {
1493 $matchVector->[ $link->[1] ] = $link->[2];
1494 }
1495 }
1496 elsif ($counting)
1497 {
1498 return $prunedCount;
1499 }
1500
1501 return wantarray ? @$matchVector : $matchVector;
1502 }
1503
1504 sub traverse_sequences
1505 {
1506 my $a = shift; # array ref
1507 my $b = shift; # array ref
1508 my $callbacks = shift || {};
1509 my $keyGen = shift;
1510 my $matchCallback = $callbacks->{'MATCH'} || sub { };
1511 my $discardACallback = $callbacks->{'DISCARD_A'} || sub { };
1512 my $finishedACallback = $callbacks->{'A_FINISHED'};
1513 my $discardBCallback = $callbacks->{'DISCARD_B'} || sub { };
1514 my $finishedBCallback = $callbacks->{'B_FINISHED'};
1515 my $matchVector = _longestCommonSubsequence( $a, $b, 0, $keyGen, @_ );
1516
1517 # Process all the lines in @$matchVector
1518 my $lastA = $#$a;
1519 my $lastB = $#$b;
1520 my $bi = 0;
1521 my $ai;
1522
1523 for ( $ai = 0 ; $ai <= $#$matchVector ; $ai++ )
1524 {
1525 my $bLine = $matchVector->[$ai];
1526 if ( defined($bLine) ) # matched
1527 {
1528 &$discardBCallback( $ai, $bi++, @_ ) while $bi < $bLine;
1529 &$matchCallback( $ai, $bi++, @_ );
1530 }
1531 else
1532 {
1533 &$discardACallback( $ai, $bi, @_ );
1534 }
1535 }
1536
1537 # The last entry (if any) processed was a match.
1538 # $ai and $bi point just past the last matching lines in their sequences.
1539
1540 while ( $ai <= $lastA or $bi <= $lastB )
1541 {
1542
1543 # last A?
1544 if ( $ai == $lastA + 1 and $bi <= $lastB )
1545 {
1546 if ( defined($finishedACallback) )
1547 {
1548 &$finishedACallback( $lastA, @_ );
1549 $finishedACallback = undef;
1550 }
1551 else
1552 {
1553 &$discardBCallback( $ai, $bi++, @_ ) while $bi <= $lastB;
1554 }
1555 }
1556
1557 # last B?
1558 if ( $bi == $lastB + 1 and $ai <= $lastA )
1559 {
1560 if ( defined($finishedBCallback) )
1561 {
1562 &$finishedBCallback( $lastB, @_ );
1563 $finishedBCallback = undef;
1564 }
1565 else
1566 {
1567 &$discardACallback( $ai++, $bi, @_ ) while $ai <= $lastA;
1568 }
1569 }
1570
1571 &$discardACallback( $ai++, $bi, @_ ) if $ai <= $lastA;
1572 &$discardBCallback( $ai, $bi++, @_ ) if $bi <= $lastB;
1573 }
1574
1575 return 1;
1576 }
1577
1578 sub traverse_balanced
1579 {
1580 my $a = shift; # array ref
1581 my $b = shift; # array ref
1582 my $callbacks = shift || {};
1583 my $keyGen = shift;
1584 my $matchCallback = $callbacks->{'MATCH'} || sub { };
1585 my $discardACallback = $callbacks->{'DISCARD_A'} || sub { };
1586 my $discardBCallback = $callbacks->{'DISCARD_B'} || sub { };
1587 my $changeCallback = $callbacks->{'CHANGE'};
1588 my $matchVector = _longestCommonSubsequence( $a, $b, 0, $keyGen, @_ );
1589
1590 # Process all the lines in match vector
1591 my $lastA = $#$a;
1592 my $lastB = $#$b;
1593 my $bi = 0;
1594 my $ai = 0;
1595 my $ma = -1;
1596 my $mb;
1597
1598 while (1)
1599 {
1600
1601 # Find next match indices $ma and $mb
1602 do {
1603 $ma++;
1604 } while(
1605 $ma <= $#$matchVector
1606 && !defined $matchVector->[$ma]
1607 );
1608
1609 last if $ma > $#$matchVector; # end of matchVector?
1610 $mb = $matchVector->[$ma];
1611
1612 # Proceed with discard a/b or change events until
1613 # next match
1614 while ( $ai < $ma || $bi < $mb )
1615 {
1616
1617 if ( $ai < $ma && $bi < $mb )
1618 {
1619
1620 # Change
1621 if ( defined $changeCallback )
1622 {
1623 &$changeCallback( $ai++, $bi++, @_ );
1624 }
1625 else
1626 {
1627 &$discardACallback( $ai++, $bi, @_ );
1628 &$discardBCallback( $ai, $bi++, @_ );
1629 }
1630 }
1631 elsif ( $ai < $ma )
1632 {
1633 &$discardACallback( $ai++, $bi, @_ );
1634 }
1635 else
1636 {
1637
1638 # $bi < $mb
1639 &$discardBCallback( $ai, $bi++, @_ );
1640 }
1641 }
1642
1643 # Match
1644 &$matchCallback( $ai++, $bi++, @_ );
1645 }
1646
1647 while ( $ai <= $lastA || $bi <= $lastB )
1648 {
1649 if ( $ai <= $lastA && $bi <= $lastB )
1650 {
1651
1652 # Change
1653 if ( defined $changeCallback )
1654 {
1655 &$changeCallback( $ai++, $bi++, @_ );
1656 }
1657 else
1658 {
1659 &$discardACallback( $ai++, $bi, @_ );
1660 &$discardBCallback( $ai, $bi++, @_ );
1661 }
1662 }
1663 elsif ( $ai <= $lastA )
1664 {
1665 &$discardACallback( $ai++, $bi, @_ );
1666 }
1667 else
1668 {
1669
1670 # $bi <= $lastB
1671 &$discardBCallback( $ai, $bi++, @_ );
1672 }
1673 }
1674
1675 return 1;
1676 }
1677
1678 sub prepare
1679 {
1680 my $a = shift; # array ref
1681 my $keyGen = shift; # code ref
1682
1683 # set up code ref
1684 $keyGen = sub { $_[0] } unless defined($keyGen);
1685
1686 return scalar _withPositionsOfInInterval( $a, 0, $#$a, $keyGen, @_ );
1687 }
1688
1689 sub LCS
1690 {
1691 my $a = shift; # array ref
1692 my $b = shift; # array ref or hash ref
1693 my $matchVector = _longestCommonSubsequence( $a, $b, 0, @_ );
1694 my @retval;
1695 my $i;
1696 for ( $i = 0 ; $i <= $#$matchVector ; $i++ )
1697 {
1698 if ( defined( $matchVector->[$i] ) )
1699 {
1700 push ( @retval, $a->[$i] );
1701 }
1702 }
1703 return wantarray ? @retval : \@retval;
1704 }
1705
1706 sub LCS_length
1707 {
1708 my $a = shift; # array ref
1709 my $b = shift; # array ref or hash ref
1710 return _longestCommonSubsequence( $a, $b, 1, @_ );
1711 }
1712
1713 sub LCSidx
1714 {
1715 my $a= shift @_;
1716 my $b= shift @_;
1717 my $match= _longestCommonSubsequence( $a, $b, 0, @_ );
1718 my @am= grep defined $match->[$_], 0..$#$match;
1719 my @bm= @{$match}[@am];
1720 return \@am, \@bm;
1721 }
1722
1723 sub compact_diff
1724 {
1725 my $a= shift @_;
1726 my $b= shift @_;
1727 my( $am, $bm )= LCSidx( $a, $b, @_ );
1728 my @cdiff;
1729 my( $ai, $bi )= ( 0, 0 );
1730 push @cdiff, $ai, $bi;
1731 while( 1 ) {
1732 while( @$am && $ai == $am->[0] && $bi == $bm->[0] ) {
1733 shift @$am;
1734 shift @$bm;
1735 ++$ai, ++$bi;
1736 }
1737 push @cdiff, $ai, $bi;
1738 last if ! @$am;
1739 $ai = $am->[0];
1740 $bi = $bm->[0];
1741 push @cdiff, $ai, $bi;
1742 }
1743 push @cdiff, 0+@$a, 0+@$b
1744 if $ai < @$a || $bi < @$b;
1745 return wantarray ? @cdiff : \@cdiff;
1746 }
1747
1748 sub diff
1749 {
1750 my $a = shift; # array ref
1751 my $b = shift; # array ref
1752 my $retval = [];
1753 my $hunk = [];
1754 my $discard = sub {
1755 push @$hunk, [ '-', $_[0], $a->[ $_[0] ] ];
1756 };
1757 my $add = sub {
1758 push @$hunk, [ '+', $_[1], $b->[ $_[1] ] ];
1759 };
1760 my $match = sub {
1761 push @$retval, $hunk
1762 if 0 < @$hunk;
1763 $hunk = []
1764 };
1765 traverse_sequences( $a, $b,
1766 { MATCH => $match, DISCARD_A => $discard, DISCARD_B => $add }, @_ );
1767 &$match();
1768 return wantarray ? @$retval : $retval;
1769 }
1770
1771 sub sdiff
1772 {
1773 my $a = shift; # array ref
1774 my $b = shift; # array ref
1775 my $retval = [];
1776 my $discard = sub { push ( @$retval, [ '-', $a->[ $_[0] ], "" ] ) };
1777 my $add = sub { push ( @$retval, [ '+', "", $b->[ $_[1] ] ] ) };
1778 my $change = sub {
1779 push ( @$retval, [ 'c', $a->[ $_[0] ], $b->[ $_[1] ] ] );
1780 };
1781 my $match = sub {
1782 push ( @$retval, [ 'u', $a->[ $_[0] ], $b->[ $_[1] ] ] );
1783 };
1784 traverse_balanced(
1785 $a,
1786 $b,
1787 {
1788 MATCH => $match,
1789 DISCARD_A => $discard,
1790 DISCARD_B => $add,
1791 CHANGE => $change,
1792 },
1793 @_
1794 );
1795 return wantarray ? @$retval : $retval;
1796 }
1797
1798 ########################################
1799 my $Root= __PACKAGE__;
1800 package Algorithm::Diff::_impl;
1801 use strict;
1802
1803 sub _Idx() { 0 } # $me->[_Idx]: Ref to array of hunk indices
1804 # 1 # $me->[1]: Ref to first sequence
1805 # 2 # $me->[2]: Ref to second sequence
1806 sub _End() { 3 } # $me->[_End]: Diff between forward and reverse pos
1807 sub _Same() { 4 } # $me->[_Same]: 1 if pos 1 contains unchanged items
1808 sub _Base() { 5 } # $me->[_Base]: Added to range's min and max
1809 sub _Pos() { 6 } # $me->[_Pos]: Which hunk is currently selected
1810 sub _Off() { 7 } # $me->[_Off]: Offset into _Idx for current position
1811 sub _Min() { -2 } # Added to _Off to get min instead of max+1
1812
1813 sub Die
1814 {
1815 require Carp;
1816 Carp::confess( @_ );
1817 }
1818
1819 sub _ChkPos
1820 {
1821 my( $me )= @_;
1822 return if $me->[_Pos];
1823 my $meth= ( caller(1) )[3];
1824 Die( "Called $meth on 'reset' object" );
1825 }
1826
1827 sub _ChkSeq
1828 {
1829 my( $me, $seq )= @_;
1830 return $seq + $me->[_Off]
1831 if 1 == $seq || 2 == $seq;
1832 my $meth= ( caller(1) )[3];
1833 Die( "$meth: Invalid sequence number ($seq); must be 1 or 2" );
1834 }
1835
1836 sub getObjPkg
1837 {
1838 my( $us )= @_;
1839 return ref $us if ref $us;
1840 return $us . "::_obj";
1841 }
1842
1843 sub new
1844 {
1845 my( $us, $seq1, $seq2, $opts ) = @_;
1846 my @args;
1847 for( $opts->{keyGen} ) {
1848 push @args, $_ if $_;
1849 }
1850 for( $opts->{keyGenArgs} ) {
1851 push @args, @$_ if $_;
1852 }
1853 my $cdif= Algorithm::Diff::compact_diff( $seq1, $seq2, @args );
1854 my $same= 1;
1855 if( 0 == $cdif->[2] && 0 == $cdif->[3] ) {
1856 $same= 0;
1857 splice @$cdif, 0, 2;
1858 }
1859 my @obj= ( $cdif, $seq1, $seq2 );
1860 $obj[_End] = (1+@$cdif)/2;
1861 $obj[_Same] = $same;
1862 $obj[_Base] = 0;
1863 my $me = bless \@obj, $us->getObjPkg();
1864 $me->Reset( 0 );
1865 return $me;
1866 }
1867
1868 sub Reset
1869 {
1870 my( $me, $pos )= @_;
1871 $pos= int( $pos || 0 );
1872 $pos += $me->[_End]
1873 if $pos < 0;
1874 $pos= 0
1875 if $pos < 0 || $me->[_End] <= $pos;
1876 $me->[_Pos]= $pos || !1;
1877 $me->[_Off]= 2*$pos - 1;
1878 return $me;
1879 }
1880
1881 sub Base
1882 {
1883 my( $me, $base )= @_;
1884 my $oldBase= $me->[_Base];
1885 $me->[_Base]= 0+$base if defined $base;
1886 return $oldBase;
1887 }
1888
1889 sub Copy
1890 {
1891 my( $me, $pos, $base )= @_;
1892 my @obj= @$me;
1893 my $you= bless \@obj, ref($me);
1894 $you->Reset( $pos ) if defined $pos;
1895 $you->Base( $base );
1896 return $you;
1897 }
1898
1899 sub Next {
1900 my( $me, $steps )= @_;
1901 $steps= 1 if ! defined $steps;
1902 if( $steps ) {
1903 my $pos= $me->[_Pos];
1904 my $new= $pos + $steps;
1905 $new= 0 if $pos && $new < 0;
1906 $me->Reset( $new )
1907 }
1908 return $me->[_Pos];
1909 }
1910
1911 sub Prev {
1912 my( $me, $steps )= @_;
1913 $steps= 1 if ! defined $steps;
1914 my $pos= $me->Next(-$steps);
1915 $pos -= $me->[_End] if $pos;
1916 return $pos;
1917 }
1918
1919 sub Diff {
1920 my( $me )= @_;
1921 $me->_ChkPos();
1922 return 0 if $me->[_Same] == ( 1 & $me->[_Pos] );
1923 my $ret= 0;
1924 my $off= $me->[_Off];
1925 for my $seq ( 1, 2 ) {
1926 $ret |= $seq
1927 if $me->[_Idx][ $off + $seq + _Min ]
1928 < $me->[_Idx][ $off + $seq ];
1929 }
1930 return $ret;
1931 }
1932
1933 sub Min {
1934 my( $me, $seq, $base )= @_;
1935 $me->_ChkPos();
1936 my $off= $me->_ChkSeq($seq);
1937 $base= $me->[_Base] if !defined $base;
1938 return $base + $me->[_Idx][ $off + _Min ];
1939 }
1940
1941 sub Max {
1942 my( $me, $seq, $base )= @_;
1943 $me->_ChkPos();
1944 my $off= $me->_ChkSeq($seq);
1945 $base= $me->[_Base] if !defined $base;
1946 return $base + $me->[_Idx][ $off ] -1;
1947 }
1948
1949 sub Range {
1950 my( $me, $seq, $base )= @_;
1951 $me->_ChkPos();
1952 my $off = $me->_ChkSeq($seq);
1953 if( !wantarray ) {
1954 return $me->[_Idx][ $off ]
1955 - $me->[_Idx][ $off + _Min ];
1956 }
1957 $base= $me->[_Base] if !defined $base;
1958 return ( $base + $me->[_Idx][ $off + _Min ] )
1959 .. ( $base + $me->[_Idx][ $off ] - 1 );
1960 }
1961
1962 sub Items {
1963 my( $me, $seq )= @_;
1964 $me->_ChkPos();
1965 my $off = $me->_ChkSeq($seq);
1966 if( !wantarray ) {
1967 return $me->[_Idx][ $off ]
1968 - $me->[_Idx][ $off + _Min ];
1969 }
1970 return
1971 @{$me->[$seq]}[
1972 $me->[_Idx][ $off + _Min ]
1973 .. ( $me->[_Idx][ $off ] - 1 )
1974 ];
1975 }
1976
1977 sub Same {
1978 my( $me )= @_;
1979 $me->_ChkPos();
1980 return wantarray ? () : 0
1981 if $me->[_Same] != ( 1 & $me->[_Pos] );
1982 return $me->Items(1);
1983 }
1984
1985 my %getName;
1986 %getName= (
1987 same => \&Same,
1988 diff => \&Diff,
1989 base => \&Base,
1990 min => \&Min,
1991 max => \&Max,
1992 range=> \&Range,
1993 items=> \&Items, # same thing
1994 );
1995
1996 sub Get
1997 {
1998 my $me= shift @_;
1999 $me->_ChkPos();
2000 my @value;
2001 for my $arg ( @_ ) {
2002 for my $word ( split ' ', $arg ) {
2003 my $meth;
2004 if( $word !~ /^(-?\d+)?([a-zA-Z]+)([12])?$/
2005 || not $meth= $getName{ lc $2 }
2006 ) {
2007 Die( $Root, ", Get: Invalid request ($word)" );
2008 }
2009 my( $base, $name, $seq )= ( $1, $2, $3 );
2010 push @value, scalar(
2011 4 == length($name)
2012 ? $meth->( $me )
2013 : $meth->( $me, $seq, $base )
2014 );
2015 }
2016 }
2017 if( wantarray ) {
2018 return @value;
2019 } elsif( 1 == @value ) {
2020 return $value[0];
2021 }
2022 Die( 0+@value, " values requested from ",
2023 $Root, "'s Get in scalar context" );
2024 }
2025
2026
2027 my $Obj= getObjPkg($Root);
2028 no strict 'refs';
2029
2030 for my $meth ( qw( new getObjPkg ) ) {
2031 *{$Root."::".$meth} = \&{$meth};
2032 *{$Obj ."::".$meth} = \&{$meth};
2033 }
2034 for my $meth ( qw(
2035 Next Prev Reset Copy Base Diff
2036 Same Items Range Min Max Get
2037 _ChkPos _ChkSeq
2038 ) ) {
2039 *{$Obj."::".$meth} = \&{$meth};
2040 }
2041
2042};
2043{
2044 package Algorithm::LCSS;
2045
2046 use strict;
2047 {
2048 no strict 'refs';
2049 *traverse_sequences = \&Algorithm::Diff::traverse_sequences;
2050 }
2051
2052 sub _tokenize { [split //, $_[0]] }
2053
2054 sub CSS {
2055 my $is_array = ref $_[0] eq 'ARRAY' ? 1 : 0;
2056 my ( $seq1, $seq2, @match, $from_match );
2057 my $i = 0;
2058 if ( $is_array ) {
2059 $seq1 = $_[0];
2060 $seq2 = $_[1];
2061 traverse_sequences( $seq1, $seq2, {
2062 MATCH => sub { push @{$match[$i]}, $seq1->[$_[0]]; $from_match = 1 },
2063 DISCARD_A => sub { do{$i++; $from_match = 0} if $from_match },
2064 DISCARD_B => sub { do{$i++; $from_match = 0} if $from_match },
2065 });
2066 }
2067 else {
2068 $seq1 = _tokenize($_[0]);
2069 $seq2 = _tokenize($_[1]);
2070 traverse_sequences( $seq1, $seq2, {
2071 MATCH => sub { $match[$i] .= $seq1->[$_[0]]; $from_match = 1 },
2072 DISCARD_A => sub { do{$i++; $from_match = 0} if $from_match },
2073 DISCARD_B => sub { do{$i++; $from_match = 0} if $from_match },
2074 });
2075 }
2076 return \@match;
2077 }
2078
2079 sub CSS_Sorted {
2080 my $match = CSS(@_);
2081 if ( ref $_[0] eq 'ARRAY' ) {
2082 @$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,scalar(@$_)]}@$match
2083 }
2084 else {
2085 @$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,length($_)]}@$match
2086 }
2087 return $match;
2088 }
2089
2090 sub LCSS {
2091 my $is_array = ref $_[0] eq 'ARRAY' ? 1 : 0;
2092 my $css = CSS(@_);
2093 my $index;
2094 my $length = 0;
2095 if ( $is_array ) {
2096 for( my $i = 0; $i < @$css; $i++ ) {
2097 next unless @{$css->[$i]}>$length;
2098 $index = $i;
2099 $length = @{$css->[$i]};
2100 }
2101 }
2102 else {
2103 for( my $i = 0; $i < @$css; $i++ ) {
2104 next unless length($css->[$i])>$length;
2105 $index = $i;
2106 $length = length($css->[$i]);
2107 }
2108 }
2109 return $css->[$index];
2110 }
2111
2112};
2113# }}}
2114#{{{ Class::Classless module
2115{
2116 package Class::Classless;
2117 use strict;
2118 use vars qw(@ISA);
2119 use Carp;
2120
2121 @ISA = ();
2122
2123 ###########################################################################
2124
2125 @Class::Classless::X::ISA = ();
2126
2127 ###########################################################################
2128 ###########################################################################
2129
2130 sub Class::Classless::X::AUTOLOAD {
2131 # This's the big dispatcher.
2132
2133 my $it = shift @_;
2134 my $m = ($Class::Classless::X::AUTOLOAD =~ m/([^:]+)$/s )
2135 ? $1 : $Class::Classless::X::AUTOLOAD;
2136
2137 croak "Can't call Class::Classless methods (like $m) without an object"
2138 unless ref $it; # sanity, basically.
2139
2140 my $prevstate;
2141 $prevstate = ${shift @_}
2142 if scalar(@_) && defined($_[0]) &&
2143 ref($_[0]) eq 'Class::Classless::CALLSTATE::SHIMMY'
2144 ; # A shim! we were called via $callstate->NEXT
2145
2146 my $no_fail = $prevstate ? $prevstate->[3] : undef;
2147 my $i = $prevstate ? ($prevstate->[1] + 1) : 0;
2148 # where to start scanning
2149 my $lineage;
2150
2151 # Get the linearization of the ISA tree
2152 if($prevstate) {
2153 $lineage = $prevstate->[2];
2154 } elsif(defined $it->{'ISA_CACHE'} and ref $it->{'ISA_CACHE'} ){
2155 $lineage = $it->{'ISA_CACHE'};
2156 } else {
2157 $lineage = [ &Class::Classless::X::ISA_TREE($it) ];
2158 }
2159
2160 # Was:
2161 #my @lineage =
2162 # $prevstate ? @{$prevstate->[2]}
2163 # : &Class::Classless::X::ISA_TREE($it);
2164 # # Get the linearization of the ISA tree
2165 # # ISA-memoization happens in the ISA_TREE function.
2166
2167 for(; $i < @$lineage; ++$i) {
2168
2169 if( !defined($no_fail) and exists($lineage->[$i]{'NO_FAIL'}) ) {
2170 $no_fail = ($lineage->[$i]{'NO_FAIL'} || 0);
2171 # so the first NO_FAIL sets it
2172 }
2173
2174 if( ref($lineage->[$i]{'METHODS'} || 0) # sanity
2175 && exists($lineage->[$i]{'METHODS'}{$m})
2176 ){
2177 # We found what we were after. Now see what to do with it.
2178 my $v = $lineage->[$i]{'METHODS'}{$m};
2179 return $v unless defined $v and ref $v;
2180
2181 if(ref($v) eq 'CODE') { # normal case, I expect!
2182 # Used to have copying of the arglist here.
2183 # But it was apparently useless, so I deleted it
2184 unshift @_,
2185 $it, # $_[0] -- target object
2186 # a NEW callstate
2187 bless([$m, $i, $lineage, $no_fail, $prevstate ? 1 : 0],
2188 'Class::Classless::CALLSTATE'
2189 ), # $_[1] -- the callstate
2190 ;
2191 goto &{ $v }; # yes, magic goto! bimskalabim!
2192 }
2193 return @$v if ref($v) eq '_deref_array';
2194 return $$v if ref($v) eq '_deref_scalar';
2195 return $v; # fallthru
2196 }
2197 }
2198
2199 if($m eq 'DESTROY') { # mitigate DESTROY-lookup failure at global destruction
2200 # should be impossible
2201 } else {
2202 if($no_fail || 0) {
2203 return;
2204 }
2205 croak "Can't find ", $prevstate ? 'NEXT method' : 'method',
2206 " $m in ", $it->{'NAME'} || $it,
2207 " or any ancestors\n";
2208 }
2209 }
2210
2211 ###########################################################################
2212 ###########################################################################
2213
2214 sub Class::Classless::X::DESTROY {
2215 # noop
2216 }
2217
2218 ###########################################################################
2219 sub Class::Classless::X::ISA_TREE {
2220 # The linearizer!
2221 # Returns the search path for $_[0], starting with $_[0]
2222 # Possibly memoized.
2223
2224 # I stopped being able to understand this algorithm about five
2225 # minutes after I wrote it.
2226 use strict;
2227
2228 my $set_cache = 0; # flag to set the cache on the way out
2229
2230 if(exists($_[0]{'ISA_CACHE'})) {
2231 return @{$_[0]{'ISA_CACHE'}}
2232 if defined $_[0]{'ISA_CACHE'}
2233 and ref $_[0]{'ISA_CACHE'};
2234
2235 # Otherwise, if exists but is not a ref, it's a signal that it should
2236 # be replaced at the earliest, with a listref
2237 $set_cache = 1;
2238 }
2239
2240 my $has_mi = 0; # set to 0 on the first node we see with 2 parents!
2241 # First, just figure out what's in the tree.
2242 my %last_child = ($_[0] => 1); # as if already seen
2243
2244 # if $last_child{$x} == $y, that means:
2245 # 1) incidentally, we've passed the node $x before.
2246 # 2) $x is the last child of $y,
2247 # so that means that $y can be pushed to the stack only after
2248 # we've pushed $x to the stack.
2249
2250 my @tree_nodes;
2251 {
2252 my $current;
2253 my @in_stack = ($_[0]);
2254 while(@in_stack) {
2255 next unless
2256 defined($current = shift @in_stack)
2257 && ref($current) # sanity
2258 && ref($current->{'PARENTS'} || 0) # sanity
2259 ;
2260
2261 push @tree_nodes, $current;
2262
2263 $has_mi = 1 if @{$current->{'PARENTS'}} > 1;
2264 unshift
2265 @in_stack,
2266 map {
2267 if(exists $last_child{$_}) { # seen before!
2268 $last_child{$_} = $current;
2269 (); # seen -- don't re-explore
2270 } else { # first time seen
2271 $last_child{$_} = $current;
2272 $_; # first time seen -- explore now
2273 }
2274 }
2275 @{$current->{'PARENTS'}}
2276 ;
2277 }
2278
2279 # If there was no MI, then that first scan was sufficient.
2280 unless($has_mi) {
2281 $_[0]{'ISA_CACHE'} = \@tree_nodes if $set_cache;
2282 return @tree_nodes;
2283 }
2284
2285 # Otherwise, toss this list and rescan, consulting %last_child
2286 }
2287
2288 # $last_child{$parent} holds the last (or only) child of $parent
2289 # in this tree. When walking the tree this time, only that
2290 # child is authorized to put its parent on the @in_stack.
2291 # And that's the only way a node can get added to @in_stack,
2292 # except for $_[0] (the start node) being there at the beginning.
2293
2294 # Now, walk again, but this time exploring parents the LAST
2295 # time seen in the tree, not the first.
2296
2297 my @out;
2298 {
2299 my $current;
2300 my @in_stack = ($_[0]);
2301 while(@in_stack) {
2302 next unless defined($current = shift @in_stack) && ref($current);
2303 push @out, $current; # finally.
2304 unshift
2305 @in_stack,
2306 grep(
2307 (
2308 defined($_) # sanity
2309 && ref($_) # sanity
2310 && $last_child{$_} eq $current,
2311 ),
2312 # I'm lastborn (or onlyborn) of this parent
2313 # so it's OK to explore now
2314 @{$current->{'PARENTS'}}
2315 )
2316 if ref($current->{'PARENTS'} || 0) # sanity
2317 ;
2318 }
2319
2320 unless(scalar(@out) == scalar(keys(%last_child))) {
2321 # the counts should be equal
2322 my %good_ones;
2323 @good_ones{@out} = ();
2324 croak
2325 "ISA tree for " .
2326 ($_[0]{'NAME'} || $_[0]) .
2327 " is apparently cyclic, probably involving the nodes " .
2328 nodelist( grep { ref($_) && !exists $good_ones{$_} }
2329 values(%last_child) )
2330 . "\n";
2331 }
2332 }
2333 #print "Contents of out: ", nodelist(@out), "\n";
2334
2335 $_[0]{'ISA_CACHE'} = \@out if $set_cache;
2336 return @out;
2337 }
2338
2339 ###########################################################################
2340
2341 sub Class::Classless::X::can { # NOT like UNIVERSAL::can ...
2342 # return 1 if $it is capable of the method given -- otherwise 0
2343 my($it, $m) = @_[0,1];
2344 return undef unless ref $it;
2345
2346 croak "undef is not a valid method name" unless defined($m);
2347 croak "null-string is not a valid method name" unless length($m);
2348
2349 foreach my $o (&Class::Classless::X::ISA_TREE($it)) {
2350 return 1
2351 if ref($o->{'METHODS'} || 0) # sanity
2352 && exists $o->{'METHODS'}{$m};
2353 }
2354
2355 return 0;
2356 }
2357
2358
2359 ###########################################################################
2360
2361 sub Class::Classless::X::isa { # Like UNIVERSAL::isa
2362 # Returns true for $X->isa($Y) iff $Y is $X or is an ancestor of $X.
2363
2364 return unless ref($_[0]) && ref($_[1]);
2365 return scalar(grep {$_ eq $_[1]} &Class::Classless::X::ISA_TREE($_[0]));
2366 }
2367
2368 ###########################################################################
2369
2370 sub nodelist { join ', ', map { "" . ($_->{'NAME'} || $_) . ""} @_ }
2371
2372 ###########################################################################
2373 ###########################################################################
2374 ###########################################################################
2375 # Methods for the CALLSTATE class.
2376 # Basically, CALLSTATE objects represent the state of the dispatcher,
2377 # frozen at the moment when the method call was dispatched to the
2378 # appropriate sub.
2379 # In the grand scheme of things, this needn't be a class -- I could
2380 # have just made the callstate data-object be a hash with documented
2381 # keys, or a closure that responded to only certain parameters,
2382 # etc. But I like it this way. And I like being able to say simply
2383 # $cs->NEXT
2384 # Yes, these are a bit cryptically written, but it's behoovy for
2385 # them to be very very efficient.
2386
2387 @Class::Classless::ISA = ();
2388 sub Class::Classless::CALLSTATE::found_name { $_[0][0] }
2389 # the method name called and found
2390 sub Class::Classless::CALLSTATE::found_depth { $_[0][1] }
2391 # my depth in the lineage
2392 sub Class::Classless::CALLSTATE::lineage { @{$_[0][2]} }
2393 # my lineage
2394 sub Class::Classless::CALLSTATE::target { $_[0][2][ 0 ] }
2395 # the object that's the target -- same as $_[0] for the method called
2396 sub Class::Classless::CALLSTATE::home { $_[0][2][ $_[0][1] ] }
2397 # the object I was found in
2398 sub Class::Classless::CALLSTATE::sub_found {
2399 $_[0][2][ $_[0][1] ]{'METHODS'}{ $_[0][0] }
2400 } # the routine called
2401
2402 sub Class::Classless::CALLSTATE::no_fail { $_[0][3] }
2403 sub Class::Classless::CALLSTATE::set_no_fail_true { $_[0][3] = 1 }
2404 sub Class::Classless::CALLSTATE::set_fail_false { $_[0][3] = 0 }
2405 sub Class::Classless::CALLSTATE::set_fail_undef { $_[0][3] = undef }
2406
2407 sub Class::Classless::CALLSTATE::via_next { $_[0][4] }
2408
2409 sub Class::Classless::CALLSTATE::NEXT {
2410 #croak "NEXT needs at least one argument: \$cs->NEXT('method'...)"
2411 # unless @_ > 1;
2412 # no longer true.
2413 my $cs = shift @_;
2414 my $m = shift @_; # which may be (or come out) undef...
2415 $m = $cs->[0] unless defined $m; # the method name called and found
2416
2417 ($cs->[2][0])->$m(
2418 bless( \$cs, 'Class::Classless::CALLSTATE::SHIMMY' ),
2419 @_
2420 );
2421 }
2422
2423 ###########################################################################
2424};
2425#}}}
2426
2427###############
2428###
2429#
2430# {{{ *** C h a n g e l o g ***
2431#
2432# 0.6ca
2433# - add screen support (from nicklist.pl)
2434# - rename to adv_windowlist.pl (advanced window list) since it isn't just a
2435# window list status bar (wlstat) anymore
2436# - names can now have a max length and window names can be used
2437# - fixed a bug with block display in screen mode and statusbar mode
2438# - added space handling to ir_fe and removed it again
2439# - now handling formats on my own
2440# - added warning about missing sb_act_none abstract leading to
2441# - display*active settings
2442# - added warning about the bug in awl_display_(no)key_active settings
2443#
2444# 0.5d
2445# - add setting to also hide the last statusbar if empty (awl_all_disable)
2446# - reverted to old utf8 code to also calculate broken utf8 length correctly
2447# - simplified dealing with statusbars in wlreset
2448# - added a little tweak for the renamed term_type somewhere after Irssi 0.8.9
2449# - fixed bug in handling channel #$$
2450# - typo on line 200 spotted by f0rked
2451# - reset background colour at the beginning of an entry
2452#
2453# 0.4d
2454# - fixed order of disabling statusbars
2455# - several attempts at special chars, without any real success
2456# and much more weird new bugs caused by this
2457# - setting to specify sort order
2458# - reduced timeout values
2459# - added awl_hide_data for Geert Hauwaerts ( geert@irssi.org ) :)
2460# - make it so the dynamic sub is actually deleted
2461# - fix a bug with removing of the last separator
2462# - take into consideration parse_special
2463#
2464# 0.3b
2465# - automatically kill old statusbars
2466# - reset on /reload
2467# - position/placement settings
2468#
2469# 0.2
2470# - automated retrieval of key bindings (thanks grep.pl authors)
2471# - improved removing of statusbars
2472# - got rid of status chop
2473#
2474# 0.1
2475# - rewritten to suit my needs
2476# - based on chanact 0.5.5
2477# }}}
2478# vim: se fdm=marker tw=80 :
diff --git a/.irssi/scripts/autorun/twirssi.pl b/.irssi/scripts/autorun/twirssi.pl
new file mode 120000
index 0000000..5722034
--- /dev/null
+++ b/.irssi/scripts/autorun/twirssi.pl
@@ -0,0 +1 @@
../twirssi.pl \ No newline at end of file
diff --git a/.irssi/scripts/twirssi.pl b/.irssi/scripts/twirssi.pl
new file mode 100644
index 0000000..12bfad7
--- /dev/null
+++ b/.irssi/scripts/twirssi.pl
@@ -0,0 +1,1901 @@
1use strict;
2use Irssi;
3use Irssi::Irc;
4use HTTP::Date;
5use HTML::Entities;
6use File::Temp;
7use LWP::Simple;
8use Data::Dumper;
9use Encode;
10$Data::Dumper::Indent = 1;
11
12use vars qw($VERSION %IRSSI);
13
14$VERSION = "2.3.0";
15%IRSSI = (
16 authors => 'Dan Boger',
17 contact => 'zigdon@gmail.com',
18 name => 'twirssi',
19 description => 'Send twitter updates using /tweet. '
20 . 'Can optionally set your bitlbee /away message to same',
21 license => 'GNU GPL v2',
22 url => 'http://twirssi.com',
23 changed => '$Date$',
24);
25
26my $window;
27my $twit;
28my %twits;
29my $user;
30my $defservice;
31my $poll;
32my $last_poll;
33my $last_friends_poll = 0;
34my %nicks;
35my %friends;
36my %tweet_cache;
37my %id_map;
38my $failwhale = 0;
39my $first_call = 1;
40my $child_pid;
41my %fix_replies_index;
42
43my %irssi_to_mirc_colors = (
44 '%k' => '01',
45 '%r' => '05',
46 '%g' => '03',
47 '%y' => '07',
48 '%b' => '02',
49 '%m' => '06',
50 '%c' => '10',
51 '%w' => '15',
52 '%K' => '14',
53 '%R' => '04',
54 '%G' => '09',
55 '%Y' => '08',
56 '%B' => '12',
57 '%M' => '13',
58 '%C' => '11',
59 '%W' => '00',
60);
61
62sub cmd_direct {
63 my ( $data, $server, $win ) = @_;
64
65 return unless &logged_in($twit);
66
67 my ( $target, $text ) = split ' ', $data, 2;
68 unless ( $target and $text ) {
69 &notice("Usage: /dm <nick> <message>");
70 return;
71 }
72
73 &cmd_direct_as( "$user $data", $server, $win );
74}
75
76sub cmd_direct_as {
77 my ( $data, $server, $win ) = @_;
78
79 return unless &logged_in($twit);
80
81 my ( $username, $target, $text ) = split ' ', $data, 3;
82 unless ( $username and $target and $text ) {
83 &notice("Usage: /dm_as <username> <nick> <message>");
84 return;
85 }
86
87 return unless $username = &valid_username($username);
88
89 eval {
90 if ( $twits{$username}
91 ->new_direct_message( { user => $target, text => $text } ) )
92 {
93 &notice("DM sent to $target: $text");
94 $nicks{$target} = time;
95 } else {
96 my $error;
97 eval {
98 $error = JSON::Any->jsonToObj( $twits{$username}->get_error() );
99 $error = $error->{error};
100 };
101 die $error if $error;
102 &notice("DM to $target failed");
103 }
104 };
105
106 if ($@) {
107 &notice("DM caused an error: $@");
108 return;
109 }
110}
111
112sub cmd_retweet {
113 my ( $data, $server, $win ) = @_;
114
115 return unless &logged_in($twit);
116
117 $data =~ s/^\s+|\s+$//;
118 unless ($data) {
119 &notice("Usage: /retweet <nick[:num]> [comment]");
120 return;
121 }
122
123 my ( $id, $data ) = split ' ', $data, 2;
124
125 &cmd_retweet_as( "$user $id $data", $server, $win );
126}
127
128sub cmd_retweet_as {
129 my ( $data, $server, $win ) = @_;
130
131 unless ( Irssi::settings_get_bool("twirssi_track_replies") ) {
132 &notice("twirssi_track_replies is required in order to reteet.");
133 return;
134 }
135
136 return unless &logged_in($twit);
137
138 $data =~ s/^\s+|\s+$//;
139 my ( $username, $id, $data ) = split ' ', $data, 3;
140
141 unless ($username) {
142 &notice("Usage: /retweet_as <username> <nick[:num]> [comment]");
143 return;
144 }
145
146 return unless $username = &valid_username($username);
147
148 my $nick;
149 $id =~ s/[^\w\d\-:]+//g;
150 ( $nick, $id ) = split /:/, $id;
151 unless ( exists $id_map{ lc $nick } ) {
152 &notice("Can't find a tweet from $nick to retweet!");
153 return;
154 }
155
156 $id = $id_map{__indexes}{$nick} unless $id;
157 unless ( $id_map{ lc $nick }[$id] ) {
158 &notice("Can't find a tweet numbered $id from $nick to retweet!");
159 return;
160 }
161
162 unless ( $id_map{__tweets}{ lc $nick }[$id] ) {
163 &notice("The text of this tweet isn't saved, sorry!");
164 return;
165 }
166
167# Irssi::settings_add_str( "twirssi", "twirssi_retweet_format", 'RT $n: $t ${-- $c$}' );
168 my $text = Irssi::settings_get_str("twirssi_retweet_format");
169 $text =~ s/\$n/\@$nick/g;
170 if ($data) {
171 $text =~ s/\${|\$}//g;
172 $text =~ s/\$c/$data/;
173 } else {
174 $text =~ s/\${.*?\$}//;
175 }
176 $text =~ s/\$t/$id_map{__tweets}{ lc $nick }[$id]/;
177
178 $data = &shorten($text);
179
180 return if &too_long($data);
181
182 my $success = 1;
183 eval {
184 unless (
185 $twits{$username}->update(
186 {
187 status => $data,
188
189 # in_reply_to_status_id => $id_map{ lc $nick }[$id]
190 }
191 )
192 )
193 {
194 &notice("Update failed");
195 $success = 0;
196 }
197 };
198 return unless $success;
199
200 if ($@) {
201 &notice("Update caused an error: $@. Aborted");
202 return;
203 }
204
205 foreach ( $data =~ /@([-\w]+)/ ) {
206 $nicks{$1} = time;
207 }
208
209 &notice("Retweet sent");
210}
211
212sub cmd_tweet {
213 my ( $data, $server, $win ) = @_;
214
215 return unless &logged_in($twit);
216
217 $data =~ s/^\s+|\s+$//;
218 unless ($data) {
219 &notice("Usage: /tweet <update>");
220 return;
221 }
222
223 &cmd_tweet_as( "$user\@$defservice $data", $server, $win );
224}
225
226sub cmd_tweet_as {
227 my ( $data, $server, $win ) = @_;
228
229 return unless &logged_in($twit);
230
231 $data =~ s/^\s+|\s+$//;
232 $data =~ s/\s\s+/ /g;
233 my ( $username, $data ) = split ' ', $data, 2;
234
235 unless ( $username and $data ) {
236 &notice("Usage: /tweet_as <username> <update>");
237 return;
238 }
239
240 return unless $username = &valid_username($username);
241
242 $data = &shorten($data);
243
244 return if &too_long($data);
245
246 my $success = 1;
247 eval {
248 unless ( $twits{$username}->update($data) )
249 {
250 &notice("Update failed");
251 $success = 0;
252 }
253 };
254 return unless $success;
255
256 if ($@) {
257 &notice("Update caused an error: $@. Aborted.");
258 return;
259 }
260
261 foreach ( $data =~ /@([-\w]+)/ ) {
262 $nicks{$1} = time;
263 }
264
265 my $away = &update_away($data);
266
267 &notice( "Update sent" . ( $away ? " (and away msg set)" : "" ) );
268}
269
270sub cmd_reply {
271 my ( $data, $server, $win ) = @_;
272
273 return unless &logged_in($twit);
274
275 $data =~ s/^\s+|\s+$//;
276 unless ($data) {
277 &notice("Usage: /reply <nick[:num]> <update>");
278 return;
279 }
280
281 my ( $id, $data ) = split ' ', $data, 2;
282 unless ( $id and $data ) {
283 &notice("Usage: /reply <nick[:num]> <update>");
284 return;
285 }
286
287 &cmd_reply_as( "$user $id $data", $server, $win );
288}
289
290sub cmd_reply_as {
291 my ( $data, $server, $win ) = @_;
292
293 unless ( Irssi::settings_get_bool("twirssi_track_replies") ) {
294 &notice("twirssi_track_replies is required in order to reply to "
295 . "specific tweets. Either enable it, or just use /tweet "
296 . "\@username <text>." );
297 return;
298 }
299
300 return unless &logged_in($twit);
301
302 $data =~ s/^\s+|\s+$//;
303 my ( $username, $id, $data ) = split ' ', $data, 3;
304
305 unless ( $username and $data ) {
306 &notice("Usage: /reply_as <username> <nick[:num]> <update>");
307 return;
308 }
309
310 return unless $username = &valid_username($username);
311
312 my $nick;
313 $id =~ s/[^\w\d\-:]+//g;
314 ( $nick, $id ) = split /:/, $id;
315 unless ( exists $id_map{ lc $nick } ) {
316 &notice("Can't find a tweet from $nick to reply to!");
317 return;
318 }
319
320 $id = $id_map{__indexes}{$nick} unless $id;
321 unless ( $id_map{ lc $nick }[$id] ) {
322 &notice("Can't find a tweet numbered $id from $nick to reply to!");
323 return;
324 }
325
326 if ( Irssi::settings_get_bool("twirssi_replies_autonick") ) {
327
328 # remove any @nick at the beginning of the reply, as we'll add it anyway
329 $data =~ s/^\s*\@?$nick\s*//;
330 $data = "\@$nick " . $data;
331 }
332
333 $data = &shorten($data);
334
335 return if &too_long($data);
336
337 my $success = 1;
338 eval {
339 unless (
340 $twits{$username}->update(
341 {
342 status => $data,
343 in_reply_to_status_id => $id_map{ lc $nick }[$id]
344 }
345 )
346 )
347 {
348 &notice("Update failed");
349 $success = 0;
350 }
351 };
352 return unless $success;
353
354 if ($@) {
355 &notice("Update caused an error: $@. Aborted");
356 return;
357 }
358
359 foreach ( $data =~ /@([-\w]+)/ ) {
360 $nicks{$1} = time;
361 }
362
363 my $away = &update_away($data);
364
365 &notice( "Update sent" . ( $away ? " (and away msg set)" : "" ) );
366}
367
368sub gen_cmd {
369 my ( $usage_str, $api_name, $post_ref ) = @_;
370
371 return sub {
372 my ( $data, $server, $win ) = @_;
373
374 return unless &logged_in($twit);
375
376 $data =~ s/^\s+|\s+$//;
377 unless ($data) {
378 &notice("Usage: $usage_str");
379 return;
380 }
381
382 my $success = 1;
383 eval {
384 unless ( $twit->$api_name($data) )
385 {
386 &notice("$api_name failed");
387 $success = 0;
388 }
389 };
390 return unless $success;
391
392 if ($@) {
393 &notice("$api_name caused an error. Aborted.");
394 return;
395 }
396
397 &$post_ref($data) if $post_ref;
398 }
399}
400
401sub cmd_switch {
402 my ( $data, $server, $win ) = @_;
403
404 $data =~ s/^\s+|\s+$//g;
405 $data = &normalize_username($data);
406 if ( exists $twits{$data} ) {
407 &notice("Switching to $data");
408 $twit = $twits{$data};
409 if ( $data =~ /(.*)\@(.*)/ ) {
410 $user = $1;
411 $defservice = $2;
412 } else {
413 &notice("Couldn't figure out what service '$data' is on");
414 }
415 } else {
416 &notice("Unknown user $data");
417 }
418}
419
420sub cmd_logout {
421 my ( $data, $server, $win ) = @_;
422
423 $data =~ s/^\s+|\s+$//g;
424 $data = $user unless $data;
425 return unless $data = &valid_username($data);
426
427 &notice("Logging out $data...");
428 $twits{$data}->end_session();
429 delete $twits{$data};
430 undef $twit;
431 if ( keys %twits ) {
432 &cmd_switch( ( keys %twits )[0], $server, $win );
433 } else {
434 Irssi::timeout_remove($poll) if $poll;
435 undef $poll;
436 }
437}
438
439sub cmd_login {
440 my ( $data, $server, $win ) = @_;
441 my $pass;
442 if ($data) {
443 ( $user, $pass ) = split ' ', $data, 2;
444 unless ($pass) {
445 &notice("usage: /twitter_login <username>[\@<service>] <password>");
446 return;
447 }
448 } elsif ( my $autouser = Irssi::settings_get_str("twitter_usernames")
449 and my $autopass = Irssi::settings_get_str("twitter_passwords") )
450 {
451 my @user = split /\s*,\s*/, $autouser;
452 my @pass = split /\s*,\s*/, $autopass;
453
454 # if a password ends with a '\', it was meant to escape the comma, and
455 # it should be concatinated with the next one
456 my @unescaped;
457 while (@pass) {
458 my $p = shift @pass;
459 while ( $p =~ /\\$/ and @pass ) {
460 $p .= "," . shift @pass;
461 }
462 push @unescaped, $p;
463 }
464
465 if ( @user != @unescaped ) {
466 &notice("Number of usernames doesn't match "
467 . "the number of passwords - auto-login failed" );
468 } else {
469 my ( $u, $p );
470 while ( @user and @unescaped ) {
471 $u = shift @user;
472 $p = shift @unescaped;
473 &cmd_login("$u $p");
474 }
475 return;
476 }
477 } else {
478 &notice("/twitter_login requires either a username and password "
479 . "or twitter_usernames and twitter_passwords to be set." );
480 return;
481 }
482
483 %friends = %nicks = ();
484
485 my $service;
486 if ( $user =~ /^(.*)@(twitter|identica)$/ ) {
487 ( $user, $service ) = ( $1, $2 );
488 } else {
489 $service = Irssi::settings_get_str("twirssi_default_service");
490 }
491 $defservice = $service = ucfirst lc $service;
492
493 eval "use Net::$service";
494 if ($@) {
495 &notice(
496 "Failed to load Net::$service when trying to log in as $user: $@");
497 return;
498 }
499
500 $twit = "Net::$service"->new(
501 username => $user,
502 password => $pass,
503 source => "twirssi",
504 ssl => Irssi::settings_get_bool("twirssi_avoid_ssl") ? 0 : 1,
505 );
506
507 unless ($twit) {
508 &notice("Failed to create Net::$service object! Aborting.");
509 return;
510 }
511
512 if ( my $timeout = Irssi::settings_get_int("twitter_timeout")
513 and $twit->can('ua') )
514 {
515 $twit->ua->timeout($timeout);
516 }
517
518 unless ( $twit->verify_credentials() ) {
519 &notice("Login as $user\@$service failed");
520
521 if ( not Irssi::settings_get_bool("twirssi_avoid_ssl") ) {
522 &notice(
523 "It's possible you're missing one of the modules required for "
524 . "SSL logins. Try setting twirssi_avoid_ssl to on. See "
525 . "http://cpansearch.perl.org/src/GAAS/libwww-perl-5.831/README.SSL "
526 . "for the detailed requirements." );
527 }
528
529 $twit = undef;
530 if ( keys %twits ) {
531 &cmd_switch( ( keys %twits )[0], $server, $win );
532 }
533 return;
534 }
535
536 if ($twit) {
537 my $rate_limit = $twit->rate_limit_status();
538 if ( $rate_limit and $rate_limit->{remaining_hits} < 1 ) {
539 &notice(
540 "Rate limit exceeded, try again after $rate_limit->{reset_time}"
541 );
542 $twit = undef;
543 return;
544 }
545
546 $twits{"$user\@$service"} = $twit;
547 Irssi::timeout_remove($poll) if $poll;
548 $poll = Irssi::timeout_add( &get_poll_time * 1000, \&get_updates, "" );
549 &notice("Logged in as $user\@$service, loading friends list...");
550 &load_friends();
551 &notice( "loaded friends: ", scalar keys %friends );
552 if ( Irssi::settings_get_bool("twirssi_first_run") ) {
553 Irssi::settings_set_bool( "twirssi_first_run", 0 );
554 }
555 %nicks = %friends;
556 $nicks{$user} = 0;
557 return 1;
558 } else {
559 &notice("Login failed");
560 }
561}
562
563sub cmd_add_follow {
564 my ( $data, $server, $win ) = @_;
565
566 unless ($data) {
567 &notice("Usage: /twitter_add_follow_extra <username>");
568 return;
569 }
570
571 $data =~ s/^\s+|\s+$//;
572 $data =~ s/^\@//;
573 $data = lc $data;
574
575 if ( exists $id_map{__fixreplies}{"$user\@$defservice"}{$data} ) {
576 &notice("Already following all replies by \@$data");
577 return;
578 }
579
580 $id_map{__fixreplies}{"$user\@$defservice"}{$data} = 1;
581 &notice("Will now follow all replies by \@$data");
582}
583
584sub cmd_del_follow {
585 my ( $data, $server, $win ) = @_;
586
587 unless ($data) {
588 &notice("Usage: /twitter_del_follow_extra <username>");
589 return;
590 }
591
592 $data =~ s/^\s+|\s+$//;
593 $data =~ s/^\@//;
594 $data = lc $data;
595
596 unless ( exists $id_map{__fixreplies}{"$user\@$defservice"}{$data} ) {
597 &notice("Wasn't following all replies by \@$data");
598 return;
599 }
600
601 delete $id_map{__fixreplies}{"$user\@$defservice"}{$data};
602 &notice("Will no longer follow all replies by \@$data");
603}
604
605sub cmd_list_follow {
606 my ( $data, $server, $win ) = @_;
607
608 my $found = 0;
609 foreach my $suser ( sort keys %{ $id_map{__fixreplies} } ) {
610 my $frusers;
611 foreach my $fruser ( sort keys %{ $id_map{__fixreplies}{$suser} } ) {
612 $frusers = $frusers ? "$frusers, $fruser" : $fruser;
613 }
614 if ($frusers) {
615 $found = 1;
616 &notice("Following all replies as \@$suser: $frusers");
617 }
618 }
619
620 unless ($found) {
621 &notice("Not following all replies by anyone");
622 }
623}
624
625sub cmd_add_search {
626 my ( $data, $server, $win ) = @_;
627
628 unless ( $twit and $twit->can('search') ) {
629 &notice("ERROR: Your version of Net::Twitter ($Net::Twitter::VERSION) "
630 . "doesn't support searches." );
631 return;
632 }
633
634 $data =~ s/^\s+|\s+$//;
635 $data = lc $data;
636
637 unless ($data) {
638 &notice("Usage: /twitter_subscribe <topic>");
639 return;
640 }
641
642 if ( exists $id_map{__searches}{"$user\@$defservice"}{$data} ) {
643 &notice("Already had a subscription for '$data'");
644 return;
645 }
646
647 $id_map{__searches}{"$user\@$defservice"}{$data} = 1;
648 &notice("Added subscription for '$data'");
649}
650
651sub cmd_del_search {
652 my ( $data, $server, $win ) = @_;
653
654 unless ( $twit and $twit->can('search') ) {
655 &notice("ERROR: Your version of Net::Twitter ($Net::Twitter::VERSION) "
656 . "doesn't support searches." );
657 return;
658 }
659 $data =~ s/^\s+|\s+$//;
660 $data = lc $data;
661
662 unless ($data) {
663 &notice("Usage: /twitter_unsubscribe <topic>");
664 return;
665 }
666
667 unless ( exists $id_map{__searches}{"$user\@$defservice"}{$data} ) {
668 &notice("No subscription found for '$data'");
669 return;
670 }
671
672 delete $id_map{__searches}{"$user\@$defservice"}{$data};
673 &notice("Removed subscription for '$data'");
674}
675
676sub cmd_list_search {
677 my ( $data, $server, $win ) = @_;
678
679 my $found = 0;
680 foreach my $suser ( sort keys %{ $id_map{__searches} } ) {
681 my $topics;
682 foreach my $topic ( sort keys %{ $id_map{__searches}{$suser} } ) {
683 $topics = $topics ? "$topics, $topic" : $topic;
684 }
685 if ($topics) {
686 $found = 1;
687 &notice("Search subscriptions for \@$suser: $topics");
688 }
689 }
690
691 unless ($found) {
692 &notice("No search subscriptions set up");
693 }
694}
695
696sub cmd_upgrade {
697 my ( $data, $server, $win ) = @_;
698
699 my $loc = Irssi::settings_get_str("twirssi_location");
700 unless ( -w $loc ) {
701 &notice("$loc isn't writable, can't upgrade."
702 . " Perhaps you need to /set twirssi_location?" );
703 return;
704 }
705
706 my $md5;
707 unless ( $data or Irssi::settings_get_bool("twirssi_upgrade_beta") ) {
708 eval { use Digest::MD5; };
709
710 if ($@) {
711 &notice("Failed to load Digest::MD5."
712 . " Try '/twirssi_upgrade nomd5' to skip MD5 verification" );
713 return;
714 }
715
716 $md5 = get("http://twirssi.com/md5sum");
717 chomp $md5;
718 $md5 =~ s/ .*//;
719 unless ($md5) {
720 &notice("Failed to download md5sum from peeron! Aborting.");
721 return;
722 }
723
724 unless ( open( CUR, $loc ) ) {
725 &notice("Failed to read $loc."
726 . " Check that /set twirssi_location is set to the correct location."
727 );
728 return;
729 }
730
731 my $cur_md5 = Digest::MD5::md5_hex(<CUR>);
732 close CUR;
733
734 if ( $cur_md5 eq $md5 ) {
735 &notice("Current twirssi seems to be up to date.");
736 return;
737 }
738 }
739
740 my $URL =
741 Irssi::settings_get_bool("twirssi_upgrade_beta")
742 ? "http://github.com/zigdon/twirssi/raw/master/twirssi.pl"
743 : "http://twirssi.com/twirssi.pl";
744 &notice("Downloading twirssi from $URL");
745 LWP::Simple::getstore( $URL, "$loc.upgrade" );
746
747 unless ( -s "$loc.upgrade" ) {
748 &notice("Failed to save $loc.upgrade."
749 . " Check that /set twirssi_location is set to the correct location."
750 );
751 return;
752 }
753
754 unless ( $data or Irssi::settings_get_bool("twirssi_upgrade_beta") ) {
755 unless ( open( NEW, "$loc.upgrade" ) ) {
756 &notice("Failed to read $loc.upgrade."
757 . " Check that /set twirssi_location is set to the correct location."
758 );
759 return;
760 }
761
762 my $new_md5 = Digest::MD5::md5_hex(<NEW>);
763 close NEW;
764
765 if ( $new_md5 ne $md5 ) {
766 &notice("MD5 verification failed. expected $md5, got $new_md5");
767 return;
768 }
769 }
770
771 rename $loc, "$loc.backup"
772 or &notice("Failed to back up $loc: $!. Aborting")
773 and return;
774 rename "$loc.upgrade", $loc
775 or &notice("Failed to rename $loc.upgrade: $!. Aborting")
776 and return;
777
778 my ( $dir, $file ) = ( $loc =~ m{(.*)/([^/]+)$} );
779 if ( -e "$dir/autorun/$file" ) {
780 &notice("Updating $dir/autorun/$file");
781 unlink "$dir/autorun/$file"
782 or &notice("Failed to remove old $file from autorun: $!");
783 symlink "../$file", "$dir/autorun/$file"
784 or &notice("Failed to create symlink in autorun directory: $!");
785 }
786
787 &notice("Download complete. Reload twirssi with /script load $file");
788}
789
790sub load_friends {
791 my $fh = shift;
792 my $cursor = -1;
793 my $page = 1;
794 my %new_friends;
795 eval {
796 while ( $page < 11 and $cursor ne "0" )
797 {
798 print $fh "type:debug Loading friends page $page...\n"
799 if ( $fh and &debug );
800 my $friends;
801 if ( ref $twit =~ /^Net::Twitter/ ) {
802 $friends = $twit->friends( { cursor => $cursor } );
803 last unless $friends;
804 $cursor = $friends->{next_cursor};
805 $friends = $friends->{users};
806 } else {
807 $friends = $twit->friends( { page => $page } );
808 last unless $friends;
809 }
810 $new_friends{ $_->{screen_name} } = time foreach @$friends;
811 $page++;
812 }
813 };
814
815 if ($@) {
816 print $fh "type:debug Error during friends list update. Aborted.\n";
817 return;
818 }
819
820 my ( $added, $removed ) = ( 0, 0 );
821 print $fh "type:debug Scanning for new friends...\n" if ( $fh and &debug );
822 foreach ( keys %new_friends ) {
823 next if exists $friends{$_};
824 $friends{$_} = time;
825 $added++;
826 }
827
828 print $fh "type:debug Scanning for removed friends...\n"
829 if ( $fh and &debug );
830 foreach ( keys %friends ) {
831 next if exists $new_friends{$_};
832 delete $friends{$_};
833 $removed++;
834 }
835
836 return ( $added, $removed );
837}
838
839sub get_updates {
840 print scalar localtime, " - get_updates starting" if &debug;
841
842 $window =
843 Irssi::window_find_name( Irssi::settings_get_str('twitter_window') );
844 unless ($window) {
845 Irssi::active_win()
846 ->print( "Can't find a window named '"
847 . Irssi::settings_get_str('twitter_window')
848 . "'. Create it or change the value of twitter_window" );
849 }
850
851 return unless &logged_in($twit);
852
853 my ( $fh, $filename ) = File::Temp::tempfile();
854 binmode( $fh, ":utf8" );
855 $child_pid = fork();
856
857 if ($child_pid) { # parent
858 Irssi::timeout_add_once( 5000, 'monitor_child',
859 [ "$filename.done", 0 ] );
860 Irssi::pidwait_add($child_pid);
861 } elsif ( defined $child_pid ) { # child
862 close STDIN;
863 close STDOUT;
864 close STDERR;
865
866 my $new_poll = time;
867
868 my $error = 0;
869 my %context_cache;
870 foreach ( keys %twits ) {
871 $error++ unless &do_updates( $fh, $_, $twits{$_}, \%context_cache );
872
873 if ( $id_map{__fixreplies}{$_} ) {
874 my @frusers = sort keys %{ $id_map{__fixreplies}{$_} };
875
876 $error++
877 unless &get_timeline( $fh, $frusers[ $fix_replies_index{$_} ],
878 $_, $twits{$_}, \%context_cache );
879
880 $fix_replies_index{$_}++;
881 $fix_replies_index{$_} = 0
882 if $fix_replies_index{$_} >= @frusers;
883 print $fh "id:$fix_replies_index{$_} ",
884 "account:$_ type:fix_replies_index\n";
885 }
886 }
887
888 print $fh "__friends__\n";
889 if (
890 time - $last_friends_poll >
891 Irssi::settings_get_int('twitter_friends_poll') )
892 {
893 print $fh "__updated ", time, "\n";
894 my ( $added, $removed ) = &load_friends($fh);
895 if ( $added + $removed ) {
896 print $fh "type:debug %R***%n Friends list updated: ",
897 join( ", ",
898 sprintf( "%d added", $added ),
899 sprintf( "%d removed", $removed ) ),
900 "\n";
901 }
902 }
903
904 foreach ( sort keys %friends ) {
905 print $fh "$_ $friends{$_}\n";
906 }
907
908 if ($error) {
909 print $fh "type:debug Update encountered errors. Aborted\n";
910 print $fh "-- $last_poll";
911 } else {
912 print $fh "-- $new_poll";
913 }
914 close $fh;
915 rename $filename, "$filename.done";
916 exit;
917 } else {
918 &ccrap("Failed to fork for updating: $!");
919 }
920 print scalar localtime, " - get_updates ends" if &debug;
921}
922
923sub do_updates {
924 my ( $fh, $username, $obj, $cache ) = @_;
925
926 my $rate_limit = $obj->rate_limit_status();
927 if ( $rate_limit and $rate_limit->{remaining_hits} < 1 ) {
928 &notice("Rate limit exceeded for $username");
929 return undef;
930 }
931
932 print scalar localtime, " - Polling for updates for $username" if &debug;
933 my $tweets;
934 my $new_poll_id = 0;
935 eval {
936 if ( $id_map{__last_id}{$username}{timeline} )
937 {
938 $tweets = $obj->friends_timeline( { count => 100 } );
939 } else {
940 $tweets = $obj->friends_timeline();
941 }
942 };
943
944 if ($@) {
945 print $fh "type:debug Error during friends_timeline call: Aborted.\n";
946 print $fh "type:debug : $_\n" foreach split /\n/, Dumper($@);
947 return undef;
948 }
949
950 unless ( ref $tweets ) {
951 if ( $obj->can("get_error") ) {
952 my $error = "Unknown error";
953 eval { $error = JSON::Any->jsonToObj( $obj->get_error() ) };
954 unless ($@) { $error = $obj->get_error() }
955 print $fh
956 "type:debug API Error during friends_timeline call: Aborted\n";
957 print $fh "type:debug : $_\n" foreach split /\n/, Dumper($error);
958
959 } else {
960 print $fh
961 "type:debug API Error during friends_timeline call. Aborted.\n";
962 }
963 return undef;
964 }
965
966 foreach my $t ( reverse @$tweets ) {
967 my $text = decode_entities( $t->{text} );
968 $text =~ s/[\n\r]/ /g;
969 my $reply = "tweet";
970 if ( Irssi::settings_get_bool("show_reply_context")
971 and $t->{in_reply_to_screen_name} ne $username
972 and $t->{in_reply_to_screen_name}
973 and not exists $friends{ $t->{in_reply_to_screen_name} } )
974 {
975 $nicks{ $t->{in_reply_to_screen_name} } = time;
976 my $context;
977 unless ( $cache->{ $t->{in_reply_to_status_id} } ) {
978 eval {
979 $cache->{ $t->{in_reply_to_status_id} } =
980 $obj->show_status( $t->{in_reply_to_status_id} );
981 };
982
983 }
984 $context = $cache->{ $t->{in_reply_to_status_id} };
985
986 if ($context) {
987 my $ctext = decode_entities( $context->{text} );
988 $ctext =~ s/[\n\r]/ /g;
989 if ( $context->{truncated} and ref($obj) ne 'Net::Identica' ) {
990 $ctext .=
991 " -- http://twitter.com/$context->{user}{screen_name}"
992 . "/status/$context->{id}";
993 }
994 printf $fh "id:%s account:%s nick:%s type:tweet %s\n",
995 $context->{id}, $username,
996 $context->{user}{screen_name}, $ctext;
997 $reply = "reply";
998 }
999 }
1000 next
1001 if $t->{user}{screen_name} eq $username
1002 and not Irssi::settings_get_bool("show_own_tweets");
1003 if ( $t->{truncated} and ref($obj) ne 'Net::Identica' ) {
1004 $text .= " -- http://twitter.com/$t->{user}{screen_name}"
1005 . "/status/$t->{id}";
1006 }
1007 printf $fh "id:%s account:%s nick:%s type:%s %s\n",
1008 $t->{id}, $username, $t->{user}{screen_name}, $reply, $text;
1009 $new_poll_id = $t->{id} if $new_poll_id < $t->{id};
1010 }
1011 printf $fh "id:%s account:%s type:last_id timeline\n",
1012 $new_poll_id, $username;
1013
1014 print scalar localtime, " - Polling for replies since ",
1015 $id_map{__last_id}{$username}{reply}
1016 if &debug;
1017 $new_poll_id = 0;
1018 eval {
1019 if ( $id_map{__last_id}{$username}{reply} )
1020 {
1021 $tweets = $obj->replies(
1022 { since_id => $id_map{__last_id}{$username}{reply} } )
1023 || [];
1024 } else {
1025 $tweets = $obj->replies() || [];
1026 }
1027 };
1028
1029 if ($@) {
1030 print $fh "type:debug Error during replies call. Aborted.\n";
1031 return undef;
1032 }
1033
1034 foreach my $t ( reverse @$tweets ) {
1035 next
1036 if exists $friends{ $t->{user}{screen_name} };
1037
1038 my $text = decode_entities( $t->{text} );
1039 $text =~ s/[\n\r]/ /g;
1040 if ( $t->{truncated} ) {
1041 $text .= " -- http://twitter.com/$t->{user}{screen_name}"
1042 . "/status/$t->{id}";
1043 }
1044 printf $fh "id:%s account:%s nick:%s type:tweet %s\n",
1045 $t->{id}, $username, $t->{user}{screen_name}, $text;
1046 $new_poll_id = $t->{id} if $new_poll_id < $t->{id};
1047 }
1048 printf $fh "id:%s account:%s type:last_id reply\n", $new_poll_id, $username;
1049
1050 print scalar localtime, " - Polling for DMs" if &debug;
1051 $new_poll_id = 0;
1052 eval {
1053 if ( $id_map{__last_id}{$username}{dm} )
1054 {
1055 $tweets = $obj->direct_messages(
1056 { since_id => $id_map{__last_id}{$username}{dm} } )
1057 || [];
1058 } else {
1059 $tweets = $obj->direct_messages() || [];
1060 }
1061 };
1062
1063 if ($@) {
1064 print $fh "type:debug Error during direct_messages call. Aborted.\n";
1065 return undef;
1066 }
1067
1068 foreach my $t ( reverse @$tweets ) {
1069 my $text = decode_entities( $t->{text} );
1070 $text =~ s/[\n\r]/ /g;
1071 printf $fh "id:%s account:%s nick:%s type:dm %s\n",
1072 $t->{id}, $username, $t->{sender_screen_name}, $text;
1073 $new_poll_id = $t->{id} if $new_poll_id < $t->{id};
1074 }
1075 printf $fh "id:%s account:%s type:last_id dm\n", $new_poll_id, $username;
1076
1077 print scalar localtime, " - Polling for subscriptions" if &debug;
1078 if ( $obj->can('search') and $id_map{__searches}{$username} ) {
1079 my $search;
1080 foreach my $topic ( sort keys %{ $id_map{__searches}{$username} } ) {
1081 print $fh "type:debug searching for $topic since ",
1082 "$id_map{__searches}{$username}{$topic}\n";
1083 eval {
1084 $search = $obj->search(
1085 {
1086 q => $topic,
1087 since_id => $id_map{__searches}{$username}{$topic}
1088 }
1089 );
1090 };
1091
1092 if ($@) {
1093 print $fh
1094 "type:debug Error during search($topic) call. Aborted.\n";
1095 return undef;
1096 }
1097
1098 unless ( $search->{max_id} ) {
1099 print $fh "type:debug Invalid search results when searching",
1100 " for $topic. Aborted.\n";
1101 return undef;
1102 }
1103
1104 $id_map{__searches}{$username}{$topic} = $search->{max_id};
1105 printf $fh "id:%s account:%s type:searchid topic:%s\n",
1106 $search->{max_id}, $username, $topic;
1107
1108 foreach my $t ( reverse @{ $search->{results} } ) {
1109 my $text = decode_entities( $t->{text} );
1110 $text =~ s/[\n\r]/ /g;
1111 printf $fh "id:%s account:%s nick:%s type:search topic:%s %s\n",
1112 $t->{id}, $username, $t->{from_user}, $topic, $text;
1113 $new_poll_id = $t->{id}
1114 if not $new_poll_id
1115 or $t->{id} < $new_poll_id;
1116 }
1117 }
1118 }
1119
1120 print scalar localtime, " - Done" if &debug;
1121
1122 return 1;
1123}
1124
1125sub get_timeline {
1126 my ( $fh, $target, $username, $obj, $cache ) = @_;
1127 my $tweets;
1128 my $last_id = $id_map{__last_id}{$username}{$target};
1129
1130 print $fh "type:debug get_timeline("
1131 . "$fix_replies_index{$username}=$target > $last_id) started."
1132 . " username = $username\n";
1133 eval {
1134 $tweets = $obj->user_timeline(
1135 {
1136 id => $target,
1137 ( $last_id ? ( since_id => $last_id ) : () ),
1138 }
1139 );
1140 };
1141
1142 if ($@) {
1143 print $fh
1144 "type:debug Error during user_timeline($target) call: Aborted.\n";
1145 print $fh "type:debug : $_\n" foreach split /\n/, Dumper($@);
1146 return undef;
1147 }
1148
1149 unless ($tweets) {
1150 print $fh
1151 "type:debug user_timeline($target) call returned undef! Aborted\n";
1152 return 1;
1153 }
1154
1155 foreach my $t ( reverse @$tweets ) {
1156 my $text = decode_entities( $t->{text} );
1157 $text =~ s/[\n\r]/ /g;
1158 my $reply = "tweet";
1159 if ( Irssi::settings_get_bool("show_reply_context")
1160 and $t->{in_reply_to_screen_name} ne $username
1161 and $t->{in_reply_to_screen_name}
1162 and not exists $friends{ $t->{in_reply_to_screen_name} } )
1163 {
1164 $nicks{ $t->{in_reply_to_screen_name} } = time;
1165 my $context;
1166 unless ( $cache->{ $t->{in_reply_to_status_id} } ) {
1167 eval {
1168 $cache->{ $t->{in_reply_to_status_id} } =
1169 $obj->show_status( $t->{in_reply_to_status_id} );
1170 };
1171
1172 }
1173 $context = $cache->{ $t->{in_reply_to_status_id} };
1174
1175 if ($context) {
1176 my $ctext = decode_entities( $context->{text} );
1177 $ctext =~ s/[\n\r]/ /g;
1178 if ( $context->{truncated} and ref($obj) ne 'Net::Identica' ) {
1179 $ctext .=
1180 " -- http://twitter.com/$context->{user}{screen_name}"
1181 . "/status/$context->{id}";
1182 }
1183 printf $fh "id:%s account:%s nick:%s type:tweet %s\n",
1184 $context->{id}, $username,
1185 $context->{user}{screen_name}, $ctext;
1186 $reply = "reply";
1187 }
1188 }
1189 if ( $t->{truncated} and ref($obj) ne 'Net::Identica' ) {
1190 $text .= " -- http://twitter.com/$t->{user}{screen_name}"
1191 . "/status/$t->{id}";
1192 }
1193 printf $fh "id:%s account:%s nick:%s type:%s %s\n",
1194 $t->{id}, $username, $t->{user}{screen_name}, $reply, $text;
1195 $last_id = $t->{id} if $last_id < $t->{id};
1196 }
1197 printf $fh "id:%s account:%s type:last_id_fixreplies %s\n",
1198 $last_id, $username, $target;
1199
1200 return 1;
1201}
1202
1203sub monitor_child {
1204 my ($data) = @_;
1205 my $filename = $data->[0];
1206 my $attempt = $data->[1];
1207
1208 print scalar localtime, " - checking child log at $filename ($attempt)"
1209 if &debug;
1210 my ($new_last_poll);
1211
1212 # first time we run we don't want to print out *everything*, so we just
1213 # pretend
1214
1215 if ( open FILE, $filename ) {
1216 binmode FILE, ":utf8";
1217 my @lines;
1218 my %new_cache;
1219 while (<FILE>) {
1220 last if /^__friends__/;
1221 unless (/\n$/) { # skip partial lines
1222 # print "Skipping partial line: $_" if &debug;
1223 next;
1224 }
1225 chomp;
1226 my $hilight = 0;
1227 my %meta;
1228
1229 foreach my $key (qw/id account nick type topic/) {
1230 if (s/^$key:(\S+)\s*//) {
1231 $meta{$key} = $1;
1232 }
1233 }
1234
1235 if ( $meta{type} and $meta{type} eq 'fix_replies_index' ) {
1236 $fix_replies_index{ $meta{account} } = $meta{id};
1237 print "fix_replies_index for $meta{account} set to $meta{id}"
1238 if &debug;
1239 next;
1240 }
1241
1242 if ( not $meta{type} or $meta{type} !~ /searchid|last_id/ ) {
1243 if ( exists $meta{id} and exists $new_cache{ $meta{id} } ) {
1244 next;
1245 }
1246
1247 $new_cache{ $meta{id} } = time;
1248
1249 if ( exists $meta{id} and exists $tweet_cache{ $meta{id} } ) {
1250 next;
1251 }
1252 }
1253
1254 my $account = "";
1255 $meta{account} =~ s/\@(\w+)$//;
1256 $meta{service} = $1;
1257 if (
1258 lc $meta{service} eq
1259 lc Irssi::settings_get_str("twirssi_default_service") )
1260 {
1261 $account = "$meta{account}: "
1262 if lc "$meta{account}\@$meta{service}" ne lc
1263 "$user\@$defservice";
1264 } else {
1265 $account = "$meta{account}\@$meta{service}: ";
1266 }
1267
1268 my $marker = "";
1269 if ( $meta{type} ne 'dm'
1270 and Irssi::settings_get_bool("twirssi_track_replies")
1271 and $meta{nick}
1272 and $meta{id} )
1273 {
1274 $marker = ( $id_map{__indexes}{ $meta{nick} } + 1 ) % 100;
1275 $id_map{ lc $meta{nick} }[$marker] = $meta{id};
1276 $id_map{__indexes}{ $meta{nick} } = $marker;
1277 $id_map{__tweets}{ lc $meta{nick} }[$marker] = $_;
1278 $marker = ":$marker";
1279 }
1280
1281 my $hilight_color =
1282 $irssi_to_mirc_colors{ Irssi::settings_get_str("hilight_color") };
1283 my $nick = "\@$meta{account}";
1284 if ( $_ =~ /\Q$nick\E(?:\W|$)/i
1285 and Irssi::settings_get_bool("twirssi_hilights") )
1286 {
1287 $meta{nick} = "\cC$hilight_color$meta{nick}\cO";
1288 $hilight = MSGLEVEL_HILIGHT;
1289 }
1290
1291 if ( $meta{type} =~ /tweet|reply/ ) {
1292 push @lines,
1293 [
1294 ( MSGLEVEL_PUBLIC | $hilight ),
1295 $meta{type}, $account, $meta{nick}, $marker, $_
1296 ];
1297 } elsif ( $meta{type} eq 'search' ) {
1298 push @lines,
1299 [
1300 ( MSGLEVEL_PUBLIC | $hilight ),
1301 $meta{type}, $account, $meta{topic},
1302 $meta{nick}, $marker, $_
1303 ];
1304 if (
1305 exists $id_map{__searches}{ $meta{account} }{ $meta{topic} }
1306 and $meta{id} >
1307 $id_map{__searches}{ $meta{account} }{ $meta{topic} } )
1308 {
1309 $id_map{__searches}{ $meta{account} }{ $meta{topic} } =
1310 $meta{id};
1311 }
1312 } elsif ( $meta{type} eq 'dm' ) {
1313 push @lines,
1314 [
1315 ( MSGLEVEL_MSGS | $hilight ),
1316 $meta{type}, $account, $meta{nick}, $_
1317 ];
1318 } elsif ( $meta{type} eq 'searchid' ) {
1319 print "Search '$meta{topic}' returned id $meta{id}" if &debug;
1320 if (
1321 not
1322 exists $id_map{__searches}{ $meta{account} }{ $meta{topic} }
1323 or $meta{id} >=
1324 $id_map{__searches}{ $meta{account} }{ $meta{topic} } )
1325 {
1326 $id_map{__searches}{ $meta{account} }{ $meta{topic} } =
1327 $meta{id};
1328 } elsif (&debug) {
1329 print "Search '$meta{topic}' returned invalid id $meta{id}";
1330 }
1331 } elsif ( $meta{type} eq 'last_id' ) {
1332 $id_map{__last_id}{"$meta{account}\@$meta{service}"}{$_} =
1333 $meta{id}
1334 if $id_map{__last_id}{"$meta{account}\@$meta{service}"}{$_} <
1335 $meta{id};
1336 } elsif ( $meta{type} eq 'last_id_fixreplies' ) {
1337 $id_map{__last_id}{"$meta{account}\@$meta{service}"}{$_} =
1338 $meta{id}
1339 if $id_map{__last_id}{"$meta{account}\@$meta{service}"}{$_} <
1340 $meta{id};
1341 } elsif ( $meta{type} eq 'error' ) {
1342 push @lines, [ MSGLEVEL_MSGS, $_ ];
1343 } elsif ( $meta{type} eq 'debug' ) {
1344 print "$_" if &debug,;
1345 } else {
1346 print "Unknown line type $meta{type}: $_" if &debug,;
1347 }
1348 }
1349
1350 %friends = ();
1351 while (<FILE>) {
1352 if (/^__updated (\d+)$/) {
1353 $last_friends_poll = $1;
1354 print "Friend list updated" if &debug;
1355 next;
1356 }
1357
1358 if (/^-- (\d+)$/) {
1359 $new_last_poll = $1;
1360 if ( $new_last_poll >= $last_poll ) {
1361 last;
1362 } else {
1363 print "Impossible! ",
1364 "new_last_poll=$new_last_poll < last_poll=$last_poll!"
1365 if &debug;
1366 undef $new_last_poll;
1367 next;
1368 }
1369 }
1370 my ( $f, $t ) = split ' ', $_;
1371 $nicks{$f} = $friends{$f} = $t;
1372 }
1373
1374 if ($new_last_poll) {
1375 print "new last_poll = $new_last_poll" if &debug;
1376 print "new last_poll_id = ", Dumper( $id_map{__last_id} ) if &debug;
1377 if ($first_call) {
1378 print "First call, not printing updates" if &debug;
1379 } else {
1380 foreach my $line (@lines) {
1381 $window->printformat(
1382 $line->[0],
1383 "twirssi_" . $line->[1],
1384 @$line[ 2 .. $#$line - 1 ],
1385 &hilight( $line->[-1] )
1386 );
1387 }
1388 }
1389
1390 close FILE;
1391 unlink $filename
1392 or warn "Failed to remove $filename: $!"
1393 unless &debug;
1394
1395 # commit the pending cache lines to the actual cache, now that
1396 # we've printed our output
1397 %tweet_cache = ( %tweet_cache, %new_cache );
1398
1399 # keep enough cached tweets, to make sure we don't show duplicates.
1400 foreach ( keys %tweet_cache ) {
1401 next if $tweet_cache{$_} >= $last_poll - 3600;
1402 delete $tweet_cache{$_};
1403 }
1404 $last_poll = $new_last_poll;
1405
1406 # make sure the pid is removed from the waitpid list
1407 Irssi::pidwait_remove($child_pid);
1408
1409 # and that we don't leave any zombies behind, somehow
1410 wait();
1411
1412 # save id_map hash
1413 if ( keys %id_map
1414 and my $file =
1415 Irssi::settings_get_str("twirssi_replies_store") )
1416 {
1417 if ( open JSON, ">$file" ) {
1418 print JSON JSON::Any->objToJson( \%id_map );
1419 close JSON;
1420 } else {
1421 &ccrap("Failed to write replies to $file: $!");
1422 }
1423 }
1424 $failwhale = 0;
1425 $first_call = 0;
1426 return;
1427 }
1428 }
1429
1430 close FILE;
1431
1432 if ( $attempt < 24 ) {
1433 Irssi::timeout_add_once( 5000, 'monitor_child',
1434 [ $filename, $attempt + 1 ] );
1435 } else {
1436 print "Giving up on polling $filename" if &debug;
1437 Irssi::pidwait_remove($child_pid);
1438 wait();
1439 unlink $filename unless &debug;
1440
1441 return unless Irssi::settings_get_bool("twirssi_notify_timeouts");
1442
1443 my $since;
1444 my @time = localtime($last_poll);
1445 if ( time - $last_poll < 24 * 60 * 60 ) {
1446 $since = sprintf( "%d:%02d", @time[ 2, 1 ] );
1447 } else {
1448 $since = scalar localtime($last_poll);
1449 }
1450
1451 if ( not $failwhale and time - $last_poll > 60 * 60 ) {
1452 foreach my $whale (
1453 q{ v v v},
1454 q{ | | v | v},
1455 q{ | .-, | | |},
1456 q{ .--./ / | _.---.| },
1457 q{ '-. (__..-" \\},
1458 q{ \\ a |},
1459 q{ ',.__. ,__.-'/},
1460 q{ '--/_.'----'`}
1461 )
1462 {
1463 &ccrap($whale);
1464 }
1465 $failwhale = 1;
1466 }
1467
1468 if ( time - $last_poll < 600 ) {
1469 &ccrap("Haven't been able to get updated tweets since $since");
1470 }
1471 }
1472}
1473
1474sub debug {
1475 return Irssi::settings_get_bool("twirssi_debug");
1476}
1477
1478sub notice {
1479 $window->print( "%R***%n @_", MSGLEVEL_PUBLIC );
1480}
1481
1482sub ccrap {
1483 $window->print( "%R***%n @_", MSGLEVEL_CLIENTCRAP );
1484}
1485
1486sub update_away {
1487 my $data = shift;
1488
1489 if ( Irssi::settings_get_bool("tweet_to_away")
1490 and $data !~ /\@\w/
1491 and $data !~ /^[dD] / )
1492 {
1493 my $server =
1494 Irssi::server_find_tag( Irssi::settings_get_str("bitlbee_server") );
1495 if ($server) {
1496 $server->send_raw("away :$data");
1497 return 1;
1498 } else {
1499 &ccrap( "Can't find bitlbee server.",
1500 "Update bitlbee_server or disable tweet_to_away" );
1501 return 0;
1502 }
1503 }
1504
1505 return 0;
1506}
1507
1508sub too_long {
1509 my $data = shift;
1510 my $noalert = shift;
1511
1512 if ( length $data > 140 ) {
1513 &notice( "Tweet too long (" . length($data) . " characters) - aborted" )
1514 unless $noalert;
1515 return 1;
1516 }
1517
1518 return 0;
1519}
1520
1521sub valid_username {
1522 my $username = shift;
1523
1524 $username = &normalize_username($username);
1525
1526 unless ( exists $twits{$username} ) {
1527 &notice("Unknown username $username");
1528 return undef;
1529 }
1530
1531 return $username;
1532}
1533
1534sub logged_in {
1535 my $obj = shift;
1536 unless ($obj) {
1537 &notice("Not logged in! Use /twitter_login username pass!");
1538 return 0;
1539 }
1540
1541 return 1;
1542}
1543
1544sub sig_complete {
1545 my ( $complist, $window, $word, $linestart, $want_space ) = @_;
1546
1547 if (
1548 $linestart =~ /^\/(?:retweet|twitter_reply)(?:_as)?\s*$/
1549 or ( Irssi::settings_get_bool("twirssi_use_reply_aliases")
1550 and $linestart =~ /^\/reply(?:_as)?\s*$/ )
1551 )
1552 { # /twitter_reply gets a nick:num
1553 $word =~ s/^@//;
1554 @$complist = map { "$_:$id_map{__indexes}{$_}" }
1555 sort { $nicks{$b} <=> $nicks{$a} }
1556 grep /^\Q$word/i,
1557 keys %{ $id_map{__indexes} };
1558 }
1559
1560 if ( $linestart =~
1561/^\/(twitter_unfriend|twitter_add_follow_extra|twitter_del_follow_extra)\s*$/
1562 )
1563 { # /twitter_unfriend gets a nick
1564 $word =~ s/^@//;
1565 push @$complist, grep /^\Q$word/i,
1566 sort { $nicks{$b} <=> $nicks{$a} } keys %nicks;
1567 }
1568
1569 # /tweet, /tweet_as, /dm, /dm_as - complete @nicks (and nicks as the first
1570 # arg to dm)
1571 if ( $linestart =~ /^\/(?:tweet|dm)/ ) {
1572 my $prefix = $word =~ s/^@//;
1573 $prefix = 0 if $linestart eq '/dm' or $linestart eq '/dm_as';
1574 push @$complist, grep /^\Q$word/i,
1575 sort { $nicks{$b} <=> $nicks{$a} } keys %nicks;
1576 @$complist = map { "\@$_" } @$complist if $prefix;
1577 }
1578}
1579
1580sub event_send_text {
1581 my ( $line, $server, $win ) = @_;
1582 my $awin = Irssi::active_win();
1583
1584 # if the window where we got our text was the twitter window, and the user
1585 # wants to be lazy, tweet away!
1586 if ( ( $awin->get_active_name() eq $window->{name} )
1587 and Irssi::settings_get_bool("tweet_window_input") )
1588 {
1589 &cmd_tweet( $line, $server, $win );
1590 }
1591}
1592
1593sub get_poll_time {
1594 my $poll = Irssi::settings_get_int("twitter_poll_interval");
1595 return $poll if $poll >= 60;
1596 return 60;
1597}
1598
1599sub hilight {
1600 my $text = shift;
1601
1602 if ( Irssi::settings_get_str("twirssi_nick_color") ) {
1603 my $c = Irssi::settings_get_str("twirssi_nick_color");
1604 $c = $irssi_to_mirc_colors{$c};
1605 $text =~ s/(^|\W)\@([-\w]+)/$1\cC$c\@$2\cO/g if $c;
1606 }
1607 if ( Irssi::settings_get_str("twirssi_topic_color") ) {
1608 my $c = Irssi::settings_get_str("twirssi_topic_color");
1609 $c = $irssi_to_mirc_colors{$c};
1610 $text =~ s/(^|\W)(\#|\!)([-\w]+)/$1\cC$c$2$3\cO/g if $c;
1611 }
1612 $text =~ s/[\n\r]/ /g;
1613
1614 return $text;
1615}
1616
1617sub shorten {
1618 my $data = shift;
1619
1620 my $provider = Irssi::settings_get_str("short_url_provider");
1621 if (
1622 (
1623 Irssi::settings_get_bool("twirssi_always_shorten")
1624 or &too_long( $data, 1 )
1625 )
1626 and $provider
1627 )
1628 {
1629 my @args;
1630 if ( $provider eq 'Bitly' ) {
1631 @args[ 1, 2 ] = split ',',
1632 Irssi::settings_get_str("short_url_args"), 2;
1633 unless ( @args == 3 ) {
1634 &ccrap(
1635 "WWW::Shorten::Bitly requires a username and API key.",
1636 "Set short_url_args to username,API_key or change your",
1637 "short_url_provider."
1638 );
1639 return decode "utf8", $data;
1640 }
1641 }
1642
1643 foreach my $url ( $data =~ /(https?:\/\/\S+[\w\/])/g ) {
1644 eval {
1645 $args[0] = $url;
1646 my $short = makeashorterlink(@args);
1647 if ($short) {
1648 $data =~ s/\Q$url/$short/g;
1649 } else {
1650 &notice("Failed to shorten $url!");
1651 }
1652 };
1653 }
1654 }
1655
1656 return decode "utf8", $data;
1657}
1658
1659sub normalize_username {
1660 my $user = shift;
1661
1662 my ( $username, $service ) = split /\@/, $user, 2;
1663 if ($service) {
1664 $service = ucfirst lc $service;
1665 } else {
1666 $service =
1667 ucfirst lc Irssi::settings_get_str("twirssi_default_service");
1668 unless ( exists $twits{"$username\@$service"} ) {
1669 $service = undef;
1670 foreach my $t ( sort keys %twits ) {
1671 next unless $t =~ /^\Q$username\E\@(Twitter|Identica)/;
1672 $service = $1;
1673 last;
1674 }
1675
1676 unless ($service) {
1677 &notice("Can't find a logged in user '$user'");
1678 }
1679 }
1680 }
1681
1682 return "$username\@$service";
1683}
1684
1685Irssi::signal_add( "send text", "event_send_text" );
1686
1687Irssi::theme_register(
1688 [
1689 'twirssi_tweet', '[$0%B@$1%n$2] $3',
1690 'twirssi_search', '[$0%r$1%n:%B@$2%n$3] $4',
1691 'twirssi_reply', '[$0\--> %B@$1%n$2] $3',
1692 'twirssi_dm', '[$0%r@$1%n (%WDM%n)] $2',
1693 'twirssi_error', 'ERROR: $0',
1694 ]
1695);
1696
1697Irssi::settings_add_int( "twirssi", "twitter_poll_interval", 300 );
1698Irssi::settings_add_str( "twirssi", "twitter_window", "twitter" );
1699Irssi::settings_add_str( "twirssi", "bitlbee_server", "bitlbee" );
1700Irssi::settings_add_str( "twirssi", "short_url_provider", "TinyURL" );
1701Irssi::settings_add_str( "twirssi", "short_url_args", undef );
1702Irssi::settings_add_str( "twirssi", "twitter_usernames", undef );
1703Irssi::settings_add_str( "twirssi", "twitter_passwords", undef );
1704Irssi::settings_add_str( "twirssi", "twirssi_default_service", "Twitter" );
1705Irssi::settings_add_str( "twirssi", "twirssi_nick_color", "%B" );
1706Irssi::settings_add_str( "twirssi", "twirssi_topic_color", "%r" );
1707Irssi::settings_add_str( "twirssi", "twirssi_retweet_format",
1708 'RT $n: "$t" ${-- $c$}' );
1709Irssi::settings_add_str( "twirssi", "twirssi_location",
1710 ".irssi/scripts/twirssi.pl" );
1711Irssi::settings_add_str( "twirssi", "twirssi_replies_store",
1712 ".irssi/scripts/twirssi.json" );
1713
1714Irssi::settings_add_int( "twirssi", "twitter_friends_poll", 600 );
1715Irssi::settings_add_int( "twirssi", "twitter_timeout", 30 );
1716
1717Irssi::settings_add_bool( "twirssi", "twirssi_upgrade_beta", 0 );
1718Irssi::settings_add_bool( "twirssi", "tweet_to_away", 0 );
1719Irssi::settings_add_bool( "twirssi", "show_reply_context", 0 );
1720Irssi::settings_add_bool( "twirssi", "show_own_tweets", 1 );
1721Irssi::settings_add_bool( "twirssi", "twirssi_debug", 0 );
1722Irssi::settings_add_bool( "twirssi", "twirssi_first_run", 1 );
1723Irssi::settings_add_bool( "twirssi", "twirssi_track_replies", 1 );
1724Irssi::settings_add_bool( "twirssi", "twirssi_replies_autonick", 1 );
1725Irssi::settings_add_bool( "twirssi", "twirssi_use_reply_aliases", 0 );
1726Irssi::settings_add_bool( "twirssi", "twirssi_notify_timeouts", 1 );
1727Irssi::settings_add_bool( "twirssi", "twirssi_hilights", 1 );
1728Irssi::settings_add_bool( "twirssi", "twirssi_always_shorten", 0 );
1729Irssi::settings_add_bool( "twirssi", "tweet_window_input", 0 );
1730Irssi::settings_add_bool( "twirssi", "twirssi_avoid_ssl", 0 );
1731
1732$last_poll = time - &get_poll_time;
1733$window = Irssi::window_find_name( Irssi::settings_get_str('twitter_window') );
1734if ( !$window ) {
1735 Irssi::active_win()
1736 ->print( "Couldn't find a window named '"
1737 . Irssi::settings_get_str('twitter_window')
1738 . "', trying to create it." );
1739 $window =
1740 Irssi::Windowitem::window_create(
1741 Irssi::settings_get_str('twitter_window'), 1 );
1742 $window->set_name( Irssi::settings_get_str('twitter_window') );
1743}
1744
1745if ($window) {
1746 Irssi::command_bind( "dm", "cmd_direct" );
1747 Irssi::command_bind( "dm_as", "cmd_direct_as" );
1748 Irssi::command_bind( "tweet", "cmd_tweet" );
1749 Irssi::command_bind( "tweet_as", "cmd_tweet_as" );
1750 Irssi::command_bind( "retweet", "cmd_retweet" );
1751 Irssi::command_bind( "retweet_as", "cmd_retweet_as" );
1752 Irssi::command_bind( "twitter_reply", "cmd_reply" );
1753 Irssi::command_bind( "twitter_reply_as", "cmd_reply_as" );
1754 Irssi::command_bind( "twitter_login", "cmd_login" );
1755 Irssi::command_bind( "twitter_logout", "cmd_logout" );
1756 Irssi::command_bind( "twitter_switch", "cmd_switch" );
1757 Irssi::command_bind( "twitter_subscribe", "cmd_add_search" );
1758 Irssi::command_bind( "twitter_unsubscribe", "cmd_del_search" );
1759 Irssi::command_bind( "twitter_list_subscriptions", "cmd_list_search" );
1760 Irssi::command_bind( "twirssi_upgrade", "cmd_upgrade" );
1761 Irssi::command_bind( "twitter_updates", "get_updates" );
1762 Irssi::command_bind( "twitter_add_follow_extra", "cmd_add_follow" );
1763 Irssi::command_bind( "twitter_del_follow_extra", "cmd_del_follow" );
1764 Irssi::command_bind( "twitter_list_follow_extra", "cmd_list_follow" );
1765 Irssi::command_bind( "bitlbee_away", "update_away" );
1766 if ( Irssi::settings_get_bool("twirssi_use_reply_aliases") ) {
1767 Irssi::command_bind( "reply", "cmd_reply" );
1768 Irssi::command_bind( "reply_as", "cmd_reply_as" );
1769 }
1770 Irssi::command_bind(
1771 "twirssi_dump",
1772 sub {
1773 print "twits: ", join ", ",
1774 map { "u: $_->{username}\@" . ref($_) } values %twits;
1775 print "selected: $user\@$defservice";
1776 print "friends: ", join ", ", sort keys %friends;
1777 print "nicks: ", join ", ", sort keys %nicks;
1778 print "searches: ", Dumper \%{ $id_map{__searches} };
1779 print "last poll: $last_poll";
1780 if ( open DUMP, ">/tmp/twirssi.cache.txt" ) {
1781 print DUMP Dumper \%tweet_cache;
1782 close DUMP;
1783 print "cache written out to /tmp/twirssi.cache.txt";
1784 }
1785 }
1786 );
1787 Irssi::command_bind(
1788 "twirssi_version",
1789 sub {
1790 &notice(
1791 "Twirssi v$VERSION; "
1792 . (
1793 $Net::Twitter::VERSION
1794 ? "Net::Twitter v$Net::Twitter::VERSION. "
1795 : ""
1796 )
1797 . (
1798 $Net::Identica::VERSION
1799 ? "Net::Identica v$Net::Identica::VERSION. "
1800 : ""
1801 )
1802 . "JSON in use: "
1803 . JSON::Any::handler()
1804 . ". See details at http://twirssi.com/"
1805 );
1806 }
1807 );
1808 Irssi::command_bind(
1809 "twitter_follow",
1810 &gen_cmd(
1811 "/twitter_follow <username>",
1812 "create_friend",
1813 sub { &notice("Following $_[0]"); $nicks{ $_[0] } = time; }
1814 )
1815 );
1816 Irssi::command_bind(
1817 "twitter_unfollow",
1818 &gen_cmd(
1819 "/twitter_unfriend <username>",
1820 "destroy_friend",
1821 sub { &notice("Stopped following $_[0]"); delete $nicks{ $_[0] }; }
1822 )
1823 );
1824 Irssi::command_bind(
1825 "twitter_device_updates",
1826 &gen_cmd(
1827 "/twitter_device_updates none|im|sms",
1828 "update_delivery_device",
1829 sub { &notice("Device updated to $_[0]"); }
1830 )
1831 );
1832 Irssi::command_bind(
1833 "twitter_block",
1834 &gen_cmd(
1835 "/twitter_block <username>",
1836 "create_block",
1837 sub { &notice("Blocked $_[0]"); }
1838 )
1839 );
1840 Irssi::command_bind(
1841 "twitter_unblock",
1842 &gen_cmd(
1843 "/twitter_unblock <username>",
1844 "destroy_block",
1845 sub { &notice("Unblock $_[0]"); }
1846 )
1847 );
1848 Irssi::signal_add_last( 'complete word' => \&sig_complete );
1849
1850 &notice(" %Y<%C(%B^%C)%N TWIRSSI v%R$VERSION%N");
1851 &notice(" %C(_(\\%N http://twirssi.com/ for full docs");
1852 &notice(
1853 " %Y||%C `%N Log in with /twitter_login, send updates with /tweet");
1854
1855 my $file = Irssi::settings_get_str("twirssi_replies_store");
1856 if ( $file and -r $file ) {
1857 if ( open( JSON, $file ) ) {
1858 local $/;
1859 my $json = <JSON>;
1860 close JSON;
1861 eval {
1862 my $ref = JSON::Any->jsonToObj($json);
1863 %id_map = %$ref;
1864 my $num = keys %{ $id_map{__indexes} };
1865 &notice( sprintf "Loaded old replies from %d contact%s.",
1866 $num, ( $num == 1 ? "" : "s" ) );
1867 &cmd_list_search;
1868 &cmd_list_follow;
1869 };
1870 } else {
1871 &notice("Failed to load old replies from $file: $!");
1872 }
1873 }
1874
1875 if ( my $provider = Irssi::settings_get_str("short_url_provider") ) {
1876 &notice("Loading WWW::Shorten::$provider...");
1877 eval "use WWW::Shorten::$provider;";
1878
1879 if ($@) {
1880 &notice(
1881 "Failed to load WWW::Shorten::$provider - either clear",
1882 "short_url_provider or install the CPAN module"
1883 );
1884 }
1885 }
1886
1887 if ( my $autouser = Irssi::settings_get_str("twitter_usernames")
1888 and my $autopass = Irssi::settings_get_str("twitter_passwords") )
1889 {
1890 &cmd_login();
1891 &get_updates;
1892 }
1893
1894} else {
1895 Irssi::active_win()
1896 ->print( "Create a window named "
1897 . Irssi::settings_get_str('twitter_window')
1898 . " or change the value of twitter_window. Then, reload twirssi." );
1899}
1900
1901# vim: set sts=4 expandtab:
diff --git a/.irssi/startup b/.irssi/startup
new file mode 100644
index 0000000..2009d71
--- /dev/null
+++ b/.irssi/startup
@@ -0,0 +1 @@
load xmpp
© 2015 Mike Crute