[scriptassist] update to 2023111700

scripts/scriptassist.pl

@@ -5,7 +5,7 @@
 
 use strict;
 
-our $VERSION = '2023091200';
+our $VERSION = '2023111700';
 our %IRSSI = (
     authors     => 'Stefan \'tommie\' Tomanek',
     contact     => '[email protected]',
@@ -29,7 +29,7 @@
 
 # GnuPG is not always needed
 $have_gpg = 0;
 eval "use GnuPG qw(:algo :trust);";
 $have_gpg = 1 if not ($@);
 
 my $irssi_version = qv('v'.Irssi::parse_special('$J') =~ s/[^.\d].*//r);
@@ -96,7 +96,7 @@
 sub call_openurl {
     my ($url) = @_;
     # check for a loaded openurl
     if (my $code = Irssi::Script::openurl::->can('launch_url')) {
 	$code->($url);
     } else {
         print CLIENTCRAP "%R>>%n Please install openurl.pl";
@@ -116,7 +116,7 @@
     $forked = 1;
     if ($pid > 0) {
 	print CLIENTCRAP "%R>>%n Please wait...";
         close $wh;
         Irssi::pidwait_add($pid);
         my $pipetag;
         my @args = ($rh, \$pipetag, $func);
@@ -184,7 +184,7 @@
 	    print($wh CPAN::Meta::YAML->new(+{data=>+{error=>$@}})
 		      ->write_string());
 	}
 	close($wh);
 	POSIX::_exit(1);
     }
 }
@@ -216,7 +216,7 @@
 	my $dir = Irssi::get_irssi_dir()."/scripts/";
 	if ($db && exists $db->{$plname}) {
 	    # $found = 1;
 	} elsif (-e $dir.$plname || -e $dir."autorun/".$plname) {
 	    # $found = 1;
 	} else {
 	    # not found
@@ -327,7 +327,7 @@
 	    my $modules = $n->{db}{modules};
 	    foreach my $mod (split(/ /, $modules)) {
 		my $opt = ($mod =~ /\((.*)\)/)? 1 : 0;
 		$mod = $1 if $1;
 		$r{modules}{$mod}{optional} = $opt;
 		$r{modules}{$mod}{installed} = module_exist($mod);
 	    }
@@ -335,7 +335,7 @@
 	    my $modules = $n->{irssi}{modules};
 	    foreach my $mod (split(/ /, $modules)) {
 		my $opt = ($mod =~ /\((.*)\)/)? 1 : 0;
 		$mod = $1 if $1;
 		$r{modules}{$mod}{optional} = $opt;
 		$r{modules}{$mod}{installed} = module_exist($mod);
 	    }
@@ -356,6 +356,8 @@
 
 sub get_rate_url {
     my ($src) = @_;
+    if (ref $src) { ($src) = grep { $_ } map { $_->{source} } values %$src; }
+    die("No script source address found\n") unless $src;
     my $ua = LWP::UserAgent->new(env_proxy=>1, keep_alive=>1, timeout=>30);
     $ua->agent('ScriptAssist/'.$VERSION);
     my $request = HTTP::Request->new('GET', $src);
@@ -364,6 +366,9 @@
 	my $error = join "\n", $response->status_line(), (grep / at .* line \d+/, split "\n", $response->content()), '';
 	die("Fetching ratings location failed: $error");
     }
+    if (my $error = $response->header('X-Died')) {
+	die("$error\n");
+    }
     my $votes_url;
     for my $tag ($response->content() =~ /<script([^>]*)>/g) {
 	my $attr = " $tag ";
@@ -375,7 +380,7 @@
     }
     $request = HTTP::Request->new('GET', $votes_url);
     $response = $ua->request($request);
-    if (!$response->is_success) {
+    if (!$response->is_success || $response->header('X-Died')) {
 	my $error = join "\n", $response->status_line(), (grep / at .* line \d+/, split "\n", $response->content()), '';
 	die("Fetching ratings failed: $error");
     }
@@ -387,7 +392,7 @@
 sub rate_script {
     my ($script, $stars) = @_;
     my $xml = get_scripts();
-    my $votes = get_rate_url(map { $_->{source} } values %$xml);
+    my $votes = get_rate_url($xml);
     my $n = get_names($script, $xml, $votes);
     die "Script $script not found\n" unless $n->{votes};
     return $n->{votes}{u}
@@ -396,7 +401,7 @@
 sub get_ratings {
     my ($scripts, $limit) = @_;
     my $xml = get_scripts();
-    my $votes = get_rate_url(map { $_->{source} } values %$xml);
+    my $votes = get_rate_url($xml);
     foreach (keys %{$votes}) {
 	if ($xml->{$_}) {
 	    $xml->{$_}{votes} = $votes->{$_}{v};
@@ -968,6 +973,10 @@
 	    $error = join "\n", $response->status_line(), (grep / at .* line \d+/, split "\n", $response->content()), '';
 	    next;
 	}
+	if (my $died = $response->header('X-Died')) {
+	    $error = $died;
+	    next;
+	}
 	$fetched = 1;
 	my $data = $response->content();
 	my $src = $site;
@@ -1117,7 +1126,7 @@
     $ua->agent('ScriptAssist/'.2003020803);
     my $request = HTTP::Request->new('GET', $site.'/scripts/'.$n->{plname});
     my $response = $ua->request($request);
-    if ($response->is_success()) {
+    if ($response->is_success() && !$response->header('X-Died')) {
 	my $file = $response->content();
 	mkdir $dir.'/scripts/' unless (-e $dir.'/scripts/');
 	open(my $f, '>', $dir.'/scripts/'.$n->{plname}.'.new');
@@ -1128,7 +1137,7 @@
 	    $ua->agent('ScriptAssist/'.2003020803);
 	    my $request2 = HTTP::Request->new('GET', $site.'/signatures/'.$n->{plname}.'.asc');
 	    my $response2 = $ua->request($request2);
-	    if ($response2->is_success()) {
+	    if ($response2->is_success() && !$response->header('X-Died')) {
 		my $sig_dir = $dir.'/scripts/signatures/';
 		mkdir $sig_dir unless (-e $sig_dir);
 		open(my $s, '>', $sig_dir.$n->{plname}.'.asc');