1
0
mirror of https://github.com/irssi/irssi.git synced 2024-06-02 06:11:11 +00:00

sync scriptassist.pl

This commit is contained in:
ailin-nemui 2016-02-08 14:38:33 +01:00
parent 38b1121989
commit 06fdfd617e

View File

@ -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')) {