use strict;
use v5.6.0; # Perl 5.6.0+ required!

use vars qw($VERSION %IRSSI $MIRROR);

use LWP::Simple;

use Irssi qw(
    active_win command_bind settings_get_str settings_add_str
    settings_get_bool settings_add_bool get_irssi_dir command
);
$VERSION = '1.35';
%IRSSI = (
    authors	=> 'Juerd',
    contact	=> 'juerd@juerd.nl',
    name	=> 'Script Administration',
    description	=> 'Install and upgrade scripts',
    license	=> 'Public Domain',
    url		=> 'http://juerd.nl/irssi/',
    changed	=> 'Mon May 13 19:52 CEST 2002',
    changes     => 'Patch by peder@ifi.uio.no: scriptadmin now creates backups',
    commands	=> '/script install, /script upgrade, /script check, /script search',
    note	=> 'Potentially dangerous. Use at your own risk!',
);

sub shuffle (\@) {
    my ($array) = @_;
    my $i;
    for ($i = @$array; --$i; ) {
	my $j = int rand ($i + 1);
	@$array[$i, $j] = @$array[$j, $i];
    }
}

sub retrieve {
    my @mirrors = split ' ', settings_get_str('script_mirrors');
    my $mirror;

    my $page;
    {
	$mirror = shift @mirrors;
	$page = get($mirror);
	if (not $page) {
    	    print CLIENTERROR "Could not retrieve $mirror";
    	    redo if @mirrors;
	    print CLIENTERROR "No more mirrors. Aborting.";
	    return 0;
	}
    }
    $MIRROR = $mirror;
    
    $page =~ s/^.*?<tr[^>]*>//s;
    $page =~ s/<.table>.*//s;
    my $counter = 0;
    my ($filecol, $vercol, $desccol, $namecol);
    while ($page =~ s/^\s*<td>(.*?)<.td>\s*//) {
        my $header = $1;
        if ($header =~ /Filename/) {
	    $filecol = $counter;
	} elsif ($header =~ /Version/) {
    	    $vercol = $counter;
	} elsif ($header =~ /Desc/) {
	    $desccol = $counter;
	} elsif ($header =~ /Name/) {
	    $namecol = $counter;
	}
	$counter++;
    }

    my @scripts = split /<tr[^>]*>/, $page;
    my %versions;
    for (@scripts) {
        my $copy = $_;
        $_ = [];
        push @$_, $1 while $copy =~ s/^\s*<td>(.*?)<.td>\s*//;
        $_->[$filecol] =~ s/<a[^>]*>|\.pl|<.*//gs;
	$_->[$vercol] = 0 if $_->[$vercol] =~ /nbsp/;
        %{ $versions{$_->[$filecol]} } = (
	    version => $_->[$vercol],
	    name    => $_->[$namecol],
	    desc    => $_->[$desccol]
	);
    }
    # print CRAP join ",", keys %versions;
    return \%versions;
}

sub compare_versions {
    my ($cur, $new) = @_;
    my @cur = split /\./, $cur;
    my @new = split /\./, $new;
    if (@cur != @new) {
        print CLIENTERROR "Number of dots differs: cannot compare version numbers.";
        print CRAP "Installed version: $cur, Available version: $new";
        return 0;
    }
    my $cmp = 0;
    $cmp ||= $new[$_] <=> $cur[$_] for 0..$#cur;
    return 'newer' if $cmp == 1;
    return 'older' if $cmp == -1;
    return 'equal';
}

sub install {
    my ($scriptname) = @_;
    my @mirrors;
    if ($MIRROR) {
	@mirrors = ($MIRROR);
    } else {
	@mirrors = split ' ', settings_get_str('script_mirrors');
	shuffle @mirrors;
    }
    my $file = "$scriptname.pl";
    my $irssidir = get_irssi_dir();
    my $newscript;
    {
	my $mirror = shift @mirrors;
	$newscript = get("$mirror/scripts/$file") || do {
	    print CLIENTERROR "Couldn't retrieve $mirror/scripts/$file :(";
	    redo if @mirrors;
	    print CLIENTERROR "No mirrors left. Aborting.";
	    return;
	};
    }
    rename "$irssidir/scripts/$file",
           "$irssidir/scripts/$file.old"
     if -e "$irssidir/scripts/$file";
    open (FOO, '>', "$irssidir/scripts/$file") or do {
	print CLIENTERROR "Couldn't open file $irssidir/$file for writing: $!";
	return;
    };
    print FOO $newscript;
    close FOO;
    if ($scriptname ne 'scriptadmin') {
        print CLIENTNOTICE "Installing new script...";
	command("script load $scriptname");
    } else {
	print CRAP "\cBCan't reload scriptadmin! Please do it manually by typing /script load scriptadmin";
    }
    if ($Irssi::Script::scriptinfo::VERSION) {
	(my $z = $scriptname) =~ tr/-/_/;
	command("script info $z");
    }
    return 1;
}

sub loaded {
    no strict 'refs';
    my @modules;
    for (sort grep s/::$//, keys %Irssi::Script::) {
        my $name    = ${ "Irssi::Script::${_}::IRSSI" }{name};
	my $version = ${ "Irssi::Script::${_}::VERSION" };
	push @modules, [$_, $name, $version] if $name && $version;
    }
    return @modules;
}


sub newscripts {
    
    my ($action, $data, $server) = @_;
    if ($data !~ /\S/) {
        print CLIENTERROR "Usage: /script $action <scriptname|all>";
        return;
    }
	
    no strict 'refs';

    if ($data ne 'all' and not exists $Irssi::Script::{ "${data}::" }) {
        print CLIENTERROR 'Script is not loaded. You can only upgrade loaded scripts.';
        return;
    }

    my $irssidir = get_irssi_dir();
    my $versions = retrieve or return;


    my $all = $data eq 'all';
	
    my @walk;  # Stupid perltidy seems not be capable of handling ?:
    @walk = map $_->[0], loaded if $all;
    @walk = ($data) if not $all;
    for $data (@walk) {
	
        (my $pack = $data) =~ tr/-/_/;
	(my $filen = $data) =~ tr/_/-/;
	
        if (not $versions->{$filen}{version}) {
	    if (not $all or settings_get_bool('scriptadmin_verbose')) {
	        print CRAP "Script \cB$data\cB has no version number in the archive.";
	    }
	    next;
	}

	my $version = ${ "Irssi::Script::${pack}::VERSION" };
	
	if (not -e "$irssidir/scripts/$data.pl") {
	    if (-e "$irssidir/scripts/$filen.pl") {
		$data = $filen;
	    } else {
	        print CRAP "$irssidir/scripts/$data.pl does not exist. Skipping.";
	        next;
	    }
	}
	    
	my $cmp = compare_versions($version, $versions->{$data}{version}) or do {
	    print CLIENTERROR "... while comparing versions for \cB$data\cB";
	    next;
	};
	
	if ($cmp eq 'equal') {
	    if (not $all or settings_get_bool('scriptadmin_verbose')) {
	        print CRAP "Script \cB$data\cB is up to date.";
	    }
	} elsif ($cmp eq 'newer') {
    	    print CRAP "New version of \cB$data\cB available! (current: $version, new $versions->{$data}{version})";
	    if ($action eq 'upgrade') {
	        install($data) or next;
	    }
	} elsif ($cmp eq 'older') {
	    print CRAP "Wow, your version of \cB$data\cB is newer...";
	} else {
	    print CLIENTERROR "What the fuck?!";
	}
    }
    if ($all) {
        print CRAP "Done.";
    }
}


command_bind 'script upgrade' => sub { newscripts('upgrade', @_) };
command_bind 'script check'   => sub { newscripts('check', @_) };

command_bind 'script install' => sub {
    my ($data, $server) = @_;
    if ($data !~ /\S/) {
        print CLIENTERROR 'Usage: /script install <scriptname>';
        return;
    }
	
    no strict 'refs';

    (my $pack = $data) =~ tr/-/_/;

    if (${ "Irssi::Script::${pack}::VERSION" }) {
        print CLIENTERROR 'Script is loaded. Please use /script upgrade instead.';
        return;
    }

    install($data) or return;
};

command_bind 'script search' => sub {
    my ($data, $server) = @_;
    if ($data !~ /\S/) {
        print CLIENTERROR 'Usage: /script search <text>';
        return;
    }
	
    print CLIENTNOTICE "Searching for $data...";

    $data = quotemeta $data;
	
    my $info = retrieve;
    my $found = 0;
    for (keys %$info) {
	my $value = $info->{$_};
	my $foo  = $value->{name} =~ s/$data/\cB$data\cB/gi;
	   $foo += $value->{desc} =~ s/$data/\cB$data\cB/gi;
        $found++, print CRAP "$_\cC14.pl\cC ($value->{name}) - $value->{desc}" if $foo;
    }
	
    print CLIENTNOTICE "Search yielded $found results.";
};

settings_add_str 'script', 'script_mirrors' => join ' ', qw(
    http://scripts.irssi.de/
    http://irssi.org/scripts/
    http://scripts.irssi.pl/
    http://www.linux-administration.de/irssi/scripts/
    http://irssi.konform.org/
);

settings_add_bool 'script', 'scriptadmin_verbose' => 1;