[gentoo-commits] proj/perl-overlay:eclass-moretests commit in: scripts/

["Kent Fredric" <kentfredric@gmail.com>]

commit:     3a05ea43a2e634e12124f44e49b7c8b059d264ec
Author:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
AuthorDate: Tue Aug  2 01:46:29 2011 +0000
Commit:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
CommitDate: Mon Aug 29 05:39:17 2011 +0000
URL:        http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=3a05ea43

[scripts] new script to facilitate spawning the ssh backgrounded connections. ( I always forget how to do this  and its annoying, this script mostly just does the right thing. Its a bit more annoying on subsequent calls to the script if the master connection is already up, but its really not worth mention )

---
 scripts/ssh_multiplex.pl |  109 ++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 109 insertions(+), 0 deletions(-)

diff --git a/scripts/ssh_multiplex.pl b/scripts/ssh_multiplex.pl
new file mode 100644
index 0000000..a83cd62
--- /dev/null
+++ b/scripts/ssh_multiplex.pl
@@ -0,0 +1,109 @@
+#!/usr/bin/env perl 
+eval 'echo "Called with something not perl"' && exit 1    # Non-Perl protection.
+  if 0;
+
+use strict;
+use warnings;
+use 5.12.1;
+
+# FILENAME: ssh_multiplex.pl
+# CREATED: 02/08/11 12:18:23 by Kent Fredric (kentnl) <kentfredric@gmail.com>
+# ABSTRACT: Spawn Background SSH Masters for Gentoo Git Sources
+
+use File::Which qw( which );
+use Data::Dump qw( dump );
+
+my $ssh_cmd  = which(qw( ssh ));
+my %flag_map = (
+  background         => ['-f'],
+  no_execute_command => ['-N'],
+  no_stdin           => ['-n'],
+  control_master     => [ '-o', 'ControlMaster=auto' ],
+);
+
+my @pids;
+
+spawn_cmd(
+  {
+    pids    => \@pids,
+    params  => [qw( background no_execute_command no_stdin control_master )],
+    connect => 'git@github.com',
+    cleanup => sub {
+      say "\e[31mConnected to git\@github.com\e[0m";
+    },
+  }
+);
+
+spawn_cmd(
+  {
+    pids    => \@pids,
+    params  => [qw( background no_execute_command no_stdin control_master )],
+    connect => 'git@git.overlays.gentoo.org',
+    cleanup => sub {
+      say "\e[32mConnected to git\@git.overlays.gentoo.org\e[0m";
+    },
+  }
+);
+
+for (@pids) {
+  waitpid $_, 0;
+}
+
+say "Done.";
+
+exit;
+
+sub map_option {
+  my ($option) = @_;
+  if ( not exists $flag_map{$option} ) {
+    require Carp;
+    Carp::croak("Map for $option undefined");
+  }
+  return @{ $flag_map{$option} };
+}
+
+sub map_literal_array {
+  my ($literal) = @_;
+  return @{$literal};
+}
+
+sub map_param {
+  my ($param) = @_;
+  return map_option($param) if not ref $param;
+  return map_literal_array($param) if ref $param eq 'ARRAY';
+  require Carp;
+  Carp::croak("Unhandled parameter $param");
+}
+
+sub spawn_child {
+  my (@cmd) = @_;
+  my $cleanup = pop @cmd;
+  my $pid;
+  if ( not defined( $pid = fork() ) ) {
+    my (@error) = ( $!, $?, $@ );
+    require Carp;
+    Carp::croak("Forking Failed :( @error ");
+  }
+  if ($pid) {
+    return $pid;
+  }
+  system(@cmd) == 0 or do {
+    my (@error) = ( $!, $?, $@ );
+    require Carp;
+    Carp::croak("Running command Failed :( @error ");
+  };
+  $cleanup->();
+  exit;
+}
+
+sub spawn_cmd {
+  my ($args) = @_;
+  my @outargs = map { map_param($_) } @{ $args->{'params'} };
+  my (@cmd) = ( $ssh_cmd, @outargs, $args->{'connect'} );
+  say "Spawning " . dump( \@cmd );
+  $args->{cleanup} //= sub {
+    say "\e[31mConnected to " . $args->{'connect'} . "\e[0m";
+  };
+  push @{ $args->{pids} }, grep { defined } spawn_child( @cmd, $args->{cleanup} );
+}
+