1# $Id: url.pl,v 1.52 2002/11/21 06:04:52 jylefort Exp $
2
3use Irssi 20020121.2020 ();
4$VERSION = "0.54";
5%IRSSI = (
6	  authors     => 'Jean-Yves Lefort',
7	  contact     => 'jylefort\@brutele.be, decadix on IRCNet',
8	  name        => 'url',
9	  description => 'An URL grabber for Irssi',
10	  license     => 'BSD',
11	  url         => 'http://void.adminz.be/',
12	  changed     => '$Date: 2002/11/21 06:04:52 $ ',
13);
14
15# description:
16#
17#	url.pl grabs URLs in messages and allows you to open them on the fly,
18#	or to write them in a HTML file and open that file.
19#
20# /set's:
21#
22#	url_grab_level
23#
24#		message levels to take in consideration
25#		example: PUBLICS ACTIONS
26#
27#	url_redundant
28#
29#		whether to grab same URLs multiple times or not
30#		example: ON
31#
32#	url_verbose_grab
33#
34#		whether to grab verbosely or not
35#		example: OFF
36#
37#	url_hilight
38#
39#		whether to hilight the URLs in the text or not
40#		example: OFF
41#
42#	url_index_color
43#
44#		hilight index color (mirc color string)
45#
46#	url_color
47#
48#		hilight URL color (mirc color string)
49#
50#	browse_command
51#
52#		a command used to open URLs
53#		%u will be replaced by the URL
54#		example: galeon %u &
55#
56#	url_file
57#
58#		where to write the URL list
59#		example: ~/.irssi-urls.html
60#
61# commands
62#
63#	/URL [-clear|<number>]
64#
65#		-clear will clear the URL list.
66#
67#		<number> will open the specified URL.
68#
69#		If no arguments are specified, a HTML file containing all
70#		grabbed URLs will be written and opened.
71#
72# changes:
73#
74#	2002-11-21	release 0.54
75#			* added a DTD to the generated HTML file, suggested
76#			  by Hugo Haas <hugo@larve.net>
77#
78#	2002-11-19	release 0.53
79#			* eh yes, once again a better regexp by
80#			  Hugo Haas <hugo@larve.net>
81#
82#	2002-11-06	release 0.52
83#			* yet another regexp correction, again by
84#			  Hugo Haas <hugo@larve.net>
85#
86#	2002-10-23	release 0.51
87#			* URI regexp corrected by Hugo Haas <hugo@larve.net>
88#
89#	2002-09-26	release 0.50
90#			* entirely rewritten; the previous template bloatness
91#			  has been dropped to get back to a simpler concept
92#
93#	2002-07-04	release 0.47
94#			* signal_add's uses a reference instead of a string
95#
96#	2002-03-11	release 0.46
97#			* fixed an oblivion in the documentation
98#
99#	2002-02-14	release 0.45
100#			* replaced theme capability by /set url_color,
101#			  fixing a bug in the URL hilighting
102#
103#	2002-02-09	release 0.44
104#			* 0.43 didn't grabbed anything: fixed
105#
106#	2002-02-09	release 0.43
107#			* url_hilight was _still_ causing an infinite loop
108#			  under certain conditions: fixed
109#			* URLs found at the start of a message were
110#			  hilighted wrongly: fixed
111#
112#	2002-02-09	release 0.42
113#			* if url_hilight was enabled, an infinite loop was
114#			  caused while printing the hilighted message: fixed
115#
116#	2002-02-08	release 0.41
117#			* safer percent substitutions
118#			* improved URL regexp
119#
120#	2002-02-08	release 0.40
121#			* added /URL -create command
122#			* added url_hilight setting
123#
124#	2002-02-01	release 0.34
125#			* more precise URL regexp
126#
127#	2002-02-01	release 0.33
128#			* added /URL - command
129#			* added url_redundant setting
130#
131#	2002-02-01	release 0.32
132#			* some little improvements made in the URL regexp
133#
134#	2002-01-31	release 0.31
135#			* oops, '<@idiot> I am really stupid' was grabbed coz
136#			  the '@' mode char trigerred the email regexp
137#
138#	2002-01-31	release 0.30
139#			* major update: not HTML-oriented anymore; can generate
140#			  any type of text file by the use of template files
141#
142#	2002-01-28	release 0.23
143#			* changes in url_item and url_item_timestamp_format
144#			  settings will now be seen immediately
145#			* "Added item #n in URL list" is now printed after
146#			  the grabbed message
147#
148#	2002-01-28	release 0.22
149#			* messages are now saved as they were printed in irssi
150#			* removed %n format of url_item
151#
152#	2002-01-27	release 0.21
153#			* uses builtin expand
154#
155#	2002-01-27	release 0.20
156#			* added a %s format to url_item
157#			* changed the %d format of url_page to %s
158#			* added url_{page|item}_timestamp_format settings
159#			* reworked the documentation
160#
161#	2002-01-25	release 0.12
162#			* added url_verbose_grab_setting
163#
164#	2002-01-24	release 0.11
165#			* now handles actions correctly
166#
167#	2002-01-23	initial release
168#
169# todo:
170#
171#	* also hilight redundant URLs
172#	* open URLs with alternate programs
173#	* add a 'url_grab_own_messages' setting
174
175use strict;
176use POSIX qw(strftime);
177
178use constant MSGLEVEL_NO_URL => 0x0400000;
179
180my @items;
181
182# -verbatim- import expand
183sub expand {
184  my ($string, %format) = @_;
185  my ($len, $attn, $repl) = (length $string, 0);
186
187  $format{'%'} = '%';
188
189  for (my $i = 0; $i < $len; $i++) {
190    my $char = substr $string, $i, 1;
191    if ($attn) {
192      $attn = undef;
193      if (exists($format{$char})) {
194	$repl .= $format{$char};
195      } else {
196	$repl .= '%' . $char;
197      }
198    } elsif ($char eq '%') {
199      $attn = 1;
200    } else {
201      $repl .= $char;
202    }
203  }
204
205  return $repl;
206}
207# -verbatim- end
208
209sub print_text {
210  my ($textdest, $text, $stripped) = @_;
211
212  if (! ($textdest->{level} & MSGLEVEL_NO_URL)
213      && (Irssi::level2bits(Irssi::settings_get_str('url_grab_level'))
214	  & $textdest->{level})
215      && ($stripped =~ /[a-zA-Z0-9+-.]+:\/\/[^ \t\<\>\"]+/o)) {
216
217    if (! Irssi::settings_get_bool('url_redundant')) {
218      foreach (@items) { return if ($_->{url} eq $&) }
219    }
220
221    push @items,
222      {
223       time => time,
224       target => $textdest->{target},
225       pre_url => $`,
226       url => $&,
227       post_url => $'
228      };
229
230    if (Irssi::settings_get_bool('url_hilight')) {
231      my $url_pos = index $text, $&;
232      $textdest->{level} |= MSGLEVEL_NO_URL;
233      Irssi::signal_emit('print text', $textdest,
234			 substr($text, 0, $url_pos) .
235			 Irssi::settings_get_str('url_index_color') . @items . ':' .
236			 Irssi::settings_get_str('url_color') . $& . '' .
237			 substr($text, $url_pos + length $&),
238			 $stripped);
239      Irssi::signal_stop();
240    }
241
242    Irssi::print('Added item #' . @items . ' to URL list')
243	if Irssi::settings_get_bool('url_verbose_grab');
244  }
245}
246
247sub write_file {
248  my $file = shift;
249
250  open(FILE, ">$file") or return $!;
251
252  print FILE <<'EOF' or return $!;
253<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
254<html>
255  <head>
256    <title>IRC URL list</title>
257  </head>
258  <body>
259    <center>
260      <table border="1" cellpadding="5">
261	<caption>IRC URL list</caption>
262	<tr><th>time<th>target<th>message</tr>
263EOF
264
265  foreach (@items) {
266    my $timestamp = strftime('%c', localtime $_->{time});
267    print FILE "	<tr><td>$timestamp<td>$_->{target}<td>$_->{pre_url}<a href=\"$_->{url}\">$_->{url}</a>$_->{post_url}</tr>\n" or return $!;
268  }
269
270  print FILE <<'EOF' or return $!;
271      </table>
272    </center>
273    <hr>
274    <center><small>Generated by url.pl</small>
275  </body>
276</html>
277EOF
278
279  close(FILE) or return $!;
280
281  return undef;
282}
283
284sub url {
285  my ($args, $server, $item) = @_;
286  my ($file) = glob Irssi::settings_get_str('url_file');
287  my $command = Irssi::settings_get_str('browse_command');
288
289  if ($args ne '') {
290    if (lc $args eq '-clear') {
291      @items = ();
292      Irssi::print('URL list cleared');
293    } elsif ($args =~ /^[0-9]+$/) {
294      if ($args > 0 && $items[$args - 1]) {
295	system(expand($command, 'u', $items[$args - 1]->{url}));
296      } else {
297	Irssi::print("URL #$args not found");
298      }
299    } else {
300      Irssi::print('Usage: /URL [-clear|<number>]', MSGLEVEL_CLIENTERROR);
301    }
302  } else {
303    if (@items) {
304      my $error;
305      if ($error = write_file($file)) {
306	Irssi::print("Unable to write $file: $error", MSGLEVEL_CLIENTERROR);
307      } else  {
308	system(expand($command, 'u', $file));
309      }
310    } else {
311      Irssi::print('URL list is empty');
312    }
313  }
314}
315
316Irssi::settings_add_str('misc', 'url_grab_level',
317			'PUBLIC TOPICS ACTIONS MSGS DCCMSGS');
318Irssi::settings_add_bool('lookandfeel', 'url_verbose_grab', undef);
319Irssi::settings_add_bool('lookandfeel', 'url_hilight', 1);
320Irssi::settings_add_str('lookandfeel', 'url_index_color', '08');
321Irssi::settings_add_str('lookandfeel', 'url_color', '12');
322Irssi::settings_add_bool('misc', 'url_redundant', 0);
323Irssi::settings_add_str('misc', 'browse_command',
324			'galeon-wrapper %u >/dev/null &');
325Irssi::settings_add_str('misc', 'url_file', '~/.irc_url_list.html');
326
327Irssi::signal_add('print text', \&print_text);
328
329Irssi::command_bind('url', \&url);
330