html/shorturl.pl
1 #!/usr/bin/perl -w
2 # This Irssi script automatically converts incoming http/https links into shorter "tinyurl" style links
3 $VERSION = "20090904"; # Fixed and enhanced by tsaavik (dave000@hellspark.com)
4 #
5 # Irssi /set Options
6 # you can view your current settigns by running "/set shorturl" in Irssi
7 #
8 # /set shorturl_debug <on|off> -- (off) if you have a problem try turning this on to debug
9 # /set shorturl_send_to_channel <on|off> -- (off) send the converted tinyurl publicly to everyone in your channels
10 # /set shorturl_chans <"#channel1, #channel2, etc"> -- Channels to automatically convert. Empty Defaults to all
11 # /set shorturl_min_url_length <35> -- (35) How long a url has to be to trigger automatic url shortening
12 #
13 # Optional manual usage is
14 # /shorturl http://yourlongurl.com/blahblahblah
15
16 # No user servicable parts below this line :D
17 #---------------------------------------------------------------------
18 use strict;
19 use vars qw($VERSION %IRSSI);
20
21 %IRSSI = (
22 authors => "eo, tsaavik",
23 contact => 'irssi@eosin.org, dave001@hellspark.com',
24 name => "shorturl.pl",
25 description => "Private/Public url reduction script.",
26 license => "GPLv2",
27 changed => "$VERSION"
28 );
29
30 use Irssi;
31 use Irssi::Irc;
32 #
33 # If you dont have either of these,
34 # I suggest: perl -MCPAN -e 'install "Bundle::LWP" '
35 # or whatever perl module install method you find
36 # suitable.
37 use LWP::Simple;
38 use LWP::UserAgent;
39
40 # Each one of these have different methods of
41 # getting a url back. So dont go adding any
42 # others unless you wish to write in the retrieval
43 # code for it. Or email me. -
44 my @lookups = ("tinyurl", "metamark");
45
46 #these are overwritten by irssi settings via setuphandler()
47 my ($min_url_length, $send_to_channel, $debug, $channel_list);
48
49 sub setuphandler{
50 # The script no longers sends translations to channel by default
51 # You can enable the older functionality here.
52 # it is controlled via the irssi /set command (see above)
53 Irssi::settings_add_bool("shorturl", "shorturl_send_to_channel", 0);
54 if( Irssi::settings_get_bool("shorturl_send_to_channel") ) {
55 print "shorturl: sending of shorturl's to public channels enabled";
56 $send_to_channel=1;
57 }
58
59 #what channels should be parsed (default is empty, which is all)
60 # it is controlled via the irssi /set command (see above)
61 Irssi::settings_add_str("shorturl", "shorturl_chans", "");
62 $channel_list = Irssi::settings_get_str("shorturl_chans");
63 if ($channel_list) {
64 print "shorturl: Following channels are now parsed $channel_list";
65 }
66
67 # Max chars per url. No sense in translating already short urls :)
68 # it is controlled via the irssi /set command (see above)
69 Irssi::settings_add_int("shorturl", "shorturl_min_url_length", 35);
70 my $old_min_url_length=$min_url_length;
71 $min_url_length=Irssi::settings_get_int("shorturl_min_url_length");
72 if ($min_url_length != $old_min_url_length) {
73 print "shorturl: min_url_length sucessfully set to $min_url_length";
74 }
75
76 # Debug messages (prints what url shorterner is used, error messages, etc)
77 # it is controlled via the irssi /set command (see above)
78 Irssi::settings_add_bool("shorturl", "shorturl_debug", 0);
79 my $old_debug=$debug;
80 $debug=Irssi::settings_get_bool("shorturl_debug");
81 if ($debug != $old_debug) {
82 if ($debug){
83 print "shorturl: Debug Mode Enabled";
84 $debug=1;
85 }else{
86 print "shorturl: Debug Mode Disabled";
87 $debug=0;
88 }
89 }
90
91 }
92
93 sub InjectUrl {
94 # data - contains the parameters for /shorturl
95 # server - the active server in window
96 # target - the active window item (eg. channel, query)
97 # or undef if the window is empty
98 my ($data, $server, $target) = @_;
99
100 if (!$server || !$server->{connected}) {
101 Irssi::print("Not connected to server");
102 return;
103 }
104
105 if ($data) {
106 GotUrl($server, $data, undef, undef, $target);
107 }
108 }
109
110 sub GotUrl {
111 my ($server, $data, $nick, $addr, $target) = @_;
112 if (!$server || !$server->{connected}) {
113 Irssi::print("Not connected to server");
114 return;
115 }
116 return unless(goodchan($target));
117 $data =~ s/^\s+//;
118 $data =~ s/\s+$//;
119 my @urls = ();
120 my ($url, $a, $return, $char, $ch, $result, $choice) = "";;
121 my $same = 0;
122 my $sitewas = "t";
123 my @chars = ();
124
125 return unless (($data =~ /\bhttp\:/) || ($data =~ /\bhttps\:/));
126 deb("$target triggered GotUrl() with url: $data");
127
128 # split on whitespace and get the url(s) out
129 # done this way in case there are more than
130 # one url per line.
131 foreach(split(/\s/, $data)) {
132 if (($_ =~ /^http\:/) || ($_ =~ /^https\:/)){
133 foreach $a (@urls) {
134 if ($_ eq $a) {
135 # incase they use the same url on the line.
136 $same = 1;
137 next;
138 }
139 }
140
141 if ($same == 0) {
142 $same = 0;
143 push(@urls, $_);
144 }
145 }
146 }
147
148 # Go through the resulting urls
149 foreach (@urls) {
150
151 #Minimum url length.
152 return unless (count($_) > $min_url_length);
153 @chars = split(//, $_);
154
155 # Originally I used uri_escape() for this
156 # But tinyurl didnt like it.. might be because
157 # of the post method I was using at the time.
158 foreach $char (@chars) {
159 if ($char !~ /[A-Za-z0-9]/) {
160 $ch = sprintf("%%%02x",ord($char));
161 $result .= $ch;
162 } else {
163 $result .= $char;
164 }
165 }
166
167 # Get a random provider from the list.
168 $choice = $lookups[ rand(@lookups) ];
169 if ($choice eq "metamark") {
170 deb("$target Generating metamark url for $result");
171 $url = "http://metamark.net/api/rest/simple?long_url=" . $result;
172 eval { $return = get($url) };
173 next unless ($return);
174 next if ($return =~ /ERROR\:/);
175 if ($send_to_channel == 1) {
176 $server->command("msg $target $return");
177 }else{
178 $server->print("$target", "$return", MSGLEVEL_CLIENTCRAP);
179 #Irssi::print("$target: $return");
180 }
181 } else {
182 deb("$target Generating tinyurl url for $result");
183 deb("tinyurl(\$server, $target, $result)");
184 tinyurl($server, $target, $result);
185 }
186
187 }
188 return;
189 }
190
191 sub tinyurl {
192 my ($server, $chan, $longurl) = @_;
193 my $url = 'http://tinyurl.com/api-create.php?url='.$longurl;
194 deb("getting url:($url)");
195 my $browser = LWP::UserAgent->new;
196 $browser->agent("tinyurl for irssi/0.8.12 ");
197 my $response = $browser->get($url);
198 my $tinyurl = $response->content;
199 my $ua = LWP::UserAgent->new;
200 if ($response->is_success) {
201 if ($send_to_channel == 1) {
202 $server->command("msg $chan $tinyurl");
203 }else{
204 $server->print("$chan", "$tinyurl", MSGLEVEL_CLIENTCRAP);
205 #Irssi::print("$chan: $tinyurl");
206 }
207 }else{
208 deb("ERROR: tinyurl: tinyurl is down or not pingable");
209 }
210 }
211
212 # conditinal print.
213 sub deb($) {
214 Irssi::print(shift) if ($debug == 1);
215 }
216
217
218 # returns the character count.
219 sub count($) {
220 my @array = split(//, shift);
221 return($#array + 1);
222 }
223
224 # Checks if we should be translating
225 # urls for the requesting channel.
226 # returns True if the list is not set
227 # thus, it will translate for ALL channels.
228 # returns True if channel matches one in the list.
229 # returns undef otherwise.
230 sub goodchan {
231 my $chan = shift;
232 return("OK") if (! $channel_list);
233 foreach(split(/\,/, $channel_list)) {
234 return("$_") if ($_ =~ /$chan/i);
235 }
236 return undef;
237 }
238
239 setuphandler(); #initilize variables on first run
240 Irssi::signal_add("setup changed", "setuphandler");
241 Irssi::signal_add_last("message public", "GotUrl");
242 Irssi::signal_add_last("ctcp action", "GotUrl");
243 Irssi::command_bind('shorturl', 'InjectUrl');
244
245