diff options
Diffstat (limited to '')
-rw-r--r-- | scripts/gitscriptassist.pl | 631 |
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(); + |