[scriptassist] update to 2020042700

- fix top/ratings/rate

diff --git a/scripts/scriptassist.pl b/scripts/scriptassist.pl
index dd461ddbef8365a705b81f92fbcf53d779c843fd..cf02d57e0408fc0e2bf1d11b042fce70e8dbe915 100644 (file)
--- a/scripts/scriptassist.pl
+++ b/scripts/scriptassist.pl
@@ -5,7 +5,7 @@
 
 use strict;
 
-our $VERSION = '2020042200';
+our $VERSION = '2020042700';
 our %IRSSI = (
     authors     => 'Stefan \'tommie\' Tomanek',
     contact     => 'stefan@pico.ruhr.de',
@@ -42,15 +42,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|all>
+    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>
+    Rate the script if you like it
+/scriptassist contact <script>
     Write an email to the author of the script
     (Requires OpenURL)
 /scriptassist cpan <module>
@@ -98,6 +98,7 @@ sub call_openurl {
        $code->($url);
     } else {
         print CLIENTCRAP "%R>>%n Please install openurl.pl";
+        print CLIENTCRAP "%R>>%n    or open < $url > manually";
     }
 }
 
@@ -277,37 +278,70 @@ sub script_info {
     return \%result;
 }
 
-sub rate_script {
-    my ($script, $stars) = @_;
+sub get_rate_url {
+    my ($src) = @_;
     my $ua = LWP::UserAgent->new(env_proxy=>1, keep_alive=>1, timeout=>30);
-    $ua->agent('ScriptAssist/'.2003020803);
-    my $request = HTTP::Request->new('GET', 'http://ratings.irssi.de/irssirate.pl?&stars='.$stars.'&mode=rate&script='.$script);
+    $ua->agent('ScriptAssist/'.$VERSION);
+    my $request = HTTP::Request->new('GET', $src);
     my $response = $ua->request($request);
-    unless ($response->is_success() && $response->content() =~ /You already rated this script/) {
-       return 1;
-    } else {
-       return 0;
+    unless ($response->is_success) {
+       my $error = join "\n", $response->status_line(), (grep / at .* line \d+/, split "\n", $response->content()), '';
+       die("Fetching ratings location failed: $error");
+    }
+    my $votes_url;
+    for my $tag ($response->content() =~ /<script([^>]*)>/g) {
+       my $attr = " $tag ";
+       ($votes_url = $1) =~ s/\.\w+$/.yml/
+           if $attr =~ /\sasync\s/ && $attr =~ m{\ssrc="(https?://.*?/votes\.\w+)"\s};
+    }
+    unless ($votes_url) {
+       die("Fetching ratings failed: Could not find votes script\n");
     }
+    $request = HTTP::Request->new('GET', $votes_url);
+    $response = $ua->request($request);
+    if (!$response->is_success) {
+       my $error = join "\n", $response->status_line(), (grep / at .* line \d+/, split "\n", $response->content()), '';
+       die("Fetching ratings failed: $error");
+    }
+    my $data = $response->content();
+    utf8::decode($data);
+    CPAN::Meta::YAML->read_string($data)->[0];
+}
+
+sub rate_script {
+    my ($script, $stars) = @_;
+    my $xml = get_scripts();
+    my $votes = get_rate_url(map { $_->{source} } values %$xml);
+    my ($sname, $plname, $pname) = get_names($script, $xml);
+    die "Script $script not found\n" unless $votes->{$plname};
+    return $votes->{$plname}{u}
 }
 
 sub get_ratings {
     my ($scripts, $limit) = @_;
-    my $ua = LWP::UserAgent->new(env_proxy=>1, keep_alive=>1, timeout=>30);
-    $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);
+    my $xml = get_scripts();
+    my $votes = get_rate_url(map { $_->{source} } values %$xml);
+    foreach (keys %{$votes}) {
+       if ($xml->{$_}) {
+           $xml->{$_}{votes} = $votes->{$_}{v};
+       }
+    }
     my %result;
-    if ($response->is_success()) {
-       foreach (split /\n/, $response->content()) {
-           if (/<tr><td><a href=".*?">(.*?)<\/a>/) {
-               my $entry = $1;
-               if (/"><\/td><td>([0-9.]+)<\/td><td>(.*?)<\/td><td>/) {
-                   $result{$entry} = [$1, $2];
-               }
-           }
+    if (@{$scripts}) {
+       foreach (@{$scripts}) {
+           my ($sname, $plname, $pname) = get_names($_, $xml);
+           next unless (defined $xml->{$plname} || ( exists $Irssi::Script::{$pname} && exists $Irssi::Script::{$pname}{IRSSI} ));
+           $result{$plname} = [$xml->{$plname}{votes}];
+       }
+    } else {
+       my @keys = sort { $xml->{$b}{votes} <=> $xml->{$a}{votes}
+                 || $xml->{$b}{modified} cmp $xml->{$a}{modified} }
+           grep { !$xml->{$_}{HIDDEN} && $xml->{$_}{votes} ne '' } keys %$xml;
+       foreach (splice @keys, 0, $limit) {
+           $result{$_} = [$xml->{$_}{votes}];
        }
     }
+    die "No such script found\n" unless keys %result;
     return \%result;
 }
 
@@ -600,13 +634,8 @@ sub print_rate {
     my (%data) = @_;
     my $line;
     foreach my $script (sort keys(%data)) {
-       if ($data{$script}) {
-            $line .= "%go%n %9".$script."%9 has been rated";
-        } else {
-            $line .= "%ro%n %9".$script."%9 : Already rated this script";
-        }
+       call_openurl($data{$script});
     }
-    print CLIENTCRAP draw_box('ScriptAssist', $line, 'rating', 1) ;
 }
 
 sub print_ratings {
@@ -620,8 +649,7 @@ sub print_ratings {
            push @line, "%yo%n";
        }
         push @line, "%9".$script."%9";
-       push @line, $data{$script}{rating};
-       push @line, "[".$data{$script}{votes}." votes]";
+       push @line, "[".(length $data{$script}{rating} ? $data{$script}{rating} : 'no')." votes]";
        push @table, \@line;
     }
     print CLIENTCRAP draw_box('ScriptAssist', array2table(@table), 'ratings', 1) ;
@@ -848,7 +876,8 @@ sub get_scripts {
        }
        $fetched = 1;
        my $data = $response->content();
-       my ($src, $type);
+       my $src = $site;
+       my $type = '';
        if ($site =~ /(.*\/).+\.(.+)/) {
            $src = $1;
            $type = $2;
@@ -1118,9 +1147,9 @@ sub cmd_scripassist {
     } elsif ($args[0] eq 'ratings' && defined $args[1]) {
        shift @args;
        bg_do("ratings ".join(' ', @args));
-    } elsif ($args[0] eq 'rate' && defined $args[1] && defined $args[2]) {
+    } elsif ($args[0] eq 'rate' && defined $args[1]) {
        shift @args;
-       bg_do("rate ".join(' ', @args)) if ($args[2] >= 0 && $args[2] < 6);
+       bg_do("rate ".join(' ', @args));
     } elsif ($args[0] eq 'info' && defined $args[1]) {
        shift @args;
        bg_do("info ".join(' ', @args));
@@ -1217,11 +1246,11 @@ foreach my $cmd ( ( 'check',
                    'search',
 #                  '-h',
                    'help',
-#                  'ratings',
-#                  'rate',
+                   'ratings',
+                   'rate',
                    'info',
 #                  'echo',
-#                  'top',
+                   'top',
                    'cpan',
                    'autorun',
                    'new' ) ) {