From 06fdfd617e3944e5ed07aa0e230d71a1e76384c3 Mon Sep 17 00:00:00 2001
From: ailin-nemui <ailin-nemui@users.noreply.github.com>
Date: Mon, 8 Feb 2016 14:38:33 +0100
Subject: sync scriptassist.pl

---
 scripts/scriptassist.pl | 454 +++++++++++++++++++++++++++---------------------
 1 file changed, 259 insertions(+), 195 deletions(-)

(limited to 'scripts')

diff --git a/scripts/scriptassist.pl b/scripts/scriptassist.pl
index dd6d3737..459d97f6 100644
--- a/scripts/scriptassist.pl
+++ b/scripts/scriptassist.pl
@@ -5,21 +5,19 @@
 
 use strict;
 
-use vars qw($VERSION %IRSSI);
-$VERSION = '2003020803';
-%IRSSI = (
+our $VERSION = '2003020804';
+our %IRSSI = (
     authors     => 'Stefan \'tommie\' Tomanek',
     contact     => 'stefan@pico.ruhr.de',
     name        => 'scriptassist',
     description => 'keeps your scripts on the cutting edge',
     license     => 'GPLv2',
     url         => 'http://irssi.org/scripts/',
-    changed     => $VERSION,
     modules     => 'Data::Dumper LWP::UserAgent (GnuPG)',
     commands	=> "scriptassist"
 );
 
-use vars qw($forked %remote_db $have_gpg);
+our ($forked, %remote_db, $have_gpg, @complist);
 
 use Irssi 20020324;
 use Data::Dumper;
@@ -27,12 +25,11 @@ use LWP::UserAgent;
 use POSIX;
 
 # GnuPG is not always needed
-use vars qw($have_gpg @complist);
 $have_gpg = 0;
 eval "use GnuPG qw(:algo :trust);";
 $have_gpg = 1 if not ($@);
 
-sub show_help() {
+sub show_help {
     my $help = "scriptassist $VERSION
 /scriptassist check
     Check all loaded scripts for new available versions
@@ -42,15 +39,15 @@ sub show_help() {
     Search the script database
 /scriptassist info <scripts>
     Display information about <scripts>
-/scriptassist ratings <scripts>
-    Retrieve the average ratings of the the scripts
-/scriptassist top <num>
-    Retrieve the first <num> top rated scripts
-/scriptassist new <num>
+".#/scriptassist ratings <scripts>
+#    Retrieve the average ratings of the the scripts
+#/scriptassist top <num>
+#    Retrieve the first <num> top rated scripts
+"/scriptassist new <num>
     Display the newest <num> scripts
-/scriptassist rate <script> <stars>
-    Rate the script with a number of stars ranging from 0-5
-/scriptassist contact <script>
+".#/scriptassist rate <script> <stars>
+#    Rate the script with a number of stars ranging from 0-5
+"/scriptassist contact <script>
     Write an email to the author of the script
     (Requires OpenURL)
 /scriptassist cpan <module>
@@ -70,7 +67,7 @@ sub show_help() {
     #theme_box("ScriptAssist", $text, "scriptassist help", 1);
 }
 
-sub theme_box ($$$$) {
+sub theme_box {
     my ($title, $text, $footer, $colour) = @_;
     Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'box_header', $title);
     foreach (split(/\n/, $text)) {
@@ -79,31 +76,30 @@ sub theme_box ($$$$) {
     Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'box_footer', $footer);
 }
 
-sub draw_box ($$$$) {
+sub draw_box {
     my ($title, $text, $footer, $colour) = @_;
     my $box = '';
     $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 .= '%R`--<%n'.$footer.'%R>->%n';
     $box =~ s/%.//g unless $colour;
     return $box;
 }
 
-sub call_openurl ($) {
+sub call_openurl {
     my ($url) = @_;
-    no strict "refs";
     # check for a loaded openurl
-    if ( %{ "Irssi::Script::openurl::" }) {
-        &{ "Irssi::Script::openurl::launch_url" }($url);
+    if (my $code = Irssi::Script::openurl::->can('launch_url')) {
+	$code->($url);
     } else {
         print CLIENTCRAP "%R>>%n Please install openurl.pl";
     }
-    use strict;
 }
 
-sub bg_do ($) {
-    my ($func) = @_; 
+sub bg_do {
+    my ($func) = @_;
     my ($rh, $wh);
     pipe($rh, $wh);
     if ($forked) {
@@ -137,7 +133,6 @@ sub bg_do ($) {
 		$result{data}{update} = update_scripts(\@items, $xml);
 	    } elsif ($items[0] eq 'search') {
 		shift(@items);
-		#$result{data}{search}{-foo} = 0;
 		foreach (@items) {
 		    $result{data}{search}{$_} = search_scripts($_, $xml);
 		}
@@ -150,14 +145,12 @@ sub bg_do ($) {
 	    } elsif ($items[0] eq 'ratings') {
 		shift(@items);
 		@items = @{ loaded_scripts() } if $items[0] eq "all";
-		#$result{data}{rating}{-foo} = 1;
 		my %ratings = %{ get_ratings(\@items, '') };
 		foreach (keys %ratings) {
 		    $result{data}{rating}{$_}{rating} = $ratings{$_}->[0];
 		    $result{data}{rating}{$_}{votes} = $ratings{$_}->[1];
 		}
 	    } elsif ($items[0] eq 'rate') {
-		#$result{data}{rate}{-foo} = 1;
 		$result{data}{rate}{$items[1]} = rate_script($items[1], $items[2]);
 	    } elsif ($items[0] eq 'info') {
 		shift(@items);
@@ -182,12 +175,16 @@ sub bg_do ($) {
 	    my $data = $dumper->Dump;
 	    print($wh $data);
 	};
+	if ($@) {
+	    print($wh Data::Dumper->new([+{data=>+{error=>$@}}])
+		      ->Purity(1)->Deepcopy(1)->Indent(0)->Dump);
+	}
 	close($wh);
 	POSIX::_exit(1);
     }
 }
 
-sub get_unknown ($$) {
+sub get_unknown {
     my ($cmd, $db) = @_;
     foreach (keys %$db) {
 	next unless defined $db->{$_}{commands};
@@ -198,56 +195,90 @@ sub get_unknown ($$) {
     return undef;
 }
 
-sub script_info ($) {
+sub get_names {
+    my ($sname, $db) = shift;
+    $sname =~ s/\s+$//;
+    $sname =~ s/\.pl$//;
+    my $plname = "$sname.pl";
+    $sname =~ s/^.*\///;
+    my $xname = $sname;
+    $xname =~ s/\W/_/g;
+    my $pname = "${xname}::";
+    if ($xname ne $sname || $sname =~ /_/) {
+	my $dir = Irssi::get_irssi_dir()."/scripts/";
+	if ($db && exists $db->{"$sname.pl"}) {
+	    # $found = 1;
+	} elsif (-e $dir.$plname || -e $dir."$sname.pl" || -e $dir."autorun/$sname.pl") {
+	    # $found = 1;
+	} else {
+	    # not found
+	    my $pat = $xname; $pat =~ y/_/?/;
+	    my $re = "\Q$xname"; $re =~ s/\Q_/./g;
+	    if ($db) {
+		my ($cand) = grep /^$re\.pl$/, sort keys %$db;
+		if ($cand) {
+		    return get_names($cand, $db);
+		}
+	    }
+	    my ($cand) = glob "'$dir$pat.pl' '${dir}autorun/$pat.pl'";
+	    if ($cand) {
+		$cand =~ s/^.*\///;
+		return get_names($cand, $db);
+	    }
+	}
+    }
+    ($sname, $plname, $pname, $xname)
+}
+
+sub script_info {
     my ($scripts) = @_;
-    no strict "refs";
     my %result;
     my $xml = get_scripts();
     foreach (@{$scripts}) {
-	next unless (defined $xml->{$_.".pl"} || ( %{ 'Irssi::Script::'.$_.'::' } &&  %{ 'Irssi::Script::'.$_.'::IRSSI' }));
-	$result{$_}{version} = get_remote_version($_, $xml);
+	my ($sname, $plname, $pname) = get_names($_, $xml);
+	next unless (defined $xml->{$plname} || ( exists $Irssi::Script::{$pname} && exists $Irssi::Script::{$pname}{IRSSI} ));
+	$result{$sname}{version} = get_remote_version($sname, $xml);
 	my @headers = ('authors', 'contact', 'description', 'license', 'source');
 	foreach my $entry (@headers) {
-	    $result{$_}{$entry} = ${ 'Irssi::Script::'.$_.'::IRSSI' }{$entry};
-	    if (defined $xml->{$_.".pl"}{$entry}) {
-		$result{$_}{$entry} = $xml->{$_.".pl"}{$entry};
+	    $result{$sname}{$entry} = $Irssi::Script::{$pname}{IRSSI}{$entry};
+	    if (defined $xml->{$plname}{$entry}) {
+		$result{$sname}{$entry} = $xml->{$plname}{$entry};
 	    }
 	}
-	if ($xml->{$_.".pl"}{signature_available}) {
-	    $result{$_}{signature_available} = 1;
+	if ($xml->{$plname}{signature_available}) {
+	    $result{$sname}{signature_available} = 1;
 	}
-	if (defined $xml->{$_.".pl"}{modules}) {
-	    my $modules = $xml->{$_.".pl"}{modules};
-	    #$result{$_}{modules}{-foo} = 1;
+	if (defined $xml->{$plname}{modules}) {
+	    my $modules = $xml->{$plname}{modules};
 	    foreach my $mod (split(/ /, $modules)) {
 		my $opt = ($mod =~ /\((.*)\)/)? 1 : 0;
 		$mod = $1 if $1;
-		$result{$_}{modules}{$mod}{optional} = $opt;
-		$result{$_}{modules}{$mod}{installed} = module_exist($mod);
+		$result{$sname}{modules}{$mod}{optional} = $opt;
+		$result{$sname}{modules}{$mod}{installed} = module_exist($mod);
 	    }
-	} elsif (defined ${ 'Irssi::Script::'.$_.'::IRSSI' }{modules}) {
-	    my $modules = ${ 'Irssi::Script::'.$_.'::IRSSI' }{modules};
+	} elsif (defined $Irssi::Script::{$pname}{IRSSI}{modules}) {
+	    my $modules = $Irssi::Script::{$pname}{IRSSI}{modules};
 	    foreach my $mod (split(/ /, $modules)) {
 		my $opt = ($mod =~ /\((.*)\)/)? 1 : 0;
 		$mod = $1 if $1;
-		$result{$_}{modules}{$mod}{optional} = $opt;
-		$result{$_}{modules}{$mod}{installed} = module_exist($mod);
+		$result{$sname}{modules}{$mod}{optional} = $opt;
+		$result{$sname}{modules}{$mod}{installed} = module_exist($mod);
 	    }
 	}
-	if (defined $xml->{$_.".pl"}{depends}) {
-	    my $depends = $xml->{$_.".pl"}{depends};
+	if (defined $xml->{$plname}{depends}) {
+	    my $depends = $xml->{$plname}{depends};
 	    foreach my $dep (split(/ /, $depends)) {
-		$result{$_}{depends}{$dep}{installed} = 1; #(defined ${ 'Irssi::Script::'.$dep }); 
+		$result{$sname}{depends}{$dep}{installed} = 1;
 	    }
 	}
     }
     return \%result;
 }
 
-sub rate_script ($$) {
+sub rate_script {
     my ($script, $stars) = @_;
     my $ua = LWP::UserAgent->new(env_proxy=>1, keep_alive=>1, timeout=>30);
-    $ua->agent('ScriptAssist/'.$VERSION);
+    $ua->agent('ScriptAssist/'.2003020803);
     my $request = HTTP::Request->new('GET', 'http://ratings.irssi.de/irssirate.pl?&stars='.$stars.'&mode=rate&script='.$script);
     my $response = $ua->request($request);
     unless ($response->is_success() && $response->content() =~ /You already rated this script/) {
@@ -257,10 +288,10 @@ sub rate_script ($$) {
     }
 }
 
-sub get_ratings ($$) {
+sub get_ratings {
     my ($scripts, $limit) = @_;
     my $ua = LWP::UserAgent->new(env_proxy=>1, keep_alive=>1, timeout=>30);
-    $ua->agent('ScriptAssist/'.$VERSION);
+    $ua->agent('ScriptAssist/'.2003020803);
     my $script = join(',', @{$scripts});
     my $request = HTTP::Request->new('GET', 'http://ratings.irssi.de/irssirate.pl?script='.$script.'&sort=rating&limit='.$limit);
     my $response = $ua->request($request);
@@ -278,7 +309,7 @@ sub get_ratings ($$) {
     return \%result;
 }
 
-sub get_new ($) {
+sub get_new {
     my ($num) = @_;
     my $result;
     my $xml = get_scripts();
@@ -290,7 +321,7 @@ sub get_new ($) {
     }
     return $result;
 }
-sub module_exist ($) {
+sub module_exist {
     my ($module) = @_;
     $module =~ s/::/\//g;
     foreach (@INC) {
@@ -299,63 +330,64 @@ sub module_exist ($) {
     return 0;
 }
 
-sub debug_scripts ($) {
+sub debug_scripts {
     my ($scripts) = @_;
     my %result;
+    my $xml = get_scripts();
     foreach (@{$scripts}) {
-	my $xml = get_scripts();
-	if (defined $xml->{$_.".pl"}{modules}) {
-	    my $modules = $xml->{$_.".pl"}{modules};
+	my ($sname, $plname) = get_names($_, $xml);
+	if (defined $xml->{$plname}{modules}) {
+	    my $modules = $xml->{$plname}{modules};
 	    foreach my $mod (split(/ /, $modules)) {
                 my $opt = ($mod =~ /\((.*)\)/)? 1 : 0;
                 $mod = $1 if $1;
-                $result{$_}{$mod}{optional} = $opt;
-                $result{$_}{$mod}{installed} = module_exist($mod);
+                $result{$sname}{$mod}{optional} = $opt;
+                $result{$sname}{$mod}{installed} = module_exist($mod);
 	    }
 	}
     }
     return(\%result);
 }
 
-sub install_scripts ($$) {
+sub install_scripts {
     my ($scripts, $xml) = @_;
     my %success;
-    #$success{-foo} = 1;
     my $dir = Irssi::get_irssi_dir()."/scripts/";
     foreach (@{$scripts}) {
-	if (get_local_version($_) && (-e $dir.$_.".pl")) {
-	    $success{$_}{installed} = -2;
+	my ($sname, $plname, $pname) = get_names($_, $xml);
+	if (get_local_version($sname) && (-e $dir.$plname)) {
+	    $success{$sname}{installed} = -2;
 	} else {
-	    $success{$_} = download_script($_, $xml);
+	    $success{$sname} = download_script($sname, $xml);
 	}
     }
     return \%success;
 }
 
-sub update_scripts ($$) {
+sub update_scripts {
     my ($list, $database) = @_;
     $list = loaded_scripts() if ($list->[0] eq "all" || scalar(@$list) == 0);
     my %status;
-    #$status{-foo} = 1;
     foreach (@{$list}) {
-	my $local = get_local_version($_);
-	my $remote = get_remote_version($_, $database);
+	my ($sname) = get_names($_, $database);
+	my $local = get_local_version($sname);
+	my $remote = get_remote_version($sname, $database);
 	next if $local eq '' || $remote eq '';
 	if (compare_versions($local, $remote) eq "older") {
-	    $status{$_} = download_script($_, $database);
+	    $status{$sname} = download_script($sname, $database);
 	} else {
-	    $status{$_}{installed} = -2;
+	    $status{$sname}{installed} = -2;
 	}
-	$status{$_}{remote} = $remote;
-	$status{$_}{local} = $local;
+	$status{$sname}{remote} = $remote;
+	$status{$sname}{local} = $local;
     }
     return \%status;
 }
 
-sub search_scripts ($$) {
+sub search_scripts {
     my ($query, $database) = @_;
+    $query =~ s/\.pl\Z//;
     my %result;
-    #$result{-foo} = " ";
     foreach (sort keys %{$database}) {
 	my %entry = %{$database->{$_}};
 	my $string = $_." ";
@@ -385,23 +417,22 @@ sub search_scripts ($$) {
 
 sub pipe_input {
     my ($rh, $pipetag) = @{$_[0]};
-    my @lines = <$rh>;
+    my $text = do { local $/; <$rh>; };
     close($rh);
     Irssi::input_remove($$pipetag);
     $forked = 0;
-    my $text = join("", @lines);
     unless ($text) {
-	print CLIENTCRAP "%R<<%n Something weird happend";
+	print CLIENTCRAP "%R<<%n Something weird happend (no text)";
 	return();
     }
-    no strict "vars";
-    my $incoming = eval("$text");
+    local our $VAR1;
+    my $incoming = eval($text);
     if ($incoming->{db} && $incoming->{timestamp}) {
     	$remote_db{db} = $incoming->{db};
     	$remote_db{timestamp} = $incoming->{timestamp};
     }
     unless (defined $incoming->{data}) {
-	print CLIENTCRAP "%R<<%n Something weird happend";
+	print CLIENTCRAP "%R<<%n Something weird happend (no data)";
 	return;
     }
     my %result = %{ $incoming->{data} };
@@ -447,10 +478,14 @@ sub pipe_input {
     if ($result{unknown}) {
         print_unknown($result{unknown});
     }
+    if (defined $result{error}) {
+	print CLIENTCRAP "%R<<%n There was an error in background processing:"; chomp($result{error});
+	print CLIENTERROR $result{error};
+    }
 
 }
 
-sub print_unknown ($) {
+sub print_unknown {
     my ($data) = @_;
     foreach my $cmd (keys %$data) {
 	print CLIENTCRAP "%R<<%n No script provides '/$cmd'" unless $data->{$cmd};
@@ -458,7 +493,7 @@ sub print_unknown ($) {
 	    my $text .= "The command '/".$cmd."' is provided by the script '".$data->{$cmd}{$_}{name}."'.\n";
 	    $text .= "This script is currently not installed on your system.\n";
 	    $text .= "If you want to install the script, enter\n";
-	    my ($name) = /(.*?)\.pl$/;
+	    my ($name) = get_names($_);
 	    $text .= "  %U/script install ".$name."%U ";
 	    my $output = draw_box("ScriptAssist", $text, "'".$_."' missing", 1);
 	    print CLIENTCRAP $output;
@@ -466,11 +501,12 @@ sub print_unknown ($) {
     }
 }
 
-sub check_autorun ($) {
+sub check_autorun {
     my ($script) = @_;
+    my (undef, $plname) = get_names($script);
     my $dir = Irssi::get_irssi_dir()."/scripts/";
-    if (-e $dir."/autorun/".$script.".pl") {
-	if (readlink($dir."/autorun/".$script.".pl") eq "../".$script.".pl") {
+    if (-e $dir."/autorun/".$plname) {
+	if (readlink($dir."/autorun/".$plname) eq "../".$plname) {
 	    return 1;
 	}
     }
@@ -487,7 +523,7 @@ sub array2table {
             $l =~ s/%%/%/g;
             $width[$_] = length($l) if $width[$_]<length($l);
         }
-    }   
+    }
     my $text;
     foreach my $line (@array) {
         for (0..scalar(@$line)-1) {
@@ -503,7 +539,7 @@ sub array2table {
 }
 
 
-sub print_info (%) {
+sub print_info {
     my (%data) = @_;
     my $line;
     foreach my $script (sort keys(%data)) {
@@ -543,7 +579,6 @@ sub print_info (%) {
 	    $line .= " <optional>" if $data{$script}{modules}{$_}{optional};
             $line .= "\n";
         }
-	#$line .= "  Needed Irssi scripts:\n";
 	$line .= "  Needed Irssi Scripts:\n" if $data{$script}{depends};
 	foreach (sort keys %{$data{$script}{depends}}) {
 	    if ( $data{$script}{depends}{$_}{installed} == 1 ) {
@@ -551,14 +586,13 @@ sub print_info (%) {
 	    } else {
 		$line .= "  %r->%n ".$_." (not loaded)";
 	    }
-	    #$line .= " <optional>" if $data{$script}{depends}{$_}{optional};
 	    $line .= "\n";
 	}
     }
     print CLIENTCRAP draw_box('ScriptAssist', $line, 'info', 1) ;
 }
 
-sub print_rate (%) {
+sub print_rate {
     my (%data) = @_;
     my $line;
     foreach my $script (sort keys(%data)) {
@@ -571,7 +605,7 @@ sub print_rate (%) {
     print CLIENTCRAP draw_box('ScriptAssist', $line, 'rating', 1) ;
 }
 
-sub print_ratings (%) {
+sub print_ratings {
     my (%data) = @_;
     my @table;
     foreach my $script (sort {$data{$b}{rating}<=>$data{$a}{rating}} keys(%data)) {
@@ -589,12 +623,12 @@ sub print_ratings (%) {
     print CLIENTCRAP draw_box('ScriptAssist', array2table(@table), 'ratings', 1) ;
 }
 
-sub print_new ($) {
+sub print_new {
     my ($list) = @_;
     my @table;
     foreach (sort {$list->{$b}{last_modified} cmp $list->{$a}{last_modified}} keys %$list) {
 	my @line;
-	my ($name) = /^(.*?)\.pl$/;
+	my ($name) = get_names($_);
         if (get_local_version($name)) {
             push @line, "%go%n";
         } else {
@@ -607,7 +641,7 @@ sub print_new ($) {
     print CLIENTCRAP draw_box('ScriptAssist', array2table(@table), 'new scripts', 1) ;
 }
 
-sub print_debug (%) {
+sub print_debug {
     my (%data) = @_;
     my $line;
     foreach my $script (sort keys %data) {
@@ -627,12 +661,12 @@ sub print_debug (%) {
     }
 }
 
-sub load_script ($) {
+sub load_script {
     my ($script) = @_;
     Irssi::command('script load '.$script);
 }
 
-sub print_install (%) {
+sub print_install {
     my (%data) = @_;
     my $text;
     my ($crashed, @installed);
@@ -681,17 +715,16 @@ sub print_install (%) {
     list_sbitems(\@installed);
 }
 
-sub list_sbitems ($) {
+sub list_sbitems {
     my ($scripts) = @_;
     my $text;
     foreach (@$scripts) {
-	no strict 'refs';
-	next unless  %{ "Irssi::Script::${_}::" };
-	next unless  %{ "Irssi::Script::${_}::IRSSI" };
-	my %header = %{ "Irssi::Script::${_}::IRSSI" };
-	next unless $header{sbitems};
+	next unless exists $Irssi::Script::{"${_}::"};
+	next unless exists $Irssi::Script::{"${_}::"}{IRSSI};
+	my $header = $Irssi::Script::{"${_}::"}{IRSSI};
+	next unless $header->{sbitems};
 	$text .= '%9"'.$_.'"%9 provides the following statusbar item(s):'."\n";
-	$text .= '  ->'.$_."\n" foreach (split / /, $header{sbitems});
+	$text .= '  ->'.$_."\n" foreach (split / /, $header->{sbitems});
     }
     return unless $text;
     $text .= "\n";
@@ -699,7 +732,7 @@ sub list_sbitems ($) {
     print CLIENTCRAP draw_box('ScriptAssist', $text, 'sbitems', 1);
 }
 
-sub check_sig ($) {
+sub check_sig {
     my ($sig) = @_;
     my $line;
     my %trust = ( -1 => 'undefined',
@@ -722,7 +755,7 @@ sub check_sig ($) {
     return $line;
 }
 
-sub print_search ($%) {
+sub print_search {
     my ($query, %data) = @_;
     my $text;
     foreach (sort keys %data) {
@@ -738,7 +771,7 @@ sub print_search ($%) {
     print CLIENTCRAP draw_box('ScriptAssist', $text, 'search: '.$query, 1) ;
 }
 
-sub print_update (%) { 
+sub print_update {
     my (%data) = @_;
     my $text;
     my @table;
@@ -761,7 +794,7 @@ sub print_update (%) {
 	    push @table, ['%yo%n', '%9'.$_.'%9', 'not upgraded'];
             foreach (split /\n/, check_sig($data{$_})) {
 		push @table, ['', '', $_];
-            } 
+            }
 	} elsif ($data{$_}{installed} == -2 && $verbose) {
 	    my $local = $data{$_}{local};
 	    push @table, ['%go%n', '%9'.$_.'%9', 'already at the latest version ('.$local.')'];
@@ -771,35 +804,44 @@ sub print_update (%) {
     print CLIENTCRAP draw_box('ScriptAssist', $text, 'update', 1) ;
 }
 
-sub contact_author ($) {
+sub contact_author {
     my ($script) = @_;
-    no strict 'refs';
-    return unless  %{ "Irssi::Script::${script}::" };
-    my %header = %{ "Irssi::Script::${script}::IRSSI" };
-    if (defined $header{contact}) {
-	my @ads = split(/ |,/, $header{contact});
+    my ($sname, $plname, $pname) = get_names($script);
+    return unless exists $Irssi::Script::{$pname};
+    my $header = $Irssi::Script::{$pname}{IRSSI};
+    if ($header && defined $header->{contact}) {
+	my @ads = split(/ |,/, $header->{contact});
 	my $address = $ads[0];
 	$address .= '?subject='.$script;
 	$address .= '_'.get_local_version($script) if defined get_local_version($script);
-	call_openurl($address);
+	call_openurl($address) if $address =~ /[\@:]/;
     }
 }
 
 sub get_scripts {
     my $ua = LWP::UserAgent->new(env_proxy=>1, keep_alive=>1, timeout=>30);
-    $ua->agent('ScriptAssist/'.$VERSION);
+    $ua->agent('ScriptAssist/'.2003020803);
     $ua->env_proxy();
     my @mirrors = split(/ /, Irssi::settings_get_str('scriptassist_script_sources'));
     my %sites_db;
+    my $not_modified = 0;
     my $fetched = 0;
     my @sources;
+    my $error;
     foreach my $site (@mirrors) {
 	my $request = HTTP::Request->new('GET', $site);
 	if ($remote_db{timestamp}) {
 	    $request->if_modified_since($remote_db{timestamp});
 	}
 	my $response = $ua->request($request);
-	next unless $response->is_success;
+	if ($response->code == 304) { # HTTP_NOT_MODIFIED
+	    $not_modified = 1;
+	    next;
+	}
+	unless ($response->is_success) {
+	    $error = join "\n", $response->status_line(), (grep / at .* line \d+/, split "\n", $response->content()), '';
+	    next;
+	}
 	$fetched = 1;
 	my $data = $response->content();
 	my ($src, $type);
@@ -826,9 +868,8 @@ sub get_scripts {
 		$sites_db{$_}{source} = $src;
 	    }
 	} else {
-	    ## FIXME Panic?!
+	    die("Unknown script database type ($type).\n");
 	}
-	
     }
     if ($fetched) {
 	# Clean database
@@ -842,32 +883,40 @@ sub get_scripts {
 	}
 	$remote_db{db}{$_} = $sites_db{$_} foreach (keys %sites_db);
 	$remote_db{timestamp} = time();
+    } elsif ($not_modified) {
+	# nothing to do
+    } else {
+	die("No script database sources defined in /set scriptassist_script_sources\n") unless @mirrors;
+	die("Fetching script database failed: $error") if $error;
+	die("Unknown error while fetching script database\n");
     }
     return $remote_db{db};
 }
 
-sub get_remote_version ($$) {
+sub get_remote_version {
     my ($script, $database) = @_;
-    return $database->{$script.".pl"}{version};
+    my $plname = (get_names($script, $database))[1];
+    return $database->{$plname}{version};
 }
 
-sub get_local_version ($) {
+sub get_local_version {
     my ($script) = @_;
-    no strict 'refs';
-    return unless  %{ "Irssi::Script::${script}::" };
-    my $version = ${ "Irssi::Script::${script}::VERSION" };
-    return $version;
+    my $pname = (get_names($script))[2];
+    return unless exists $Irssi::Script::{$pname};
+    my $vref = $Irssi::Script::{$pname}{VERSION};
+    return $vref ? $$vref : undef;
 }
 
-sub compare_versions ($$) {
+sub compare_versions {
     my ($ver1, $ver2) = @_;
-    my @ver1 = split /\./, $ver1;
-    my @ver2 = split /\./, $ver2;
-    #if (scalar(@ver2) != scalar(@ver1)) {
-    #    return 0;
-    #}       
+    for ($ver1, $ver2) {
+	$_ = "0:$_" unless /:/;
+    }
+    my @ver1 = split /[.:]/, $ver1;
+    my @ver2 = split /[.:]/, $ver2;
     my $cmp = 0;
     ### Special thanks to Clemens Heidinger
+    no warnings 'uninitialized';
     $cmp ||= $ver1[$_] <=> $ver2[$_] || $ver1[$_] cmp $ver2[$_] for 0..scalar(@ver2);
     return 'newer' if $cmp == 1;
     return 'older' if $cmp == -1;
@@ -875,24 +924,20 @@ sub compare_versions ($$) {
 }
 
 sub loaded_scripts {
-    no strict 'refs';
     my @modules;
     foreach (sort grep(s/::$//, keys %Irssi::Script::)) {
-        #my $name    = ${ "Irssi::Script::${_}::IRSSI" }{name};
-        #my $version = ${ "Irssi::Script::${_}::VERSION" };
-	push @modules, $_;# if $name && $version;
+	push @modules, $_;
     }
     return \@modules;
-
 }
 
 sub check_scripts {
     my ($data) = @_;
     my %versions;
-    #$versions{-foo} = 1;
     foreach (@{loaded_scripts()}) {
-        my $remote = get_remote_version($_, $data);
-        my $local =  get_local_version($_);
+	my ($sname) = get_names($_, $data);
+	my $remote = get_remote_version($sname, $data);
+	my $local = get_local_version($sname);
 	my $state;
 	if ($local && $remote) {
 	    $state = compare_versions($local, $remote);
@@ -905,51 +950,50 @@ sub check_scripts {
 	    $remote = '/';
 	}
 	if ($state) {
-	    $versions{$_}{state} = $state;
-	    $versions{$_}{remote} = $remote;
-	    $versions{$_}{local} = $local;
+	    $versions{$sname}{state} = $state;
+	    $versions{$sname}{remote} = $remote;
+	    $versions{$sname}{local} = $local;
 	}
     }
     return \%versions;
 }
 
-sub download_script ($$) {
+sub download_script {
     my ($script, $xml) = @_;
+    my ($sname, $plname) = get_names($script, $xml);
     my %result;
-    my $site = $xml->{$script.".pl"}{source};
+    my $site = $xml->{$plname}{source};
     $result{installed} = 0;
     $result{signed} = 0;
     my $dir = Irssi::get_irssi_dir();
     my $ua = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1,timeout => 30);
-    $ua->agent('ScriptAssist/'.$VERSION);
+    $ua->agent('ScriptAssist/'.2003020803);
     my $request = HTTP::Request->new('GET', $site.'/scripts/'.$script.'.pl');
     my $response = $ua->request($request);
     if ($response->is_success()) {
 	my $file = $response->content();
 	mkdir $dir.'/scripts/' unless (-e $dir.'/scripts/');
-	local *F;
-	open(F, '>'.$dir.'/scripts/'.$script.'.pl.new');
-	print F $file;
-	close(F);
+	open(my $F, '>', $dir.'/scripts/'.$plname.'.new');
+	print $F $file;
+	close($F);
 	if ($have_gpg && Irssi::settings_get_bool('scriptassist_use_gpg')) {
 	    my $ua2 = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1,timeout => 30);
-	    $ua->agent('ScriptAssist/'.$VERSION);
-	    my $request2 = HTTP::Request->new('GET', $site.'/signatures/'.$script.'.pl.asc');
+	    $ua->agent('ScriptAssist/'.2003020803);
+	    my $request2 = HTTP::Request->new('GET', $site.'/signatures/'.$plname.'.asc');
 	    my $response2 = $ua->request($request2);
 	    if ($response2->is_success()) {
-		local *S;
 		my $sig_dir = $dir.'/scripts/signatures/';
 		mkdir $sig_dir unless (-e $sig_dir);
-		open(S, '>'.$sig_dir.$script.'.pl.asc');
+		open(my $S, '>', $sig_dir.$plname.'.asc');
 		my $file2 = $response2->content();
-		print S $file2;
-		close(S);
+		print $S $file2;
+		close($S);
 		my $sig;
 		foreach (1..2) {
 		    # FIXME gpg needs two rounds to load the key
 		    my $gpg = new GnuPG();
 		    eval {
-			$sig = $gpg->verify( file => $dir.'/scripts/'.$script.'.pl.new', signature => $sig_dir.$script.'.pl.asc' );
+			$sig = $gpg->verify( file => $dir.'/scripts/'.$plname.'.new', signature => $sig_dir.$plname.'.asc' );
 		    };
 		}
 		if (defined $sig->{user}) {
@@ -975,13 +1019,13 @@ sub download_script ($$) {
     if ($result{installed}) {
 	my $old_dir = "$dir/scripts/old/";
 	mkdir $old_dir unless (-e $old_dir);
-	rename "$dir/scripts/$script.pl", "$old_dir/$script.pl.old" if -e "$dir/scripts/$script.pl";
-	rename "$dir/scripts/$script.pl.new", "$dir/scripts/$script.pl";
+	rename "$dir/scripts/$plname", "$old_dir/$plname.old" if -e "$dir/scripts/$plname";
+	rename "$dir/scripts/$plname.new", "$dir/scripts/$plname";
     }
     return \%result;
 }
 
-sub print_check (%) {
+sub print_check {
     my (%data) = @_;
     my $text;
     my @table;
@@ -1001,28 +1045,29 @@ sub print_check (%) {
     print CLIENTCRAP draw_box('ScriptAssist', $text, 'check', 1) ;
 }
 
-sub toggle_autorun ($) {
+sub toggle_autorun {
     my ($script) = @_;
+    my ($sname, $plname) = get_names($script);
     my $dir = Irssi::get_irssi_dir()."/scripts/";
     mkdir $dir."autorun/" unless (-e $dir."autorun/");
-    return unless (-e $dir.$script.".pl");
-    if (check_autorun($script)) {
-	if (readlink($dir."/autorun/".$script.".pl") eq "../".$script.".pl") {
-	    if (unlink($dir."/autorun/".$script.".pl")) {
-		print CLIENTCRAP "%R>>%n Autorun of ".$script." disabled";
+    return unless (-e $dir.$plname);
+    if (check_autorun($sname)) {
+	if (readlink($dir."/autorun/".$plname) eq "../".$plname) {
+	    if (unlink($dir."/autorun/".$plname)) {
+		print CLIENTCRAP "%R>>%n Autorun of ".$sname." disabled";
 	    } else {
 		print CLIENTCRAP "%R>>%n Unable to delete link";
 	    }
 	} else {
-	    print CLIENTCRAP "%R>>%n ".$dir."/autorun/".$script.".pl is not a correct link";
+	    print CLIENTCRAP "%R>>%n ".$dir."/autorun/".$plname." is not a correct link";
 	}
     } else {
-	symlink("../".$script.".pl", $dir."/autorun/".$script.".pl");
-    	print CLIENTCRAP "%R>>%n Autorun of ".$script." enabled";
+	symlink("../".$plname, $dir."/autorun/".$plname);
+    	print CLIENTCRAP "%R>>%n Autorun of ".$sname." enabled";
     }
 }
 
-sub sig_script_error ($$) {
+sub sig_script_error {
     my ($script, $msg) = @_;
     return unless Irssi::settings_get_bool('scriptassist_catch_script_errors');
     if ($msg =~ /Can't locate (.*?)\.pm in \@INC \(\@INC contains:(.*?) at/) {
@@ -1032,7 +1077,7 @@ sub sig_script_error ($$) {
     }
 }
 
-sub missing_module ($$) {
+sub missing_module {
     my ($module) = @_;
     my $text;
     $text .= "The perl module %9".$module."%9 is missing on your system.\n";
@@ -1041,7 +1086,7 @@ sub missing_module ($$) {
     print CLIENTCRAP &draw_box('ScriptAssist', $text, $module, 1);
 }
 
-sub cmd_scripassist ($$$) {
+sub cmd_scripassist {
     my ($arg, $server, $witem) = @_;
     my @args = split(/ /, $arg);
     if ($args[0] eq 'help' || $args[0] eq '-h') {
@@ -1083,27 +1128,34 @@ sub cmd_scripassist ($$$) {
     }
 }
 
-sub sig_command_script_load ($$$) {
+sub cmd_help {
+    my ($arg, $server, $witem) = @_;
+    $arg =~ s/\s+$//;
+    if ($arg =~ /^scriptassist/i) {
+	show_help();
+    }
+}
+
+sub sig_command_script_load {
     my ($script, $server, $witem) = @_;
-    no strict;
-    $script = $2 if $script =~ /(.*\/)?(.*?)\.pl$/;
-    if ( %{ "Irssi::Script::${script}::" }) {
-	if (defined &{ "Irssi::Script::${script}::pre_unload" }) {
+    my ($sname, $plname, $pname, $xname) = get_names($script);
+    if ( exists $Irssi::Script::{$pname} ) {
+	if (my $code = "Irssi::Script::${pname}"->can('pre_unload')) {
 	    print CLIENTCRAP "%R>>%n Triggering pre_unload function of $script...";
-	    &{ "Irssi::Script::${script}::pre_unload" }();
+	    $code->();
 	}
     }
 }
 
-sub sig_default_command ($$) {
+sub sig_default_command {
     my ($cmd, $server) = @_;
     return unless Irssi::settings_get_bool("scriptassist_check_unknown_commands");
     bg_do('unknown '.$cmd);
 }
 
-sub sig_complete ($$$$$) {
+sub sig_complete {
     my ($list, $window, $word, $linestart, $want_space) = @_;
-    return unless $linestart =~ /^.script(assist)? (install|rate|ratings|update|check|contact|info|autorun)/;
+    return unless $linestart =~ /^.script(assist)? (install|rate|ratings|update|check|contact|info|autorun)/i;
     my @newlist;
     my $str = $word;
     foreach (@complist) {
@@ -1114,13 +1166,12 @@ sub sig_complete ($$$$$) {
     foreach (@{loaded_scripts()}) {
 	push @newlist, $_ if /^(\Q$str\E.*)?$/;
     }
-    $want_space = 0;
     push @$list, $_ foreach @newlist;
     Irssi::signal_stop();
 }
 
 
-Irssi::settings_add_str($IRSSI{name}, 'scriptassist_script_sources', 'http://scripts.irssi.org/scripts.dmp');
+Irssi::settings_add_str($IRSSI{name}, 'scriptassist_script_sources', 'https://scripts.irssi.org/scripts.dmp');
 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_cache_sources', 1);
 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_update_verbose', 1);
 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_check_verbose', 1);
@@ -1131,24 +1182,37 @@ Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_use_gpg', 1);
 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_integrate', 1);
 Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_check_unknown_commands', 1);
 
-Irssi::signal_add_first("default command", \&sig_default_command);
-Irssi::signal_add_first('complete word', \&sig_complete);
-Irssi::signal_add_first('command script load', \&sig_command_script_load);
-Irssi::signal_add_first('command script unload', \&sig_command_script_load);
+Irssi::signal_add_first("default command", 'sig_default_command');
+Irssi::signal_add_first('complete word', 'sig_complete');
+Irssi::signal_add_first('command script load', 'sig_command_script_load');
+Irssi::signal_add_first('command script unload', 'sig_command_script_load');
 
-if (defined &Irssi::signal_register) {
-    Irssi::signal_register({ 'script error' => [ 'Irssi::Script', 'string' ] });
-    Irssi::signal_add_last('script error', \&sig_script_error);
-}
+Irssi::signal_register({ 'script error' => [ 'Irssi::Script', 'string' ] });
+Irssi::signal_add_last('script error', 'sig_script_error');
 
-Irssi::command_bind('scriptassist', \&cmd_scripassist);
+Irssi::command_bind('scriptassist', 'cmd_scripassist');
+Irssi::command_bind('help', 'cmd_help');
 
 Irssi::theme_register(['box_header', '%R,--[%n$*%R]%n',
 'box_inside', '%R|%n $*',
 'box_footer', '%R`--<%n$*%R>->%n',
 ]);
 
-foreach my $cmd ( ( 'check', 'install', 'update', 'contact', 'search', '-h', 'help', 'ratings', 'rate', 'info', 'echo', 'top', 'cpan', 'autorun', 'new') ) {
+foreach my $cmd ( ( 'check',
+		    'install',
+		    'update',
+		    'contact',
+		    'search',
+#		    '-h',
+		    'help',
+#		    'ratings',
+#		    'rate',
+		    'info',
+#		    'echo',
+#		    'top',
+		    'cpan',
+		    'autorun',
+		    'new' ) ) {
     Irssi::command_bind('scriptassist '.$cmd => sub {
 			cmd_scripassist("$cmd ".$_[0], $_[1], $_[2]); });
     if (Irssi::settings_get_bool('scriptassist_integrate')) {
-- 
cgit v1.2.3