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

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

[Kent Fredric]

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} );
+}
+

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

[Kent Fredric]

commit:     96e36ba5d7a32ff510915d54b089386554466986
Author:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
AuthorDate: Wed Sep 21 10:14:06 2011 +0000
Commit:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
CommitDate: Thu Sep 22 07:26:41 2011 +0000
URL:        http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=96e36ba5

[scripts] make multiplex script +x

[scripts] make error conditions in ssh_multiplex script clearer

---
 scripts/ssh_multiplex.pl |   14 ++++++++++----
 1 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/scripts/ssh_multiplex.pl b/scripts/ssh_multiplex.pl
old mode 100644
new mode 100755
index a83cd62..cb3d4c9
--- a/scripts/ssh_multiplex.pl
+++ b/scripts/ssh_multiplex.pl
@@ -77,20 +77,26 @@ sub map_param {
 
 sub spawn_child {
   my (@cmd) = @_;
+  local $!;
+  local $?;
+  local $@;
   my $cleanup = pop @cmd;
   my $pid;
   if ( not defined( $pid = fork() ) ) {
-    my (@error) = ( $!, $?, $@ );
+    my (%error) = ( '$!', $!, '$?', $?, '$@', $@ );
     require Carp;
-    Carp::croak("Forking Failed :( @error ");
+    Carp::croak( 'Forking Failed :( ' . dump \%error );
   }
   if ($pid) {
     return $pid;
   }
+  local $!;
+  local $?;
+  local $@;
   system(@cmd) == 0 or do {
-    my (@error) = ( $!, $?, $@ );
+    my (%error) = ( '$!', $!, '$?', $?, '$@', $@ );
     require Carp;
-    Carp::croak("Running command Failed :( @error ");
+    Carp::croak( 'Running command Failed :( ' . dump \%error );
   };
   $cleanup->();
   exit;

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

[Kent Fredric]

commit:     a3124f45d1cbeb9170123a31fdd1079a641b2e11
Author:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
AuthorDate: Mon Oct 24 21:15:37 2011 +0000
Commit:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
CommitDate: Mon Oct 24 21:15:37 2011 +0000
URL:        http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=a3124f45

[scripts/package_log.pl] add a  --nosummarize command to get full changes output

---
 scripts/package_log.pl |   16 +++++++++++-----
 1 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/scripts/package_log.pl b/scripts/package_log.pl
index 1d36d12..70547b3 100644
--- a/scripts/package_log.pl
+++ b/scripts/package_log.pl
@@ -201,6 +201,10 @@ sub change_for {
 
   return unless $file;
 
+  if ( $flags->{'nosummarize'} ) {
+    return $file;
+  }
+
   require CPAN::Changes;
   my $changes = CPAN::Changes->load_string($file);
   if ($changes) {
@@ -239,11 +243,13 @@ USAGE:
   # Be verbose about what we're doing
   package_log.pl Moose --trace --all
 
-    --all     Show all releases in the log.
-    --help    Show this message
-    --changes Show ChangeLog Excerpts using CPAN::Changes where possible
-    --deps    Show Dependency data ( as reported via metadata )
-    --trace   Turn on extra debugging.
+    --all         Show all releases in the log.
+    --help        Show this message
+    --changes     Show ChangeLog Excerpts using CPAN::Changes where possible
+    --deps        Show Dependency data ( as reported via metadata )
+    --trace       Turn on extra debugging.
+    --nosummarize Do no processing of Changes data and report it verbatim
+                  ( Useful when CPAN::Changes gets it wrong :( )
 EOF
 
 }

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

[Kent Fredric]

commit:     eeb6d383783c990d56f039cd0ffe92c9e0dc6838
Author:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
AuthorDate: Tue Oct 25 19:43:09 2011 +0000
Commit:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
CommitDate: Tue Oct 25 19:45:19 2011 +0000
URL:        http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=eeb6d383

[scripts/module_log.pl] improve help

---
 scripts/module_log.pl |   66 +++++++++++++++++++++++++++++++++++++-----------
 1 files changed, 51 insertions(+), 15 deletions(-)

diff --git a/scripts/module_log.pl b/scripts/module_log.pl
index cf0d498..ff012af 100755
--- a/scripts/module_log.pl
+++ b/scripts/module_log.pl
@@ -26,6 +26,52 @@ my $singleflags;
 
 if ( $flags->{help} or $singleflags->{h} ) { print help(); exit 0; }
 
+sub help {
+  return <<'EOF';
+module_log.pl
+
+USAGE:
+
+  module_log.pl Class::MOP::Class
+
+    # See Class::MOP::Class started in Class-MOP and moved to Moose
+    #
+    # NOTE: Due to a caveat in PAUSE with how indexing works, Modules may look
+    # like they're comming from weird places.
+    #
+    # this is usually due to somebody lexically hacking a foreign package like so:
+    #
+    #   { package Foo; blah blah blah }
+    #
+    # Unfortunately, PAUSE indexer sees that 'package Foo' and then deems this a place 'Foo' is defined.
+    #
+    # Usually that doesn't pose a problem, as the author who releases the containing package rarely has
+    # AUTHORITY permssion on the hacked package, so it doesn't get indexed. ( ie: HTTP::Request::Common )
+    #
+    # However, in the event the author has permissions to publish 'Foo', the indexer runs the risk
+    # of taking that tiny little package declaration as *the most recent version of that package*
+    # and is likely to try installing it.  ( ie: HTTP::Message )
+    #
+    # For the most part, the "indexed but not authorised" case is eliminated by the query,
+    # but we have to weed out some false matches client side due to a current API limitation.
+    #
+    # but you can turn this weeding off for diagnostic reasons with
+    #
+    # module_log.pl --notrim HTTP::Message
+    #
+    # PROTIP: Usually when people do this foreign hacking, they don't define a VERSION in the same context
+    # which thankfully gives you the ability to assume its not sourceable.
+    #
+    # Try this:
+    #
+    # module_log.pl --notrim HTTP::Request::Common
+    #
+    # and see all the hacking in Apache-TestRequest turn up =)
+    #
+
+EOF
+}
+
 # FILENAME: module_log.pl
 # CREATED: 25/10/11 12:15:51 by Kent Fredric (kentnl) <kentfredric@gmail.com>
 # ABSTRACT: Show the full history of a Module across distributions.
@@ -34,13 +80,15 @@ if ( $flags->{help} or $singleflags->{h} ) { print help(); exit 0; }
 #
 # module_log.pl Class::MOP
 #  # emits both Class-MOP and Moose history
+
+use Data::Dump qw( pp );
+
 my ($release) = shift(@ARGV);
 
-my $result = [ map { $_->{as_string} } metacpan->find_dist_simple( $release , {notrim=>1}) ];
+my $result = [ map { $_->{as_string} } metacpan->find_dist_simple( $release, $flags ) ];
 
-use Data::Dump qw( pp );
 use JSON qw( to_json );
-say to_json($result , { pretty => 1 } );
+say to_json( $result, { pretty => 1 } );
 1;
 
 sub pkg_for_module {
@@ -54,15 +102,3 @@ sub gen_dep {
 
 }
 
-sub help {
-  return <<'EOF';
-module_log.pl
-
-USAGE:
-
-  module_log.pl Class::MOP::Class
-
-    # See Class::MOP::Class started in Class-MOP and moved to Moose
-
-EOF
-}

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

[Kent Fredric]

commit:     d384d09cd4451a333cd0278d1aefd5f1ffbfec25
Author:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
AuthorDate: Tue Oct 25 19:23:41 2011 +0000
Commit:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
CommitDate: Tue Oct 25 19:45:07 2011 +0000
URL:        http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=d384d09c

[scripts/module_log.pl] Pull out module history code into its own util

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

diff --git a/scripts/module_log.pl b/scripts/module_log.pl
new file mode 100755
index 0000000..cf0d498
--- /dev/null
+++ b/scripts/module_log.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+
+eval 'echo "Called with something not perl"' && exit 1    # Non-Perl protection.
+  if 0;
+
+use 5.14.2;
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use env::gentoo::perl_experimental;
+use metacpan qw( mcpan );
+
+my $flags;
+my $singleflags;
+
+@ARGV = grep { defined } map {
+  $_ =~ /^--(\w+)/
+    ? do { $flags->{$1}++; undef }
+    : do {
+    $_ =~ /^-(\w+)/
+      ? do { $singleflags->{$1}++; undef }
+      : do { $_ }
+    }
+} @ARGV;
+
+if ( $flags->{help} or $singleflags->{h} ) { print help(); exit 0; }
+
+# FILENAME: module_log.pl
+# CREATED: 25/10/11 12:15:51 by Kent Fredric (kentnl) <kentfredric@gmail.com>
+# ABSTRACT: Show the full history of a Module across distributions.
+
+# usage:
+#
+# module_log.pl Class::MOP
+#  # emits both Class-MOP and Moose history
+my ($release) = shift(@ARGV);
+
+my $result = [ map { $_->{as_string} } metacpan->find_dist_simple( $release , {notrim=>1}) ];
+
+use Data::Dump qw( pp );
+use JSON qw( to_json );
+say to_json($result , { pretty => 1 } );
+1;
+
+sub pkg_for_module {
+  my ($module) = shift;
+
+}
+
+sub gen_dep {
+  state $template = qq{\t# %s%s\n\techo %s\n};
+  my ( $module, $version ) = @_;
+
+}
+
+sub help {
+  return <<'EOF';
+module_log.pl
+
+USAGE:
+
+  module_log.pl Class::MOP::Class
+
+    # See Class::MOP::Class started in Class-MOP and moved to Moose
+
+EOF
+}

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

[Kent Fredric]

commit:     daa146d297c4d3842458e2e1709148bbf17cfe81
Author:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
AuthorDate: Tue Oct 25 20:46:34 2011 +0000
Commit:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
CommitDate: Mon Oct 31 02:45:46 2011 +0000
URL:        http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=daa146d2

make executable

---
 0 files changed, 0 insertions(+), 0 deletions(-)

diff --git a/scripts/gen_ebuild.pl b/scripts/gen_ebuild.pl
old mode 100644
new mode 100755

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

[Kent Fredric]

commit:     61c48fe86e85329762533763c3c2799893c761bd
Author:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
AuthorDate: Sun Feb 12 01:48:15 2012 +0000
Commit:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
CommitDate: Sun Feb 12 01:48:15 2012 +0000
URL:        http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=61c48fe8

[script] remove newest_date limitation on package_log

---
 scripts/package_log.pl |    2 +-
 1 files changed, 1 insertions(+), 1 deletions(-)

diff --git a/scripts/package_log.pl b/scripts/package_log.pl
index a6bc9fb..22e571d 100755
--- a/scripts/package_log.pl
+++ b/scripts/package_log.pl
@@ -61,7 +61,7 @@ if ( not $flags->{all} ) {
         range => {
             date => {
                 from => $oldest_date,
-                to   => $newest_date,
+                #to   => $newest_date,
             }
         }
     };