diff options
| -rw-r--r-- | scripts/scriptassist.pl | 454 |
1 files changed, 259 insertions, 195 deletions
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')) { |