html/xdccget.pl
1 #
2 # by Stefan "tommie" Tomanek <stefan@kann-nix.org>
3 #
4 # History:
5 #
6 # 26.02.2002
7 # *first release, report bugs :)
8 #
9 # 01.03.2002
10 # *CHanged to GPL
11 #
12 # 08.03.200
13 # *some bugfixes
14 #
15 # 13.04.2002
16 # *major improvements
17 # *cosmetic changes
18 #
19 # 14.04.2002
20 # *internal redesign
21 # *feature enhancements
22 #
23 # 17.04.2002
24 # * improved queuing code
25 # * changed to $server->{tag}
26 # * improved communication with server
27 #
28 # 21.04.2002
29 # *improved ETA listing
30 #
31 # 27.04.2002
32 # *handling of gone bots added
33 #
34 # 28.04.2002
35 # *fixed handling of servers that are not in an ircnet
36
37 use strict;
38 #use warnings;
39
40 use vars qw($VERSION %IRSSI);
41 $VERSION = "20040509";
42 %IRSSI = (
43 authors => "Stefan 'tommie' Tomanek",
44 contact => "stefan\@pico.ruhr.de",
45 name => "XDCCget",
46 description => "advances downloading from XDCC bots",
47 license => "GPLv2",
48 changed => "$VERSION",
49 commands => "xdccget"
50 );
51
52 use Irssi 20020324;
53
54 use vars qw(@queue $timer $debug %lists);
55
56 $debug=0;
57
58 sub show_help() {
59 my $help="XDCCget $VERSION
60 /xdccget queue Nickname <number> <number>...
61 Queue the specified packs of the server 'Nickname'
62 /xdccget list
63 List the download queue
64 /xdccget cancel <number>
65 Remove pack <number> from the local queue
66 /xdccget help
67 Display this help
68 ";
69 my $text = '';
70 foreach (split(/\n/, $help)) {
71 $_ =~ s/^\/(.*)$/%9\/$1%9/;
72 $text .= $_."\n";
73 }
74 print CLIENTCRAP &draw_box("XDCCget", $text, "help", 1);
75 }
76
77 sub draw_box ($$$$) {
78 my ($title, $text, $footer, $colour) = @_;
79 my $box = '';
80 my $exp_flags = Irssi::EXPAND_FLAG_IGNORE_EMPTY | Irssi::EXPAND_FLAG_IGNORE_REPLACES;
81 $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
82 foreach (split(/\n/, $text)) { $box .= '%R|%n '.$_."\n";
83 } $box .= '%R`--<%n'.$footer.'%R>->%n';
84 $box =~ s/%.//g unless $colour;
85 return $box;
86 }
87
88 sub contains {
89 my ($item, @list) = @_;
90 foreach (@list) {
91 ($item eq $_) && return 1;
92 }
93 return 0;
94 }
95
96 sub event_message_irc_notice {
97 my ($server, $msg, $nick, $address, $target) = @_;
98 $_ = $msg;
99 if ($queue[0] && $nick eq $queue[0]->{'nick'}) {
100 if (/\*\*\* Closing Connection:/) {
101 print CLIENTCRAP "%R>>%n XDCC-Transfer closed";
102 # Is it a canceled transger?
103 if ($queue[0]->{'status'} == 5) {
104 $queue[0]->{'status'} = 4;
105 } else {
106 # We should try again
107 $queue[0]->{'status'} = 0;
108 }
109 } elsif (/\*\*\* Transfer Completed/i) {
110 print CLIENTCRAP "%R>>%n XDCC-Transfer completed";
111 # Mark the transfer as completed
112 $queue[0]->{'status'} = 4;
113 } elsif (/\*\*\* You already requested that pack/i) {
114 $queue[0]->{'status'} = 4;
115 } elsif (/\*\*\* Sending You Pack/i || /\*\*\* Sending You Your Queued Pack|DCC Send .*? \(.*?\)/i) {
116 $queue[0]->{'status'} = 3;
117 print CLIENTCRAP "%R>>%n XDCC-Transfer starting";
118 } elsif (/\*\*\* All Slots Full, Added (|you to the main )queue in position ([0-9]*)/i) {
119 $queue[0]->{'pos'} = $2;
120 $queue[0]->{'etr'} = 0;
121 $queue[0]->{'status'} = 2;
122 } elsif (/You have been queued for ([0-9]*?) hr ([0-9]*?) min, currently in main queue position ([0-9]*?) of ([0-9]*?)\. Estimated remaining time is ([0-9]*?) hr ([0-9]*?) min or (less|more)\./i) {
123 $queue[0]->{'pos'} = $3;
124 $queue[0]->{'etr'} = time() + (($5*60)+$6)*60;
125 $queue[0]->{'status'} = 2;
126 } elsif (/You have been queued for ([0-9]*?) hours ([0-9]*?) minutes, currently in main queue position ([0-9]*?) of ([0-9]*?)\./i) {
127 $queue[0]->{'pos'} = $3;
128 $queue[0]->{'status'} = 2;
129 } elsif (/You have been queued for ([0-9]*?) minutes, currently in main queue position ([0-9]*?) of ([0-9]*?)\./) {
130 $queue[0]->{'status'} = 2;
131 # FIXME unite somehow with regexp above
132 $queue[0]->{'pos'} = $2;
133 } elsif (/It has been placed in queue slot #(\d+), it will send when sends are available/) {
134 $queue[0]->{'pos'} = $1;
135 $queue[0]->{'status'} = 2;
136 } elsif (/\*\*\* Invalid Pack Number/) {
137 $queue[0]->{'status'} = 4;
138 } elsif (/\*\*\* The Owner Has Requested That No New Connections Are Made/) {
139 $queue[0]->{'status'} = 4;
140 } elsif (/\*\*\* All Slots Full,(| Main) queue of size [0-9]* is Full, Try Again Later/i || /\*\*\* You can only have 1 transfer at a time/i) {
141 if (Irssi::settings_get_int('xdccget_retry_time') > 0) {
142 my $retry = Irssi::settings_get_int('xdccget_retry_time')*1000;
143 $queue[0]->{'status'} = 6;
144 $queue[0]->{'timer'} = Irssi::timeout_add($retry, 'retry_transfer', undef);
145 $queue[0]->{'etr'} = time()+$retry/1000;
146 } else {
147 $queue[0]->{'status'} = 4;
148 }
149 } elsif (/Removed you from the queue/) {
150 $queue[0]->{'status'} = 4;
151 } else { Irssi::print($_) if ($debug); }
152
153 process_queue();
154 }
155 if (/#(\d+).+?\d+x \[ *(<?\d+.*?)\] +(.*)$/) {
156 my ($pack, $size, $name) = ($1, $2, $3);
157 if (defined $lists{lc $server->{tag}}{lc $nick}) {
158 $lists{lc $server->{tag}}{lc $nick}{$pack} = $name;
159 }
160 foreach (@queue) {
161 next unless lc $nick eq lc $_->{nick};
162 next unless lc $server->{tag} eq lc $_->{net};
163 next unless $_->{pack} eq $pack;
164 $_->{filename} = $name;
165 }
166 }
167 }
168
169 sub process_queue {
170 unless (scalar(@queue) > 0) {return 0};
171 my %current = %{$queue[0]};
172 shift @queue if ( $current{'status'} == 4 );
173 unless (scalar(@queue) > 0) {return 0};
174 %current = %{$queue[0]};
175 if ( $current{'status'} == 0 ) {
176 my $server = Irssi::server_find_tag($current{'net'});
177 $server->command('MSG '.$current{'nick'}.' xdcc send '.$current{'pack'});
178 $queue[0]->{'try'}++;
179 $queue[0]->{'status'} = 1;
180 }
181 }
182
183 sub retry_transfer {
184 if (defined $queue[0] && $queue[0]->{'status'} == 6) {
185 Irssi::timeout_remove($queue[0]->{'timer'});
186 #print CLIENTCRAP "%R>>%n Retrying XDCC-transfer...";
187 $queue[0]->{'status'} = 0;
188 process_queue();
189 }
190 }
191
192 sub queue_pack {
193 my ($args, $server, $witem) = @_;
194 my @args = split(/ /, $args, 2);
195 my ($nick, $packs);
196 if (ref $witem && $witem->{type} eq 'QUERY' && $args[0] =~ /^\d+$/) {
197 ($nick, $packs) = ($witem->{name}, $args[0]);
198 } else {
199 ($nick, $packs) = @args;
200 }
201 my @packs = split(/ /, $packs);
202 foreach (@packs) {
203 # 0: Waiting, 1: Processing, 2: Doenloading
204 my $status = 0;
205 my $chatnet = $server->{tag};
206 my %transfer = ('nick' => $nick,
207 'pack' => $_,
208 'status' => $status,
209 'net' => $chatnet,
210 'pos' => 0,
211 'try' => 0,
212 'etr' => 0,
213 'timer' => undef,
214 );
215 if (defined $lists{lc $server->{tag}}{lc $nick}{$_}) {
216 $transfer{filename} = $lists{lc $server->{tag}}{lc $nick}{$_};
217 }
218 push @queue, \%transfer;
219 }
220 process_queue()
221 }
222
223 sub list_xdcc_queue {
224 my $text;
225 my %progress = (0=>'waiting',
226 1=>'requesting',
227 2=>'queued',
228 3=>'transferring',
229 4=>'completed',
230 5=>'canceling',
231 6=>'retrying');
232 my $i = 1;
233 foreach (@queue) {
234 my $current = $_;
235 my $botname = $current->{'nick'};
236 my $ircnet = $current->{'net'};
237 my $pack = $current->{'pack'};
238 my $status = $progress{$current->{'status'}};
239 my $info = '';
240 my $etr = '';
241 if ($current->{'status'}==2) {
242 my $time = $current->{'etr'}-time();
243 my $hours = int($time / (60*60));
244 my $minutes = int( ($time-($hours*60*60))/60 );
245 my $seconds = int( ($time-($hours*60*60)-($minutes*60)) );
246
247 $etr = '('.$hours.' hours, '.$minutes.' minutes and '.$seconds.' seconds remaining)' if ($current->{'etr'} > 0);
248 $info = "[".$current->{'pos'}."]".' '.$etr;
249 } elsif ($current->{'status'}==6) {
250 my $time = $current->{'etr'}-time();
251 my $hours = int($time / (60*60));
252 my $minutes = int( ($time-($hours*60*60))/60 );
253 my $seconds = int( ($time-($hours*60*60)-($minutes*60)) );
254
255 $etr = '('.$hours.' hours, '.$minutes.' minutes and '.$seconds.' seconds remaining)' if ($current->{'etr'} > 0);
256 $info = '['.$current->{'try'}.']'.' '.$etr;
257 }
258 $text .= "%9".$i."%9 ".$botname."<".$ircnet.">: Pack ".$pack;
259 $text .= " (".$current->{filename}.")" if defined $current->{filename};
260 $text .= " => ".$status.' '.$info;
261 $text .= "\n";
262 $i++;
263 }
264 print CLIENTCRAP draw_box("XDCCget", $text, "queued packs", 1);
265 }
266
267 sub cancel_pack {
268 my (@numbers) = @_;
269 @numbers = sort {$b cmp $a} @numbers;
270 foreach (@numbers) {
271 my $item = @queue->[$_-1];
272
273 if ($item->{'status'} == 2) {
274 # Remove the order from the bots queue
275 my $server = Irssi::server_find_tag($item->{'net'});
276 $server->command('MSG '.$item->{'nick'}.' xdcc remove');
277 print CLIENTCRAP "%R>>>%n Removing pack ".$_." from server queue";
278 $item->{'status'} = 5;
279 #splice(@queue, $_,$_+1);
280 } elsif ($item->{'status'} == 3) {
281 $item->{'status'} = 5;
282 Irssi::command('DCC close get '.$item->{'nick'});
283 print CLIENTCRAP "%R>>>%n Transfer aborted, waiting for acknowledgement";
284 } else {
285 splice(@queue, $_-1, $_);
286 }
287 process_queue();
288 }
289 }
290
291 sub list_packs ($$) {
292 my ($server, $bot) = @_;
293 $server->command('MSG '.$bot.' xdcc list');
294 $lists{lc $server->{tag}}{lc $bot} = {};
295 }
296
297 sub cmd_xdccget {
298 my ($args, $server, $witem) = @_;
299 my @arg = split(/ /, $args);
300
301 if ((scalar(@arg) == 0) or ($arg[0] eq '-l')) {
302 list_xdcc_queue();
303 } elsif ($arg[0] eq 'queue') {
304 # queue files
305 shift @arg;
306 queue_pack("@arg", $server, $witem);
307 } elsif ($arg[0] eq 'list' && defined $arg[1]) {
308 list_packs($server, $arg[1]);
309 } elsif ($arg[0] eq 'cancel') {
310 shift @arg;
311 cancel_pack(@arg);
312 } elsif ($arg[0] eq 'help') {
313 show_help();
314 }
315 }
316
317 sub event_private_message {
318 my ($server, $text, $nick, $address) = @_;
319 event_message_irc_notice($server, $text, $nick, $address, undef);
320 }
321
322 sub event_no_such_nick {
323 my ($server, $args, $sender_nick, $sender_address) = @_;
324 my ($myself, $nick) = split(/ /, $args, 3);
325
326 unless (scalar(@queue) == 0) {
327 if ($nick eq $queue[0]->{'nick'}) {
328 if ($queue[0]->{'status'} == 1 || $queue[0]->{'status'} == 5) {
329 $queue[0]->{'status'} = 4;
330 }
331 }
332 process_queue();
333 }
334 }
335
336
337 Irssi::command_bind('xdccget', \&cmd_xdccget);
338 foreach my $cmd ('queue', 'cancel', 'list', 'help', 'list') {
339 Irssi::command_bind('xdccget '.$cmd => sub {
340 cmd_xdccget("$cmd ".$_[0], $_[1], $_[2]); });
341 }
342
343
344 Irssi::signal_add('message irc notice', 'event_message_irc_notice');
345 Irssi::signal_add("message private", "event_private_message");
346 Irssi::signal_add("event 401", "event_no_such_nick");
347
348 Irssi::settings_add_int($IRSSI{'name'}, 'xdccget_retry_time', 30);
349
350 print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /xdccget help for help';