mirror of
https://github.com/irssi/irssi.git
synced 2024-11-03 04:27:19 -05:00
1266 lines
38 KiB
Prolog
1266 lines
38 KiB
Prolog
# by Stefan "tommie" Tomanek
|
|
#
|
|
# scriptassist.pl
|
|
|
|
|
|
use strict;
|
|
|
|
our $VERSION = '2020042700';
|
|
our %IRSSI = (
|
|
authors => 'Stefan \'tommie\' Tomanek',
|
|
contact => 'stefan@pico.ruhr.de',
|
|
name => 'scriptassist',
|
|
description => 'keeps your scripts on the cutting edge',
|
|
license => 'GPLv2',
|
|
url => 'https://scripts.irssi.org/',
|
|
modules => 'CPAN::Meta::YAML LWP::Protocol::https (GnuPG)',
|
|
commands => "scriptassist"
|
|
);
|
|
|
|
our ($forked, %remote_db, $have_gpg, @complist);
|
|
|
|
use Irssi 20020324;
|
|
use CPAN::Meta::YAML;
|
|
use LWP::UserAgent;
|
|
use POSIX;
|
|
use version;
|
|
|
|
# GnuPG is not always needed
|
|
$have_gpg = 0;
|
|
eval "use GnuPG qw(:algo :trust);";
|
|
$have_gpg = 1 if not ($@);
|
|
|
|
my $irssi_version = qv(Irssi::parse_special('v$J') =~ s/-.*//r);
|
|
|
|
sub show_help {
|
|
my $help = "scriptassist $VERSION
|
|
/scriptassist check
|
|
Check all loaded scripts for new available versions
|
|
/scriptassist update <script|all>
|
|
Update the selected or all script to the newest version
|
|
/scriptassist search <query>
|
|
Search the script database
|
|
/scriptassist info <scripts>
|
|
Display information about <scripts>
|
|
/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>
|
|
Rate the script if you like it
|
|
/scriptassist contact <script>
|
|
Write an email to the author of the script
|
|
(Requires OpenURL)
|
|
/scriptassist cpan <module>
|
|
Visit CPAN to look for missing Perl modules
|
|
(Requires OpenURL)
|
|
/scriptassist install <script>
|
|
Retrieve and load the script
|
|
/scriptassist autorun <script>
|
|
Toggles automatic loading of <script>
|
|
";
|
|
my $text='';
|
|
foreach (split(/\n/, $help)) {
|
|
$_ =~ s/^\/(.*)$/%9\/$1%9/;
|
|
$text .= $_."\n";
|
|
}
|
|
print CLIENTCRAP &draw_box("ScriptAssist", $text, "scriptassist help", 1);
|
|
#theme_box("ScriptAssist", $text, "scriptassist help", 1);
|
|
}
|
|
|
|
sub theme_box {
|
|
my ($title, $text, $footer, $colour) = @_;
|
|
Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'box_header', $title);
|
|
foreach (split(/\n/, $text)) {
|
|
Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'box_inside', $_);
|
|
}
|
|
Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'box_footer', $footer);
|
|
}
|
|
|
|
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 =~ s/%.//g unless $colour;
|
|
return $box;
|
|
}
|
|
|
|
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";
|
|
print CLIENTCRAP "%R>>%n or open < $url > manually";
|
|
}
|
|
}
|
|
|
|
sub bg_do {
|
|
my ($func) = @_;
|
|
my ($rh, $wh);
|
|
pipe($rh, $wh);
|
|
if ($forked) {
|
|
print CLIENTCRAP "%R>>%n Please wait until your earlier request has been finished.";
|
|
return;
|
|
}
|
|
my $pid = fork();
|
|
$forked = 1;
|
|
if ($pid > 0) {
|
|
print CLIENTCRAP "%R>>%n Please wait...";
|
|
close $wh;
|
|
Irssi::pidwait_add($pid);
|
|
my $pipetag;
|
|
my @args = ($rh, \$pipetag, $func);
|
|
$pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
|
|
} else {
|
|
eval {
|
|
my @items = split(/ /, $func);
|
|
my %result;
|
|
my $ts1 = $remote_db{timestamp};
|
|
my $xml = get_scripts();
|
|
my $ts2 = $remote_db{timestamp};
|
|
if (not($ts1 eq $ts2) && Irssi::settings_get_bool('scriptassist_cache_sources')) {
|
|
$result{db} = $remote_db{db};
|
|
$result{timestamp} = $remote_db{timestamp};
|
|
}
|
|
if ($items[0] eq 'check') {
|
|
$result{data}{check} = check_scripts($xml);
|
|
} elsif ($items[0] eq 'update') {
|
|
shift(@items);
|
|
$result{data}{update} = update_scripts(\@items, $xml);
|
|
} elsif ($items[0] eq 'search') {
|
|
shift(@items);
|
|
foreach (@items) {
|
|
$result{data}{search}{$_} = search_scripts($_, $xml);
|
|
}
|
|
} elsif ($items[0] eq 'install') {
|
|
shift(@items);
|
|
$result{data}{install} = install_scripts(\@items, $xml);
|
|
} elsif ($items[0] eq 'debug') {
|
|
shift(@items);
|
|
$result{data}{debug} = debug_scripts(\@items);
|
|
} elsif ($items[0] eq 'ratings') {
|
|
shift(@items);
|
|
@items = @{ loaded_scripts() } if $items[0] eq "all";
|
|
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}{$items[1]} = rate_script($items[1], $items[2]);
|
|
} elsif ($items[0] eq 'info') {
|
|
shift(@items);
|
|
$result{data}{info} = script_info(\@items);
|
|
} elsif ($items[0] eq 'echo') {
|
|
$result{data}{echo} = 1;
|
|
} elsif ($items[0] eq 'top') {
|
|
my %ratings = %{ get_ratings([], $items[1]) };
|
|
foreach (keys %ratings) {
|
|
$result{data}{rating}{$_}{rating} = $ratings{$_}->[0];
|
|
$result{data}{rating}{$_}{votes} = $ratings{$_}->[1];
|
|
}
|
|
} elsif ($items[0] eq 'new') {
|
|
my $new = get_new($items[1]);
|
|
$result{data}{new} = $new;
|
|
} elsif ($items[0] eq 'unknown') {
|
|
my $cmd = $items[1];
|
|
$result{data}{unknown}{$cmd} = get_unknown($cmd, $xml);
|
|
}
|
|
my $yaml = CPAN::Meta::YAML->new(\%result);
|
|
my $data = $yaml->write_string();
|
|
print($wh $data);
|
|
};
|
|
if ($@) {
|
|
print($wh CPAN::Meta::YAML->new(+{data=>+{error=>$@}})
|
|
->write_string());
|
|
}
|
|
close($wh);
|
|
POSIX::_exit(1);
|
|
}
|
|
}
|
|
|
|
sub get_unknown {
|
|
my ($cmd, $db) = @_;
|
|
foreach (keys %$db) {
|
|
next unless defined $db->{$_}{commands};
|
|
foreach my $item (split / /, $db->{$_}{commands}) {
|
|
return { $_ => +{%{$db->{$_}}} } if ($item =~ /^$cmd$/i);
|
|
}
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
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) = @_;
|
|
my %result;
|
|
my $xml = get_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{$sname}{version} = get_remote_version($sname, $xml);
|
|
my @headers = ('authors', 'contact', 'description', 'license', 'source');
|
|
foreach my $entry (@headers) {
|
|
$result{$sname}{$entry} = $Irssi::Script::{$pname}{IRSSI}{$entry};
|
|
if (defined $xml->{$plname}{$entry}) {
|
|
$result{$sname}{$entry} = $xml->{$plname}{$entry};
|
|
}
|
|
}
|
|
if ($xml->{$plname}{signature_available}) {
|
|
$result{$sname}{signature_available} = 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{$sname}{modules}{$mod}{optional} = $opt;
|
|
$result{$sname}{modules}{$mod}{installed} = module_exist($mod);
|
|
}
|
|
} 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{$sname}{modules}{$mod}{optional} = $opt;
|
|
$result{$sname}{modules}{$mod}{installed} = module_exist($mod);
|
|
}
|
|
}
|
|
# if (defined $xml->{$plname}{depends}) {
|
|
# my $depends = $xml->{$plname}{depends};
|
|
# foreach my $dep (split(/ /, $depends)) {
|
|
# $result{$sname}{depends}{$dep}{installed} = 1; #(defined ${ 'Irssi::Script::'.$dep });
|
|
# }
|
|
# }
|
|
}
|
|
return \%result;
|
|
}
|
|
|
|
sub get_rate_url {
|
|
my ($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);
|
|
my $response = $ua->request($request);
|
|
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 $xml = get_scripts();
|
|
my $votes = get_rate_url(map { $_->{source} } values %$xml);
|
|
foreach (keys %{$votes}) {
|
|
if ($xml->{$_}) {
|
|
$xml->{$_}{votes} = $votes->{$_}{v};
|
|
}
|
|
}
|
|
my %result;
|
|
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;
|
|
}
|
|
|
|
sub get_new {
|
|
my ($num) = @_;
|
|
my $result;
|
|
my $xml = get_scripts();
|
|
foreach (sort {$xml->{$b}{modified} cmp $xml->{$a}{modified}} keys %$xml) {
|
|
my %entry = %{ $xml->{$_} };
|
|
next if $entry{HIDDEN};
|
|
$result->{$_} = \%entry;
|
|
$num--;
|
|
last unless $num;
|
|
}
|
|
return $result;
|
|
}
|
|
sub module_exist {
|
|
my ($module) = @_;
|
|
$module =~ s/::/\//g;
|
|
foreach (@INC) {
|
|
return 1 if (-e $_."/".$module.".pm");
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub debug_scripts {
|
|
my ($scripts) = @_;
|
|
my %result;
|
|
my $xml = get_scripts();
|
|
foreach (@{$scripts}) {
|
|
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{$sname}{$mod}{optional} = $opt;
|
|
$result{$sname}{$mod}{installed} = module_exist($mod);
|
|
}
|
|
}
|
|
}
|
|
return(\%result);
|
|
}
|
|
|
|
sub install_scripts {
|
|
my ($scripts, $xml) = @_;
|
|
my %success;
|
|
my $dir = Irssi::get_irssi_dir()."/scripts/";
|
|
foreach (@{$scripts}) {
|
|
my ($sname, $plname, $pname) = get_names($_, $xml);
|
|
if (get_local_version($sname) && (-e $dir.$plname)) {
|
|
$success{$sname}{installed} = -2;
|
|
} else {
|
|
$success{$sname} = download_script($sname, $xml);
|
|
}
|
|
}
|
|
return \%success;
|
|
}
|
|
|
|
sub update_scripts {
|
|
my ($list, $database) = @_;
|
|
$list = loaded_scripts() if ($list->[0] eq "all" || scalar(@$list) == 0);
|
|
my %status;
|
|
foreach (@{$list}) {
|
|
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{$sname} = download_script($sname, $database);
|
|
} else {
|
|
$status{$sname}{installed} = -2;
|
|
}
|
|
$status{$sname}{remote} = $remote;
|
|
$status{$sname}{local} = $local;
|
|
}
|
|
return \%status;
|
|
}
|
|
|
|
sub search_scripts {
|
|
my ($query, $database) = @_;
|
|
$query =~ s/\.pl\Z//;
|
|
my %result;
|
|
foreach (sort keys %{$database}) {
|
|
my %entry = %{$database->{$_}};
|
|
next if $entry{HIDDEN};
|
|
my $string = $_." ";
|
|
$string .= $entry{description} if defined $entry{description};
|
|
if ($string =~ /$query/i) {
|
|
my $name = $_;
|
|
$name =~ s/\.pl$//;
|
|
if (defined $entry{description}) {
|
|
$result{$name}{desc} = $entry{description};
|
|
} else {
|
|
$result{$name}{desc} = "";
|
|
}
|
|
if (defined $entry{authors}) {
|
|
$result{$name}{authors} = $entry{authors};
|
|
} else {
|
|
$result{$name}{authors} = "";
|
|
}
|
|
if (get_local_version($name)) {
|
|
$result{$name}{installed} = 1;
|
|
} else {
|
|
$result{$name}{installed} = 0;
|
|
}
|
|
}
|
|
}
|
|
return \%result;
|
|
}
|
|
|
|
sub pipe_input {
|
|
my ($rh, $pipetag) = @{$_[0]};
|
|
my $text = do { local $/; <$rh>; };
|
|
close($rh);
|
|
Irssi::input_remove($$pipetag);
|
|
$forked = 0;
|
|
unless ($text) {
|
|
print CLIENTCRAP "%R<<%n Something weird happend (no text)";
|
|
return();
|
|
}
|
|
utf8::decode($text);
|
|
my $incoming = CPAN::Meta::YAML->read_string($text)->[0];
|
|
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 (no data)";
|
|
return;
|
|
}
|
|
my %result = %{ $incoming->{data} };
|
|
@complist = ();
|
|
if (defined $result{new}) {
|
|
print_new($result{new});
|
|
push @complist, $_ foreach keys %{ $result{new} };
|
|
}
|
|
if (defined $result{check}) {
|
|
print_check(%{$result{check}});
|
|
push @complist, $_ foreach keys %{ $result{check} };
|
|
}
|
|
if (defined $result{update}) {
|
|
print_update(%{ $result{update} });
|
|
push @complist, $_ foreach keys %{ $result{update} };
|
|
}
|
|
if (defined $result{search}) {
|
|
foreach (keys %{$result{search}}) {
|
|
print_search($_, %{$result{search}{$_}});
|
|
push @complist, keys(%{$result{search}{$_}});
|
|
}
|
|
}
|
|
if (defined $result{install}) {
|
|
print_install(%{ $result{install} });
|
|
push @complist, $_ foreach keys %{ $result{install} };
|
|
}
|
|
if (defined $result{debug}) {
|
|
print_debug(%{ $result{debug} });
|
|
}
|
|
if (defined $result{rating}) {
|
|
print_ratings(%{ $result{rating} });
|
|
push @complist, $_ foreach keys %{ $result{rating} };
|
|
}
|
|
if (defined $result{rate}) {
|
|
print_rate(%{ $result{rate} });
|
|
}
|
|
if (defined $result{info}) {
|
|
print_info(%{ $result{info} });
|
|
}
|
|
if (defined $result{echo}) {
|
|
Irssi::print "ECHO";
|
|
}
|
|
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 {
|
|
my ($data) = @_;
|
|
foreach my $cmd (keys %$data) {
|
|
print CLIENTCRAP "%R<<%n No script provides '/$cmd'" unless $data->{$cmd};
|
|
foreach (keys %{ $data->{$cmd} }) {
|
|
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) = get_names($_);
|
|
$text .= " %U/script install ".$name."%U ";
|
|
my $output = draw_box("ScriptAssist", $text, "'".$_."' missing", 1);
|
|
print CLIENTCRAP $output;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub check_autorun {
|
|
my ($script) = @_;
|
|
my (undef, $plname) = get_names($script);
|
|
my $dir = Irssi::get_irssi_dir()."/scripts/";
|
|
if (-e $dir."/autorun/".$plname) {
|
|
if (readlink($dir."/autorun/".$plname) eq "../".$plname) {
|
|
return 1;
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub array2table {
|
|
my (@array) = @_;
|
|
my @width;
|
|
foreach my $line (@array) {
|
|
for (0..scalar(@$line)-1) {
|
|
my $l = $line->[$_];
|
|
$l =~ s/%[^%]//g;
|
|
$l =~ s/%%/%/g;
|
|
$width[$_] = length($l) if $width[$_]<length($l);
|
|
}
|
|
}
|
|
my $text;
|
|
foreach my $line (@array) {
|
|
for (0..scalar(@$line)-1) {
|
|
my $l = $line->[$_];
|
|
$text .= $line->[$_];
|
|
$l =~ s/%[^%]//g;
|
|
$l =~ s/%%/%/g;
|
|
$text .= " "x($width[$_]-length($l)+1) unless ($_ == scalar(@$line)-1);
|
|
}
|
|
$text .= "\n";
|
|
}
|
|
return $text;
|
|
}
|
|
|
|
|
|
sub print_info {
|
|
my (%data) = @_;
|
|
my $line;
|
|
foreach my $script (sort keys(%data)) {
|
|
my ($local, $autorun);
|
|
if (get_local_version($script)) {
|
|
$line .= "%go%n ";
|
|
$local = get_local_version($script);
|
|
} else {
|
|
$line .= "%ro%n ";
|
|
$local = undef;
|
|
}
|
|
if (defined $local || check_autorun($script)) {
|
|
$autorun = "no";
|
|
$autorun = "yes" if check_autorun($script);
|
|
} else {
|
|
$autorun = undef;
|
|
}
|
|
$line .= "%9".$script."%9\n";
|
|
$line .= " Version : ".$data{$script}{version}."\n";
|
|
$line .= " Source : ".$data{$script}{source}."\n";
|
|
$line .= " Installed : ".$local."\n" if defined $local;
|
|
$line .= " Autorun : ".$autorun."\n" if defined $autorun;
|
|
$line .= " Authors : ".$data{$script}{authors};
|
|
$line .= " %Go-m signed%n" if $data{$script}{signature_available};
|
|
$line .= "\n";
|
|
$line .= " Contact : ".$data{$script}{contact}."\n";
|
|
$line .= " Description: ".$data{$script}{description}."\n";
|
|
$line .= "\n" if $data{$script}{modules};
|
|
$line .= " Needed Perl modules:\n" if $data{$script}{modules};
|
|
|
|
foreach (sort keys %{$data{$script}{modules}}) {
|
|
if ( $data{$script}{modules}{$_}{installed} == 1 ) {
|
|
$line .= " %g->%n ".$_." (found)";
|
|
} else {
|
|
$line .= " %r->%n ".$_." (not found)";
|
|
}
|
|
$line .= " <optional>" if $data{$script}{modules}{$_}{optional};
|
|
$line .= "\n";
|
|
}
|
|
$line .= " Needed Irssi Scripts:\n" if $data{$script}{depends};
|
|
foreach (sort keys %{$data{$script}{depends}}) {
|
|
if ( $data{$script}{depends}{$_}{installed} == 1 ) {
|
|
$line .= " %g->%n ".$_." (loaded)";
|
|
} else {
|
|
$line .= " %r->%n ".$_." (not loaded)";
|
|
}
|
|
$line .= "\n";
|
|
}
|
|
}
|
|
print CLIENTCRAP draw_box('ScriptAssist', $line, 'info', 1) ;
|
|
}
|
|
|
|
sub print_rate {
|
|
my (%data) = @_;
|
|
my $line;
|
|
foreach my $script (sort keys(%data)) {
|
|
call_openurl($data{$script});
|
|
}
|
|
}
|
|
|
|
sub print_ratings {
|
|
my (%data) = @_;
|
|
my @table;
|
|
foreach my $script (sort {$data{$b}{rating}<=>$data{$a}{rating}} keys(%data)) {
|
|
my @line;
|
|
if (get_local_version($script)) {
|
|
push @line, "%go%n";
|
|
} else {
|
|
push @line, "%yo%n";
|
|
}
|
|
push @line, "%9".$script."%9";
|
|
push @line, "[".(length $data{$script}{rating} ? $data{$script}{rating} : 'no')." votes]";
|
|
push @table, \@line;
|
|
}
|
|
print CLIENTCRAP draw_box('ScriptAssist', array2table(@table), 'ratings', 1) ;
|
|
}
|
|
|
|
sub print_new {
|
|
my ($list) = @_;
|
|
my @table;
|
|
foreach (sort {$list->{$b}{modified} cmp $list->{$a}{modified}} keys %$list) {
|
|
my @line;
|
|
my ($name) = get_names($_);
|
|
if (get_local_version($name)) {
|
|
push @line, "%go%n";
|
|
} else {
|
|
push @line, "%yo%n";
|
|
}
|
|
push @line, "%9".$name."%9";
|
|
push @line, $list->{$_}{modified};
|
|
push @table, \@line;
|
|
}
|
|
print CLIENTCRAP draw_box('ScriptAssist', array2table(@table), 'new scripts', 1) ;
|
|
}
|
|
|
|
sub print_debug {
|
|
my (%data) = @_;
|
|
my $line;
|
|
foreach my $script (sort keys %data) {
|
|
$line .= "%ro%n %9".$script."%9 failed to load\n";
|
|
$line .= " Make sure you have the following perl modules installed:\n";
|
|
foreach (sort keys %{$data{$script}}) {
|
|
if ( $data{$script}{$_}{installed} == 1 ) {
|
|
$line .= " %g->%n ".$_." (found)";
|
|
} else {
|
|
$line .= " %r->%n ".$_." (not found)\n";
|
|
$line .= " [This module is optional]\n" if $data{$script}{$_}{optional};
|
|
$line .= " [Try /scriptassist cpan ".$_."]";
|
|
}
|
|
$line .= "\n";
|
|
}
|
|
print CLIENTCRAP draw_box('ScriptAssist', $line, 'debug', 1) ;
|
|
}
|
|
}
|
|
|
|
sub load_script {
|
|
my ($script) = @_;
|
|
Irssi::command('script load '.$script);
|
|
}
|
|
|
|
sub print_install {
|
|
my (%data) = @_;
|
|
my $text;
|
|
my ($crashed, @installed);
|
|
foreach my $script (sort keys %data) {
|
|
my $line;
|
|
if ($data{$script}{installed} == 1) {
|
|
my $hacked;
|
|
if ($have_gpg && Irssi::settings_get_bool('scriptassist_use_gpg')) {
|
|
if ($data{$script}{signed} >= 0) {
|
|
load_script($script) unless (lc($script) eq lc($IRSSI{name}));
|
|
} else {
|
|
$hacked = 1;
|
|
}
|
|
} else {
|
|
load_script($script) unless (lc($script) eq lc($IRSSI{name}));
|
|
}
|
|
if (get_local_version($script) && not lc($script) eq lc($IRSSI{name})) {
|
|
$line .= "%go%n %9".$script."%9 installed\n";
|
|
push @installed, $script;
|
|
} elsif (lc($script) eq lc($IRSSI{name})) {
|
|
$line .= "%yo%n %9".$script."%9 installed, please reload manually\n";
|
|
} else {
|
|
$line .= "%Ro%n %9".$script."%9 fetched, but unable to load\n";
|
|
$crashed .= $script." " unless $hacked;
|
|
}
|
|
if ($have_gpg && Irssi::settings_get_bool('scriptassist_use_gpg')) {
|
|
foreach (split /\n/, check_sig($data{$script})) {
|
|
$line .= " ".$_."\n";
|
|
}
|
|
}
|
|
} elsif ($data{$script}{installed} == -2) {
|
|
$line .= "%ro%n %9".$script."%9 already loaded, please try \"update\"\n";
|
|
} elsif ($data{$script}{installed} <= 0) {
|
|
$line .= "%ro%n %9".$script."%9 not installed\n";
|
|
foreach (split /\n/, check_sig($data{$script})) {
|
|
$line .= " ".$_."\n";
|
|
}
|
|
} else {
|
|
$line .= "%Ro%n %9".$script."%9 not found on server\n";
|
|
}
|
|
$text .= $line;
|
|
}
|
|
# Inspect crashed scripts
|
|
bg_do("debug ".$crashed) if $crashed;
|
|
print CLIENTCRAP draw_box('ScriptAssist', $text, 'install', 1);
|
|
list_sbitems(\@installed);
|
|
}
|
|
|
|
sub list_sbitems {
|
|
my ($scripts) = @_;
|
|
my $text;
|
|
foreach (@$scripts) {
|
|
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});
|
|
}
|
|
return unless $text;
|
|
$text .= "\n";
|
|
$text .= "Enter '/statusbar window add <item>' to add an item.";
|
|
print CLIENTCRAP draw_box('ScriptAssist', $text, 'sbitems', 1);
|
|
}
|
|
|
|
sub check_sig {
|
|
my ($sig) = @_;
|
|
my $line;
|
|
my %trust = ( -1 => 'undefined',
|
|
0 => 'never',
|
|
1 => 'marginal',
|
|
2 => 'fully',
|
|
3 => 'ultimate'
|
|
);
|
|
if ($sig->{signed} == 1) {
|
|
$line .= "Signature found from ".$sig->{sig}{user}."\n";
|
|
$line .= "Timestamp : ".$sig->{sig}{date}."\n";
|
|
$line .= "Fingerprint: ".$sig->{sig}{fingerprint}."\n";
|
|
$line .= "KeyID : ".$sig->{sig}{keyid}."\n";
|
|
$line .= "Trust : ".$trust{$sig->{sig}{trust}}."\n";
|
|
} elsif ($sig->{signed} == -1) {
|
|
$line .= "%1Warning, unable to verify signature%n\n";
|
|
} elsif ($sig->{signed} == 0) {
|
|
$line .= "%1No signature found%n\n" unless Irssi::settings_get_bool('scriptassist_install_unsigned_scripts');
|
|
}
|
|
return $line;
|
|
}
|
|
|
|
sub print_search {
|
|
my ($query, %data) = @_;
|
|
my $text;
|
|
foreach (sort keys %data) {
|
|
my $line;
|
|
$line .= "%go%n" if $data{$_}{installed};
|
|
$line .= "%yo%n" if not $data{$_}{installed};
|
|
$line .= " %9".$_."%9 ";
|
|
$line .= $data{$_}{desc};
|
|
$line =~ s/($query)/%U$1%U/gi;
|
|
$line .= ' ('.$data{$_}{authors}.')';
|
|
$text .= $line." \n";
|
|
}
|
|
print CLIENTCRAP draw_box('ScriptAssist', $text, 'search: '.$query, 1) ;
|
|
}
|
|
|
|
sub print_update {
|
|
my (%data) = @_;
|
|
my $text;
|
|
my @table;
|
|
my $verbose = Irssi::settings_get_bool('scriptassist_update_verbose');
|
|
foreach (sort keys %data) {
|
|
my $signed = 0;
|
|
if ($data{$_}{installed} == 1) {
|
|
my $local = $data{$_}{local};
|
|
my $remote = $data{$_}{remote};
|
|
push @table, ['%yo%n', '%9'.$_.'%9', 'upgraded ('.$local.'->'.$remote.')'];
|
|
foreach (split /\n/, check_sig($data{$_})) {
|
|
push @table, ['', '', $_];
|
|
}
|
|
if (lc($_) eq lc($IRSSI{name})) {
|
|
push @table, ['', '', "%R%9Please reload manually%9%n"];
|
|
} else {
|
|
load_script($_);
|
|
}
|
|
} elsif ($data{$_}{installed} == 0 || $data{$_}{installed} == -1) {
|
|
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.')'];
|
|
}
|
|
}
|
|
$text = array2table(@table);
|
|
print CLIENTCRAP draw_box('ScriptAssist', $text, 'update', 1) ;
|
|
}
|
|
|
|
sub contact_author {
|
|
my ($script) = @_;
|
|
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) if $address =~ /[\@:]/;
|
|
}
|
|
}
|
|
|
|
sub get_scripts {
|
|
my $ua = LWP::UserAgent->new(env_proxy=>1, keep_alive=>1, timeout=>30);
|
|
$ua->agent('ScriptAssist/'.$VERSION);
|
|
$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);
|
|
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 = $site;
|
|
my $type = '';
|
|
if ($site =~ /(.*\/).+\.(.+)/) {
|
|
$src = $1;
|
|
$type = $2;
|
|
}
|
|
push @sources, $src;
|
|
#my @header = ('name', 'contact', 'authors', 'description', 'version', 'modules', 'modified');
|
|
if ($type eq 'dmp') {
|
|
die("Support for $type script database has been removed. Please /set scriptassist_script_sources and change $type -> yml.\n");
|
|
} elsif ($type eq 'yml') {
|
|
utf8::decode($data);
|
|
my $new_db = CPAN::Meta::YAML->read_string($data);
|
|
foreach (@{$new_db->[0]}) {
|
|
my $K = $_->{filename};
|
|
if (defined $sites_db{script}{$K}) {
|
|
my $old = $sites_db{$K}{version};
|
|
my $new = $_->{version};
|
|
next if (compare_versions($old, $new) eq 'newer');
|
|
}
|
|
#foreach my $key (@header) {
|
|
foreach my $key (keys %$_) {
|
|
next unless defined $_->{$key};
|
|
$sites_db{$K}{$key} = $_->{$key};
|
|
}
|
|
$sites_db{$K}{source} = $src;
|
|
}
|
|
} else {
|
|
die("Unknown script database type ($type).\n");
|
|
}
|
|
}
|
|
if ($fetched) {
|
|
# Clean database
|
|
foreach (keys %{$remote_db{db}}) {
|
|
foreach my $site (@sources) {
|
|
if ($remote_db{db}{$_}{source} eq $site) {
|
|
delete $remote_db{db}{$_};
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
$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 {
|
|
my ($script, $database) = @_;
|
|
my $plname = (get_names($script, $database))[1];
|
|
return $database->{$plname}{version};
|
|
}
|
|
|
|
sub get_local_version {
|
|
my ($script) = @_;
|
|
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 {
|
|
my ($ver1, $ver2) = @_;
|
|
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;
|
|
return 'equal';
|
|
}
|
|
|
|
sub loaded_scripts {
|
|
my @modules;
|
|
foreach (sort grep(s/::$//, keys %Irssi::Script::)) {
|
|
push @modules, $_;
|
|
}
|
|
return \@modules;
|
|
}
|
|
|
|
sub check_scripts {
|
|
my ($data) = @_;
|
|
my %versions;
|
|
foreach (@{loaded_scripts()}) {
|
|
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);
|
|
} elsif ($local) {
|
|
$state = 'noversion';
|
|
$remote = '/';
|
|
} else {
|
|
$state = 'noheader';
|
|
$local = '/';
|
|
$remote = '/';
|
|
}
|
|
if ($state) {
|
|
$versions{$sname}{state} = $state;
|
|
$versions{$sname}{remote} = $remote;
|
|
$versions{$sname}{local} = $local;
|
|
}
|
|
}
|
|
return \%versions;
|
|
}
|
|
|
|
sub download_script {
|
|
my ($script, $xml) = @_;
|
|
my ($sname, $plname) = get_names($script, $xml);
|
|
my %result;
|
|
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/'.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/');
|
|
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/'.2003020803);
|
|
my $request2 = HTTP::Request->new('GET', $site.'/signatures/'.$plname.'.asc');
|
|
my $response2 = $ua->request($request2);
|
|
if ($response2->is_success()) {
|
|
my $sig_dir = $dir.'/scripts/signatures/';
|
|
mkdir $sig_dir unless (-e $sig_dir);
|
|
open(my $S, '>', $sig_dir.$plname.'.asc');
|
|
my $file2 = $response2->content();
|
|
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/'.$plname.'.new', signature => $sig_dir.$plname.'.asc' );
|
|
};
|
|
}
|
|
if (defined $sig->{user}) {
|
|
$result{installed} = 1;
|
|
$result{signed} = 1;
|
|
$result{sig}{$_} = $sig->{$_} foreach (keys %{$sig});
|
|
} else {
|
|
# Signature broken?
|
|
$result{installed} = 0;
|
|
$result{signed} = -1;
|
|
}
|
|
} else {
|
|
$result{signed} = 0;
|
|
$result{installed} = -1;
|
|
$result{installed} = 1 if Irssi::settings_get_bool('scriptassist_install_unsigned_scripts');
|
|
}
|
|
} else {
|
|
$result{signed} = 0;
|
|
$result{installed} = -1;
|
|
$result{installed} = 1 if Irssi::settings_get_bool('scriptassist_install_unsigned_scripts');
|
|
}
|
|
}
|
|
if ($result{installed}) {
|
|
my $old_dir = "$dir/scripts/old/";
|
|
mkdir $old_dir unless (-e $old_dir);
|
|
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 {
|
|
my (%data) = @_;
|
|
my $text;
|
|
my @table;
|
|
foreach (sort keys %data) {
|
|
my $state = $data{$_}{state};
|
|
my $remote = $data{$_}{remote};
|
|
my $local = $data{$_}{local};
|
|
if (Irssi::settings_get_bool('scriptassist_check_verbose')) {
|
|
push @table, ['%go%n', '%9'.$_.'%9', 'Up to date. ('.$local.')'] if $state eq 'equal';
|
|
}
|
|
push @table, ['%mo%n', '%9'.$_.'%9', "No version information available on network."] if $state eq "noversion";
|
|
push @table, ['%mo%n', '%9'.$_.'%9', 'No header in script.'] if $state eq "noheader";
|
|
push @table, ['%bo%n', '%9'.$_.'%9', "Your version is newer (".$local."->".$remote.")"] if $state eq "newer";
|
|
push @table, ['%ro%n', '%9'.$_.'%9', "A new version is available (".$local."->".$remote.")"] if $state eq "older";;
|
|
}
|
|
$text = array2table(@table);
|
|
print CLIENTCRAP draw_box('ScriptAssist', $text, 'check', 1) ;
|
|
}
|
|
|
|
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.$plname);
|
|
if (-e $dir."/autorun/".$plname) {
|
|
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/".$plname." is not a correct link";
|
|
}
|
|
} else {
|
|
if (symlink("../".$plname, $dir."/autorun/".$plname)) {
|
|
print CLIENTCRAP "%R>>%n Autorun of ".$sname." enabled";
|
|
} else {
|
|
print CLIENTCRAP "%R>>%n Unable to create autorun link";
|
|
}
|
|
}
|
|
}
|
|
|
|
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/) {
|
|
my $module = $1;
|
|
$module =~ s/\//::/g;
|
|
missing_module($module);
|
|
}
|
|
}
|
|
|
|
sub missing_module {
|
|
my ($module) = @_;
|
|
my $text;
|
|
$text .= "The perl module %9".$module."%9 is missing on your system.\n";
|
|
$text .= "Please ask your administrator about it.\n";
|
|
$text .= "You can also check CPAN via '/scriptassist cpan ".$module."'.\n";
|
|
print CLIENTCRAP &draw_box('ScriptAssist', $text, $module, 1);
|
|
}
|
|
|
|
sub cmd_scripassist {
|
|
my ($arg, $server, $witem) = @_;
|
|
utf8::decode($arg);
|
|
my @args = split(/ /, $arg);
|
|
if ($args[0] eq 'help' || $args[0] eq '-h') {
|
|
show_help();
|
|
} elsif ($args[0] eq 'check') {
|
|
bg_do("check");
|
|
} elsif ($args[0] eq 'update') {
|
|
shift @args;
|
|
bg_do("update ".join(' ', @args));
|
|
} elsif ($args[0] eq 'search' && defined $args[1]) {
|
|
shift @args;
|
|
bg_do("search ".join(" ", @args));
|
|
} elsif ($args[0] eq 'install' && defined $args[1]) {
|
|
shift @args;
|
|
bg_do("install ".join(' ', @args));
|
|
} elsif ($args[0] eq 'contact' && defined $args[1]) {
|
|
contact_author($args[1]);
|
|
} elsif ($args[0] eq 'ratings' && defined $args[1]) {
|
|
shift @args;
|
|
bg_do("ratings ".join(' ', @args));
|
|
} elsif ($args[0] eq 'rate' && defined $args[1]) {
|
|
shift @args;
|
|
bg_do("rate ".join(' ', @args));
|
|
} elsif ($args[0] eq 'info' && defined $args[1]) {
|
|
shift @args;
|
|
bg_do("info ".join(' ', @args));
|
|
} elsif ($args[0] eq 'echo') {
|
|
bg_do("echo");
|
|
} elsif ($args[0] eq 'top') {
|
|
my $number = defined $args[1] ? $args[1] : 10;
|
|
bg_do("top ".$number);
|
|
} elsif ($args[0] eq 'cpan' && defined $args[1]) {
|
|
call_openurl('http://search.cpan.org/search?mode=module&query='.$args[1]);
|
|
} elsif ($args[0] eq 'autorun' && defined $args[1]) {
|
|
toggle_autorun($args[1]);
|
|
} elsif ($args[0] eq 'new') {
|
|
my $number = defined $args[1] ? $args[1] : 5;
|
|
bg_do("new ".$number);
|
|
}
|
|
}
|
|
|
|
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) = @_;
|
|
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...";
|
|
$code->();
|
|
}
|
|
}
|
|
}
|
|
|
|
sub sig_default_command {
|
|
my ($cmd, $server) = @_;
|
|
return unless Irssi::settings_get_bool("scriptassist_check_unknown_commands");
|
|
return if ($cmd =~ /^\d+$/ && $irssi_version >= v1.2.0 && Irssi::settings_get_bool("window_number_commands"));
|
|
bg_do('unknown '.$cmd);
|
|
}
|
|
|
|
sub sig_complete {
|
|
my ($list, $window, $word, $linestart, $want_space) = @_;
|
|
return unless $linestart =~ /^.script(assist)? (install|rate|ratings|update|check|contact|info|autorun)/i;
|
|
my @newlist;
|
|
my $str = $word;
|
|
foreach (@complist) {
|
|
if ($_ =~ /^(\Q$str\E.*)?$/) {
|
|
push @newlist, $_;
|
|
}
|
|
}
|
|
foreach (@{loaded_scripts()}) {
|
|
push @newlist, $_ if /^(\Q$str\E.*)?$/;
|
|
}
|
|
push @$list, $_ foreach @newlist;
|
|
Irssi::signal_stop();
|
|
}
|
|
|
|
|
|
Irssi::settings_add_str($IRSSI{name}, 'scriptassist_script_sources', 'https://scripts.irssi.org/scripts.yml');
|
|
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);
|
|
Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_catch_script_errors', 1);
|
|
|
|
Irssi::settings_add_bool($IRSSI{name}, 'scriptassist_install_unsigned_scripts', 1);
|
|
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_register({ 'script error' => [ 'Irssi::Script', 'string' ] });
|
|
Irssi::signal_add_last('script error', 'sig_script_error');
|
|
|
|
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' ) ) {
|
|
Irssi::command_bind('scriptassist '.$cmd => sub {
|
|
cmd_scripassist("$cmd ".$_[0], $_[1], $_[2]); });
|
|
if (Irssi::settings_get_bool('scriptassist_integrate')) {
|
|
Irssi::command_bind('script '.$cmd => sub {
|
|
cmd_scripassist("$cmd ".$_[0], $_[1], $_[2]); });
|
|
}
|
|
}
|
|
|
|
print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /scriptassist help for help';
|