Adding upstream version 20231031.upstream/20231031upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 631 insertions, 0 deletions

diff --git a/scripts/gitscriptassist.pl b/scripts/gitscriptassist.pl
new file mode 100644
index 0000000..dd285d6
--- /dev/null
+++ b/scripts/gitscriptassist.pl
@@ -0,0 +1,631 @@
+use strict;
+use vars qw($VERSION %IRSSI);
+
+use Irssi;
+use IPC::Open3;
+use CPAN::Meta::YAML;
+use Text::ParseWords;
+use Text::Wrap;
+use Time::HiRes;
+use File::Glob qw/:bsd_glob/;
+
+$VERSION = '0.2';
+%IRSSI = (
+    authors	=> 'bw1',
+    contact	=> 'bw1@aol.at',
+    name	=> 'gitscriptassist',
+    description	=> 'script management with git',
+    license	=> 'Public Domain',
+    url		=> 'https://scripts.irssi.org/',
+    changed	=> '2020-02-02',
+    modules => 'IPC::Open3 CPAN::Meta::YAML Text::ParseWords '.
+					'Text::Wrap Time::HiRes',
+    commands=> "gitscriptassist"
+);
+
+my $help= << "END";
+%9Name%9
+  /gitscriptassist -  $IRSSI{description}
+
+%9Version%9
+  $VERSION
+
+%9Description%9
+  \$ mkdir ~/foo
+  \$ cd ~/foo
+  \$ git clone https://github.com/irssi/scripts.irssi.org.git
+  \$ irssi
+  [(status)] /script load ~/foo/scripts.irssi.org/scripts/gitscriptassist.pl
+  [(status)] /set gitscriptassist_repo ~/foo/scripts.irssi.org
+  [(status)] /gitscriptassist search script
+  [(status)] /quit
+  \$ echo "/script load ~/foo/scripts.irssi.org/scripts/gitscriptassist.pl" >> \\
+  > ~/.irssi/startup
+  \$ irssi
+
+%9Settings%9
+  %Ugitscriptassist_repo%U
+    path to the git workingdir
+  %Ugitscriptassist_path%U
+    path for the tempory files of /gitscriptassist
+  %Ugitscriptassist_startup%U
+    load the scripts on startup
+  %Ugitscriptassist_integrate%U
+    integrate in the script command
+
+%9Commands%9
+END
+
+my %scmds=(
+	'fetch'=>{
+		'short'=>"git fetch -all",
+	},
+	'gitload'=>{
+		'short'=>"load a script from the repository",
+		'usage'=>"/gitscriptassist gitload {filename[.pl]|hash:filename[.pl]}",
+		'file'=>1,
+	},
+	'info'=>{
+		'short'=>"view script info",
+		'usage'=>"/gitscriptassist info <filename[.pl]>",
+		'file'=>1,
+	},
+	'log'=>{
+		'short'=>"git log",
+		'usage'=>"/gitscriptassist log [filename[.pl]]",
+		'file'=>1,
+	},
+	'pull'=>{
+		'short'=>"git pull",
+	},
+	'search'=>{
+		'short'=>"search for word in scripts.yaml",
+		'usage'=>"/gitscriptassist search <word>",
+	},
+	'status'=>{
+		'short'=>"git status",
+	},
+	'help'=>{
+		'short'=>"show help",
+	},
+	'autoload'=>{
+		'short'=>"manage autoload",
+		'usage'=>"/gitscriptassist autoload <command>",
+		'sub' => {
+			'list' => {
+				'short'=>"show the list for startup",
+			},
+			'add' => {
+				'short'=>"add a list entry for /script load",
+				'file'=>1,
+			},
+			'gitadd' => {
+				'short'=>"add a list entry for /script load via git",
+				'file'=>1,
+			},
+			'write' => {
+				'short'=>"write list to file",
+			},
+			'load' => {
+				'short'=>"load the list from file",
+			},
+			'startup' => {
+				'short'=>"trigger the startup",
+			},
+			'remove' => {
+				'short'=>"remove a list entry",
+			},
+			'move' => {
+				'short'=>"move a list entry",
+			},
+		},
+	},
+	'new'=>{
+		'short'=>"show last modified scripts",
+		'usage'=>"/gitscriptassist new [max]",
+	},
+);
+
+my ($repo, $path, $startup, $integrate);
+
+my $subproc;
+my @nproc;
+
+my %scripts;
+my %time_scr;
+my @comp_start;
+my @autoload;
+
+my ($fh_in, $fh_out, $fh_err);
+
+sub load_autoload {
+	my $fh;
+	my $fn = $path.'/autoload.yaml';
+	if (-e $fn) {
+		open $fh, "<:utf8", $fn;
+		my $yt = do { local $/; <$fh> };
+		my $yml= CPAN::Meta::YAML->read_string($yt);
+		if (defined $yml->[0]) {
+			@autoload =@{$yml->[0]};
+		}
+		close $fh;
+		if ($startup) {
+			ascmd_startup();
+		}
+	}
+}
+
+sub write_autoload {
+	my $fh;
+	my $fn = $path.'/autoload.yaml';
+	if (scalar(@autoload) >0) {
+		open $fh, ">:utf8", $fn;
+		my $yml =CPAN::Meta::YAML->new(\@autoload);
+		print $fh $yml->write_string;
+		close $fh;
+	}
+}
+
+sub load_scripts {
+	my $fh;
+	my $f  =$repo.'/_data/scripts.yaml';
+	my $fn = bsd_glob $f, GLOB_TILDE;
+	if (-e $fn) {
+		%time_scr= ();
+		%scripts= ();
+		open $fh, "<:utf8", $fn;
+		my $yt = do { local $/; <$fh> };
+		my $yml= CPAN::Meta::YAML->read_string($yt);
+		my @l =@{$yml->[0]};
+		foreach my $s (@l) {
+			$scripts{$s->{filename}}=$s;
+		}
+		foreach my $s (@l) {
+			if (!exists $time_scr{$s->{modified}}) {
+				$time_scr{$s->{modified}} =[];
+			}
+			push @{$time_scr{$s->{modified}}}, $s;
+		}
+		close $fh;
+	}
+}
+
+sub run {
+	my (%arg) =@_;
+	if (!defined $subproc) {
+		$subproc={%arg};
+		use Symbol 'gensym'; $fh_err = gensym;
+		my $pid = open3 ($fh_in, $fh_out, $fh_err, $subproc->{cmd});
+		if (defined $pid) {
+			$subproc->{pid}=$pid;
+			Irssi::pidwait_add($pid);
+		}
+	} else {
+		push @nproc, {%arg}
+	}
+}
+
+sub sig_run_end {
+	my ($pid, $status) = @_;
+
+	if (defined $subproc) {
+		my $old = select $fh_out;
+		{
+			local $/;
+			$subproc->{out} = <$fh_out>;
+			$subproc->{out} =~ s/\n$//;
+			select $old;
+		}
+
+		{
+			select $fh_err;
+			local $/;
+			$subproc->{err} = <$fh_err>;
+			$subproc->{err} =~ s/\n$//;
+			select $old;
+		}
+
+		if (exists $subproc->{next}) {
+			if (ref ($subproc->{next}) eq 'CODE') {
+				&{$subproc->{next}}();
+			} elsif (ref ($subproc->{next}) eq 'ARRAY') {
+				foreach my $p (@{$subproc->{next}}) {
+					if (ref ($p) eq 'CODE') {
+						&{$p}();
+					}
+				}
+			}
+		}
+		$subproc = undef;
+		if (scalar(@nproc) >0 ){
+			my %arg = %{shift @nproc};
+			run(%arg);
+		}
+	}
+}
+
+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 print_msg {
+	my ( @te );
+	if ($subproc->{out} ne '') {
+		push @te, $subproc->{out};
+	}
+	if ($subproc->{err} ne '') {
+		push @te,'E:'.$subproc->{cmd};
+		push @te,'E:'.$subproc->{err};
+	}
+	if (defined $subproc->{label} &&
+			($subproc->{out} ne '' ||
+				$subproc->{err} ne '' )) {
+		Irssi::print(
+			draw_box($IRSSI{name}, join( "\n",@te) ,$subproc->{label}, 1),
+				, MSGLEVEL_CLIENTCRAP);
+	}
+}
+
+sub next_gitload {
+	if ($subproc->{err} eq '') {
+		Irssi::command("script load $path/$subproc->{filename}");
+	}
+}
+
+sub scmd_script_info {
+	my ($server, $witem, @args) =@_;
+	my @te;
+	my $s = $scripts{$args[0]};
+	if (!defined $s) {
+		$s = $scripts{$args[0].'.pl'};
+	}
+	if (defined $s) {
+		push @te, "name:        $s->{name}";
+		push @te, "authors:     $s->{authors}";
+		push @te, "description:";
+		my $d;
+		{
+			local $Text::Wrap::columns = 60;
+			local $Text::Wrap::unexpand= 0;
+			$d =wrap('   ','   ',$s->{description});
+		}
+		push @te, $d;
+		push @te, "filename:    $s->{filename}";
+		push @te, "version:     $s->{version}";
+		push @te, "modified:    $s->{modified}";
+		Irssi::print(
+			draw_box($IRSSI{name}, join( "\n",@te) ,'info' , 1),
+				, MSGLEVEL_CLIENTCRAP);
+	}
+}
+
+sub scmd_script_search {
+	my ($server, $witem, @args) =@_;
+	my @te;
+	my @scrs;
+	my $ml=0;
+	my $w=$args[0];
+	foreach my $fn (sort keys %scripts) {
+		my $s=$scripts{$fn};
+		if (
+				$s->{name} =~ m/$w/i ||
+				$s->{authors} =~ m/$w/i ||
+				$s->{description} =~ m/$w/i ||
+				$s->{filename} =~ m/$w/i ) {
+			push @scrs, $s;
+			my $l=length($s->{filename});
+			$ml=$l if ( $ml < $l);
+		}
+	}
+
+	foreach my $s (@scrs) {
+		my $i = sprintf "%-*s ", $ml, $s->{filename};
+		my $dt=$s->{description};
+		$dt=~ s/\n/ /g;
+		$dt=~ s/\s+/ /g;
+		my $d;
+		{
+			local $Text::Wrap::columns = 60;
+			local $Text::Wrap::unexpand= 0;
+			$d =wrap($i, ' 'x($ml+1), $dt);
+		}
+		push @te, $d;
+	}
+	Irssi::print(
+		draw_box($IRSSI{name}, join( "\n",@te) ,'search' , 1),
+			, MSGLEVEL_CLIENTCRAP);
+}
+
+sub scmd_gitload {
+	my ($server, $witem, @args) =@_;
+	my ($po, $fn);
+	if ($args[0] =~ m/^(.*):(.*)$/) {
+		$po=$1;
+		$fn=$2;
+	} else {
+		$po='master';
+		$fn=$args[0];
+	}
+	$fn .= '.pl' if ($fn !~ m/\.pl$/);
+	run(
+		'cmd' => "git -C $repo show $po:scripts/$fn >$path/$fn",
+		'label'=> 'gitload',
+		'filename'=>$fn,
+		'point'=>$po,
+		'next' => [\&next_gitload,\&print_msg]);
+}
+
+sub scmd_help {
+	my ($server, $witem, @args) =@_;
+	my @te;
+	if (scalar(@args) ==0 ) {
+		chomp $help;
+		push @te, $help;
+		foreach my $c (sort keys %scmds) {
+			if (exists $scmds{$c}->{short}) {
+				push @te, sprintf("  %%9%-10s%%9 %s", $c, $scmds{$c}->{short});
+			}
+			if (scalar(keys %{$scmds{$c}->{sub}}) ) {
+				push @te, '    '.join ' ',sort keys %{$scmds{$c}->{sub}};
+			}
+		}
+		Irssi::print(
+			draw_box($IRSSI{name}, join( "\n",@te) ,'help' , 1),
+				, MSGLEVEL_CLIENTCRAP);
+	} elsif ( exists $scmds{$args[0]} ) {
+		my $sa = $args[0];
+		push @te, "%9/$IRSSI{name} $sa%9";
+		if (exists $scmds{$sa}->{short}) {
+			push @te, "  $scmds{$sa}->{short}";
+		}
+		if (exists $scmds{$sa}->{usage}) {
+			push @te, "%9Usage:%9";
+			push @te, "  $scmds{$sa}->{usage}";
+		}
+		if (scalar(keys %{$scmds{$sa}->{sub}}) >0) {
+			push @te, "%9Commands:%9";
+			foreach my $su (sort keys %{$scmds{$sa}->{sub}}) {
+				if (exists $scmds{$sa}->{sub}->{$su}->{short}) {
+					push @te, sprintf("  %-10s %s", $su, $scmds{$sa}->{sub}->{$su}->{short});
+				}
+			}
+		}
+		Irssi::print(
+			draw_box($IRSSI{name}, join( "\n",@te) ,'help' , 1),
+				, MSGLEVEL_CLIENTCRAP);
+	}
+}
+
+sub ascmd_startup {
+	my ($server, $witem, @args) =@_;
+	foreach my $s (@autoload) {
+		if (exists $s->{load}) {
+			Irssi::command("script load $s->{load}");
+		} elsif (exists $s->{gitload}) {
+			scmd_gitload($server, $witem, $s->{gitload});
+		}
+	}
+}
+
+sub ascmd_list {
+	my ($server, $witem, @args) =@_;
+	my @te;
+	my $co=0;
+	foreach (@autoload){
+		my ($k, $f);
+		($k) = keys %$_;
+		$f   = $_->{$k};
+		push @te,sprintf("%4d %-10s %s", $co, $k, $f);
+		$co++;
+	}
+	Irssi::print(
+		draw_box($IRSSI{name}, join( "\n",@te) ,'autoload list' , 1),
+			, MSGLEVEL_CLIENTCRAP);
+}
+
+sub scmd_autoload {
+	my ($server, $witem, @args) =@_;
+	my $c = shift @args;
+	if ($c eq 'list') {
+		ascmd_list($server, $witem, @args);
+	} elsif ( $c eq 'add') {
+		push @autoload, { load=>$args[0]};
+	} elsif ( $c eq 'gitadd') {
+		push @autoload, { gitload=>$args[0]};
+	} elsif ( $c eq 'remove') {
+		splice @autoload,$args[0],1;
+	} elsif ( $c eq 'move') {
+		my $b =splice @autoload,$args[0],1;
+		my @ab =splice @autoload,$args[1];
+		push @autoload, $b;
+		push @autoload, @ab;
+	} elsif ( $c eq 'write') {
+		write_autoload();
+	} elsif ( $c eq 'load') {
+		load_autoload();
+	} elsif ( $c eq 'startup') {
+		ascmd_startup($server, $witem, @args);
+	}
+}
+
+sub scmd_new {
+	my ($server, $witem, @args) =@_;
+	my @te;
+	my $co=1;
+	my $max=5;
+	if (defined $args[0]) {
+		$max= $args[0];
+	}
+	foreach my $t (sort { $b cmp $a } keys %time_scr) {
+		foreach my $s ( @{$time_scr{$t}}) {
+			push @te,"$t  $s->{filename}";
+			$co++;
+		}
+		last if ($co > $max);
+	}
+	Irssi::print(
+		draw_box($IRSSI{name}, join( "\n",@te) ,'new' , 1),
+			, MSGLEVEL_CLIENTCRAP);
+}
+
+sub cmd {
+	my ($args, $server, $witem)=@_;
+	my @args = grep { $_ ne ''}  quotewords('\s+', 0, $args);
+	my $c =shift @args;
+
+	if ($c eq 'gitload') {
+		scmd_gitload($server, $witem, @args);
+
+	} elsif ($c eq 'status') {
+		run(
+			'cmd' => "git -C $repo status -sbuno",
+			'label'=> 'status',
+			'next' => [\&print_msg, \&load_scripts]);
+
+	} elsif ($c eq 'pull') {
+		run(
+			'cmd' => "git -C $repo pull",
+			'label'=> 'pull',
+			'next' => [\&print_msg, \&load_scripts]);
+
+	} elsif ($c eq 'fetch') {
+		run(
+			'cmd' => "git -C $repo fetch --all",
+			'label'=> 'fetch',
+			'next' => \&print_msg);
+
+	} elsif ($c eq 'log') {
+		my $s;
+		if (defined $args[0]) {
+			$s = "scripts/$args[0]";
+			if ($s !~ m/\.pl$/) {
+				$s .=".pl";
+			}
+		}
+		run(
+			'cmd' => "git -C $repo log master -n 10 ".
+							"--invert-grep --grep='automatic scripts database update' ".
+							"--no-decorate --no-merges ".
+							"--date=short ".
+							"--pretty='format:%cd %h %s' ".
+							"$s",
+			'label'=> 'log',
+			'next' => \&print_msg);
+
+	} elsif ($c eq 'info') {
+		scmd_script_info($server, $witem, @args);
+
+	} elsif ($c eq 'search') {
+		scmd_script_search($server, $witem, @args);
+
+	} elsif ($c eq 'help') {
+		scmd_help($server, $witem, @args);
+
+	} elsif ($c eq 'new') {
+		scmd_new($server, $witem, @args);
+
+	} elsif ($c eq 'autoload') {
+		scmd_autoload($server, $witem, @args);
+	}
+}
+
+sub sig_setup_changed {
+	my $r = Irssi::settings_get_str('gitscriptassist_repo');
+	if ($r ne $repo ) {
+		$r =~ s#/$##;
+		$repo= $r;
+		%scripts=();
+		load_scripts();
+	}
+	my $p = Irssi::settings_get_str('gitscriptassist_path');
+	$p =~ s#/$##;
+	if ($p !~ m#^[~/]#) {
+		$path = Irssi::get_irssi_dir().'/'.$p;
+	}
+	if (! -e $path ) {
+		Irssi::print('gitscriptassist: make working dir "'.$path.'"', MSGLEVEL_CLIENTCRAP);
+		mkdir $path;
+	}
+	$startup  = Irssi::settings_get_bool('gitscriptassist_startup');
+	my $bi= Irssi::settings_get_bool('gitscriptassist_integrate');
+	if ($bi==1 && $integrate != $bi) {
+		$integrate=$bi;
+		bind_cmd('script');
+	}
+}
+
+sub do_complete {
+	my ($strings, $window, $word, $linestart, $want_space) = @_;
+	my $ok;
+	foreach (@comp_start) {
+		$ok=1 if ($linestart =~ m/^$_/);
+	}
+	return unless $ok;
+
+	if ($word =~ m/^(.*:)/) {
+		@$strings = grep { m/^$word/} map {$1.$_} keys %scripts;
+	} else {
+		@$strings = grep { m/^$word/} keys %scripts;
+	}
+	$$want_space = 1;
+	Irssi::signal_stop;
+}
+
+sub bind_cmd {
+	my ($cm)=@_;
+	Irssi::command_bind($cm ,\&cmd);
+	foreach my $c (keys %scmds) {
+		Irssi::command_bind($cm .' '.$c,\&cmd);
+		foreach my $s (keys %{$scmds{$c}->{sub}}) {
+			Irssi::command_bind($cm .' '.$c.' '.$s,\&cmd);
+		}
+	}
+	foreach my $sc (keys %scmds) {
+		if (exists $scmds{$sc}->{file}) {
+			push @comp_start, "/$cm $sc";
+		}
+		foreach my $s (keys %{$scmds{$sc}->{sub}}) {
+			if (exists $scmds{$sc}->{sub}->{$s}->{file}) {
+				push @comp_start, "/$cm $sc $s";
+			}
+		}
+	}
+}
+
+sub UNLOAD {
+	write_autoload();
+}
+
+Irssi::command_bind('help', sub {
+		my @args = grep { $_ ne '' } quotewords('\s+', 0, $_[0]);
+		my $s = shift @args;
+		if ($s eq $IRSSI{name} ) {
+			scmd_help(undef, undef, @args);
+			Irssi::signal_stop;
+		}
+	}
+);
+
+
+Irssi::signal_add_first('complete word',  \&do_complete);
+Irssi::signal_add('pidwait', 'sig_run_end');
+Irssi::signal_add('setup changed', 'sig_setup_changed');
+
+Irssi::settings_add_str($IRSSI{name}, 'gitscriptassist_repo', '~/foo/script-irssi');
+Irssi::settings_add_str($IRSSI{name}, 'gitscriptassist_path', 'gitscriptassist');
+Irssi::settings_add_bool($IRSSI{name}, 'gitscriptassist_startup', 0);
+Irssi::settings_add_bool($IRSSI{name}, 'gitscriptassist_integrate', 0);
+
+bind_cmd($IRSSI{name});
+
+sig_setup_changed();
+load_autoload();
+