irssi-scripts 20120326 / usr / share / irssi / scripts / xdccget.pl

#
# by Stefan "tommie" Tomanek <stefan@kann-nix.org>
#
# History:
#
# 26.02.2002
# *first release, report bugs :)
#
# 01.03.2002
# *CHanged to GPL
#
# 08.03.200
# *some bugfixes
#
# 13.04.2002
# *major improvements
# *cosmetic changes
# 
# 14.04.2002
# *internal redesign
# *feature enhancements
#
# 17.04.2002
# * improved queuing code
# * changed to $server->{tag}
# * improved communication with server
#
# 21.04.2002
# *improved ETA listing
#
# 27.04.2002
# *handling of gone bots added
#
# 28.04.2002
# *fixed handling of servers that are not in an ircnet

use strict;
#use warnings;

use vars qw($VERSION %IRSSI);
$VERSION = "20040509";
%IRSSI = (
    authors     => "Stefan 'tommie' Tomanek",
    contact     => "stefan\@pico.ruhr.de",
    name        => "XDCCget",
    description => "advances downloading from XDCC bots",
    license     => "GPLv2",
    changed     => "$VERSION",
    commands	=> "xdccget"
);

use Irssi 20020324;

use vars qw(@queue $timer $debug %lists);

$debug=0;

sub show_help() {
    my $help="XDCCget $VERSION
/xdccget queue Nickname <number> <number>...
    Queue the specified packs of the server 'Nickname'
/xdccget list
    List the download queue
/xdccget cancel <number>
    Remove pack <number> from the local queue
/xdccget help
    Display this help
";
    my $text = '';
    foreach (split(/\n/, $help)) {
        $_ =~ s/^\/(.*)$/%9\/$1%9/;
        $text .= $_."\n";
    }
    print CLIENTCRAP &draw_box("XDCCget", $text, "help", 1);
}

sub draw_box ($$$$) {
    my ($title, $text, $footer, $colour) = @_;
    my $box = '';
    my $exp_flags = Irssi::EXPAND_FLAG_IGNORE_EMPTY | Irssi::EXPAND_FLAG_IGNORE_REPLACES;
    $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
    foreach (split(/\n/, $text)) {                                                      $box .= '%R|%n '.$_."\n";
    }                                                                               $box .= '%R`--<%n'.$footer.'%R>->%n';
    $box =~ s/%.//g unless $colour;
    return $box;
}

sub contains {
    my ($item, @list) = @_;
    foreach (@list) {
	    ($item eq $_) && return 1;
    }
    return 0;
}

sub event_message_irc_notice {
    my ($server, $msg, $nick, $address, $target) = @_;
    $_ = $msg;
    if ($queue[0] &&  $nick eq $queue[0]->{'nick'}) {
	if (/\*\*\* Closing Connection:/) {
	    print CLIENTCRAP "%R>>%n XDCC-Transfer closed";
	    # Is it a canceled transger?
	    if ($queue[0]->{'status'} == 5) {
		$queue[0]->{'status'} = 4;
	    } else {
		# We should try again
		$queue[0]->{'status'} = 0;
	    }
	} elsif (/\*\*\* Transfer Completed/i) {
    	    print CLIENTCRAP "%R>>%n XDCC-Transfer completed";
	    # Mark the transfer as completed
	    $queue[0]->{'status'} = 4;
	} elsif (/\*\*\* You already requested that pack/i) {
	    $queue[0]->{'status'} = 4;
	} elsif (/\*\*\* Sending You Pack/i || /\*\*\* Sending You Your Queued Pack|DCC Send .*? \(.*?\)/i) {
	    $queue[0]->{'status'} = 3;
	    print CLIENTCRAP "%R>>%n XDCC-Transfer starting";
	} elsif (/\*\*\* All Slots Full, Added (|you to the main )queue in position ([0-9]*)/i) {
	    $queue[0]->{'pos'} = $2;
	    $queue[0]->{'etr'} = 0;
	    $queue[0]->{'status'} = 2;
	} elsif (/You have been queued for ([0-9]*?) hr ([0-9]*?) min, currently in main queue position ([0-9]*?) of ([0-9]*?)\.  Estimated remaining time is ([0-9]*?) hr ([0-9]*?) min or (less|more)\./i) {
	    $queue[0]->{'pos'} = $3;
	    $queue[0]->{'etr'} = time() + (($5*60)+$6)*60;
	    $queue[0]->{'status'} = 2;
	} elsif (/You have been queued for ([0-9]*?) hours ([0-9]*?) minutes, currently in main queue position ([0-9]*?) of ([0-9]*?)\./i) {
	    $queue[0]->{'pos'} = $3;
	    $queue[0]->{'status'} = 2;
	} elsif (/You have been queued for ([0-9]*?) minutes, currently in main queue position ([0-9]*?) of ([0-9]*?)\./) {
	    $queue[0]->{'status'} = 2;
	    # FIXME unite somehow with regexp above
	    $queue[0]->{'pos'} = $2;
	} elsif (/It has been placed in queue slot #(\d+), it will send when sends are available/) {
	    $queue[0]->{'pos'} = $1;
	    $queue[0]->{'status'} = 2;
	} elsif (/\*\*\* Invalid Pack Number/) {
	    $queue[0]->{'status'} = 4;
	} elsif (/\*\*\* The Owner Has Requested That No New Connections Are Made/) {
	    $queue[0]->{'status'} = 4;
	} 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) {
	    if (Irssi::settings_get_int('xdccget_retry_time') > 0) {
		my $retry = Irssi::settings_get_int('xdccget_retry_time')*1000;
		$queue[0]->{'status'} = 6;
		$queue[0]->{'timer'} = Irssi::timeout_add($retry, 'retry_transfer', undef);
		$queue[0]->{'etr'} = time()+$retry/1000;
	    } else {
		$queue[0]->{'status'} = 4;
	    }
	} elsif (/Removed you from the queue/) {
	    $queue[0]->{'status'} = 4;
	} else { Irssi::print($_) if ($debug); }
	
	process_queue();
    }
    if (/#(\d+).+?\d+x \[ *(<?\d+.*?)\] +(.*)$/) {
	my ($pack, $size, $name) = ($1, $2, $3);
    	if (defined $lists{lc $server->{tag}}{lc $nick}) {
	    $lists{lc $server->{tag}}{lc $nick}{$pack} = $name;
	}
	foreach (@queue) {
	    next unless lc $nick eq lc $_->{nick};
	    next unless lc $server->{tag} eq lc $_->{net};
	    next unless $_->{pack} eq $pack;
	    $_->{filename} = $name;
	}
    }
}

sub process_queue {
    unless (scalar(@queue) > 0) {return 0};
    my %current = %{$queue[0]};
    shift @queue if ( $current{'status'} == 4 );
    unless (scalar(@queue) > 0) {return 0};
    %current = %{$queue[0]};
    if ( $current{'status'} == 0 ) {
	my $server = Irssi::server_find_tag($current{'net'});
    	$server->command('MSG '.$current{'nick'}.' xdcc send '.$current{'pack'});
	$queue[0]->{'try'}++;
	$queue[0]->{'status'} = 1;
    }
}

sub retry_transfer {
    if (defined $queue[0] && $queue[0]->{'status'} == 6) {
	Irssi::timeout_remove($queue[0]->{'timer'});
	#print CLIENTCRAP "%R>>%n Retrying XDCC-transfer...";
	$queue[0]->{'status'} = 0;
	process_queue();
    }
}

sub queue_pack {
    my ($args, $server, $witem) = @_;
    my @args = split(/ /, $args, 2);
    my ($nick, $packs);
    if (ref $witem && $witem->{type} eq 'QUERY' && $args[0] =~ /^\d+$/) {
	($nick, $packs) = ($witem->{name}, $args[0]);
    } else {
	($nick, $packs) = @args;
    }
    my @packs = split(/ /, $packs);
    foreach (@packs) {
	# 0: Waiting, 1: Processing, 2: Doenloading
	my $status = 0;
	my $chatnet = $server->{tag};
	my %transfer = ('nick'    => $nick,
			'pack'    => $_,
			'status'  => $status,
			'net'     => $chatnet,
			'pos'     => 0,
			'try'     => 0,
			'etr'     => 0,
			'timer'   => undef,
			);
	if (defined $lists{lc $server->{tag}}{lc $nick}{$_}) {
	    $transfer{filename} = $lists{lc $server->{tag}}{lc $nick}{$_};
	}
	push @queue, \%transfer;
    }
    process_queue()
}

sub list_xdcc_queue {
    my $text;
    my %progress = (0=>'waiting',
		    1=>'requesting',
		    2=>'queued',
		    3=>'transferring',
		    4=>'completed',
		    5=>'canceling',
		    6=>'retrying');
    my $i = 1;
    foreach (@queue) {
	my $current = $_;
	my $botname = $current->{'nick'};
	my $ircnet = $current->{'net'};
	my $pack = $current->{'pack'};
	my $status = $progress{$current->{'status'}};
	my $info = '';
	my $etr = '';
	if ($current->{'status'}==2) {
	    my $time = $current->{'etr'}-time();
            my $hours = int($time / (60*60));
            my $minutes = int( ($time-($hours*60*60))/60 );
            my $seconds = int( ($time-($hours*60*60)-($minutes*60))  );

            $etr = '('.$hours.' hours, '.$minutes.' minutes and '.$seconds.' seconds remaining)' if ($current->{'etr'} > 0);
	    $info = "[".$current->{'pos'}."]".' '.$etr;
	} elsif ($current->{'status'}==6) {
	    my $time = $current->{'etr'}-time();
	    my $hours = int($time / (60*60));
	    my $minutes = int( ($time-($hours*60*60))/60 );
	    my $seconds = int( ($time-($hours*60*60)-($minutes*60))  );
	    
	    $etr = '('.$hours.' hours, '.$minutes.' minutes and '.$seconds.' seconds remaining)' if ($current->{'etr'} > 0);
	    $info = '['.$current->{'try'}.']'.' '.$etr;
	}
	$text .= "%9".$i."%9 ".$botname."<".$ircnet.">: Pack ".$pack;
	$text .= " (".$current->{filename}.")" if defined $current->{filename};
	$text .= " => ".$status.' '.$info;
	$text .= "\n";
	$i++;
    }
    print CLIENTCRAP draw_box("XDCCget", $text, "queued packs", 1);
}

sub cancel_pack {
    my (@numbers) = @_;
    @numbers = sort {$b cmp $a} @numbers;
    foreach (@numbers) {
	my $item = @queue->[$_-1];

	if ($item->{'status'} == 2) {
	    # Remove the order from the bots queue
	    my $server = Irssi::server_find_tag($item->{'net'});
	    $server->command('MSG '.$item->{'nick'}.' xdcc remove');
	    print CLIENTCRAP "%R>>>%n Removing pack ".$_." from server queue";
	    $item->{'status'} = 5;
	    #splice(@queue, $_,$_+1);
	} elsif ($item->{'status'} == 3) {
	    $item->{'status'} = 5;
	    Irssi::command('DCC close get '.$item->{'nick'});
	    print CLIENTCRAP "%R>>>%n Transfer aborted, waiting for acknowledgement";
	} else {
	    splice(@queue, $_-1, $_);
	}
	process_queue();
    }
}

sub list_packs ($$) {
    my ($server, $bot) = @_;
    $server->command('MSG '.$bot.' xdcc list');
    $lists{lc $server->{tag}}{lc $bot} = {};
}

sub cmd_xdccget {
    my ($args, $server, $witem) = @_;
    my @arg = split(/ /, $args);

    if ((scalar(@arg) == 0) or ($arg[0] eq '-l')) {
	list_xdcc_queue();
    } elsif ($arg[0] eq 'queue') {
	# queue files
	shift @arg;
	queue_pack("@arg", $server, $witem);
    } elsif ($arg[0] eq 'list' && defined $arg[1]) {
	list_packs($server, $arg[1]);
    } elsif ($arg[0] eq 'cancel') {
	shift @arg;
	cancel_pack(@arg);
    } elsif ($arg[0] eq 'help') {
	show_help();
    }
}

sub event_private_message {
    my ($server, $text, $nick, $address) = @_;
    event_message_irc_notice($server, $text, $nick, $address, undef);
}

sub event_no_such_nick {
    my ($server, $args, $sender_nick, $sender_address) = @_;
    my ($myself, $nick) = split(/ /, $args, 3);
    
    unless (scalar(@queue) == 0) {
	if ($nick eq $queue[0]->{'nick'}) {
	    if ($queue[0]->{'status'} == 1 || $queue[0]->{'status'} == 5) {
		$queue[0]->{'status'} = 4;
	    }
	}
	process_queue();
    }
}


Irssi::command_bind('xdccget', \&cmd_xdccget);
foreach my $cmd ('queue', 'cancel', 'list', 'help', 'list') {
    Irssi::command_bind('xdccget '.$cmd => sub {
                        cmd_xdccget("$cmd ".$_[0], $_[1], $_[2]); });
}


Irssi::signal_add('message irc notice', 'event_message_irc_notice');
Irssi::signal_add("message private", "event_private_message");
Irssi::signal_add("event 401", "event_no_such_nick");

Irssi::settings_add_int($IRSSI{'name'}, 'xdccget_retry_time', 30);

print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /xdccget help for help';