[libmoosex-has-sugar-perl] 58/120: Refactor shared code between bits into a library
Intrigeri
intrigeri at moszumanska.debian.org
Wed Aug 27 21:35:10 UTC 2014
This is an automated email from the git hooks/post-receive script.
intrigeri pushed a commit to annotated tag 0.05070422-source
in repository libmoosex-has-sugar-perl.
commit 3783dec3cb33d8a4754daa5f9fafd90a1052d8ba
Author: Kent Fredric <kentfredric at gmail.com>
Date: Wed Oct 30 20:30:48 2013 +1300
Refactor shared code between bits into a library
---
before_script.pl | 34 +++------------
install_deps.pl | 91 ++++++---------------------------------
lib/tools.pm | 123 +++++++++++++++++++++++++++++++++++++++++++++++++++++
report_fail_ctx.pl | 37 ++--------------
script.pl | 35 ++-------------
sterilize_env.pl | 47 ++------------------
sync_tree.pl | 28 ++----------
7 files changed, 158 insertions(+), 237 deletions(-)
diff --git a/before_script.pl b/before_script.pl
index cc128c7..f852b51 100644
--- a/before_script.pl
+++ b/before_script.pl
@@ -2,36 +2,15 @@
use strict;
use warnings;
-use utf8;
-sub diag { print STDERR @_; print STDERR "\n" }
-sub env_exists { return exists $ENV{ $_[0] } }
-sub env_true { return ( env_exists( $_[0] ) and $ENV{ $_[0] } ) }
-sub env_is { return ( env_exists( $_[0] ) and $ENV{ $_[0] } eq $_[1] ) }
-sub safe_exec_nonfatal {
- my ( $command, @params ) = @_;
- diag("running $command @params");
- my $exit = system( $command, @params );
- if ( $exit != 0 ) {
- my $low = $exit & 0b11111111;
- my $high = $exit >> 8;
- warn "$command failed: $? $! and exit = $high , flags = $low";
- if ( $high != 0 ) {
- return $high;
- }
- else {
- return 1;
- }
- }
- return 0;
-}
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use tools;
-sub safe_exec {
- my ( $command, @params ) = @_;
- my $result = safe_exec_nonfatal( $command, @params );
- exit $result if $result != 0;
+if ( not env_exists('STERILIZE_ENV') ) {
+ diag("\e[31mSTERILIZE_ENV \e[32munset\e[0m, skipping");
+ exit 0;
}
-
if ( env_is( 'TRAVIS_BRANCH', 'master' ) ) {
diag("before_script skipped, TRAVIS_BRANCH=master");
exit 0;
@@ -47,5 +26,6 @@ else {
safe_exec("make");
exit 0;
}
+
}
diff --git a/install_deps.pl b/install_deps.pl
index 3ac11b9..83b4e61 100644
--- a/install_deps.pl
+++ b/install_deps.pl
@@ -2,70 +2,10 @@
use strict;
use warnings;
use utf8;
-use Cwd qw(cwd);
-sub diag { print STDERR @_; print STDERR "\n" }
-sub env_exists { return exists $ENV{ $_[0] } }
-sub env_true { return ( env_exists( $_[0] ) and $ENV{ $_[0] } ) }
-sub env_is { return ( env_exists( $_[0] ) and $ENV{ $_[0] } eq $_[1] ) }
-
-sub safe_exec_nonfatal {
- my ( $command, @params ) = @_;
- diag("running $command @params");
- my $exit = system( $command, @params );
- if ( $exit != 0 ) {
- my $low = $exit & 0b11111111;
- my $high = $exit >> 8;
- warn "$command failed: $? $! and exit = $high , flags = $low";
- if ( $high != 0 ) {
- return $high;
- }
- else {
- return 1;
- }
-
- }
- return 0;
-}
-
-sub safe_exec {
- my ( $command, @params ) = @_;
- my $exit_code = safe_exec_nonfatal( $command, @params );
- if ( $exit_code != 0 ) {
- exit $exit_code;
- }
- return 1;
-}
-
-sub cpanm {
- my (@params) = @_;
- my $exit_code = safe_exec_nonfatal( 'cpanm', @params );
- if ( $exit_code != 0 ) {
- safe_exec( 'tail', '-n', '200', '/home/travis/.cpanm/build.log' );
- exit $exit_code;
- }
- return 1;
-}
-
-my $got_fixes;
-
-sub get_fixes {
- return if $got_fixes;
- my $cwd = cwd();
- chdir '/tmp';
- safe_exec( 'git', 'clone', 'https://github.com/kentfredric/cpan-fixes.git' );
- chdir $cwd;
- $got_fixes = 1;
-}
-
-sub cpanm_fix {
- my (@params) = @_;
- get_fixes();
- my $cwd = cwd();
- chdir '/tmp/cpan-fixes';
- cpanm(@params);
- chdir $cwd;
-}
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use tools;
if ( not env_exists('TRAVIS') ) {
diag('Is not running under travis!');
@@ -89,20 +29,17 @@ if ( env_is( 'TRAVIS_BRANCH', 'master' ) ) {
safe_exec( 'git', 'config', '--global', 'user.email', 'kentfredric+travisci at gmail.com' );
safe_exec( 'git', 'config', '--global', 'user.name', 'Travis CI ( On behalf of Kent Fredric )' );
- require Capture::Tiny;
- my $stdout = Capture::Tiny::capture_stdout(
- sub {
- safe_exec( 'dzil', 'authordeps', '--missing' );
- }
- );
+ my $stdout = capture_stdout {
+ safe_exec( 'dzil', 'authordeps', '--missing' );
+ };
+
if ( $stdout !~ /^\s*$/msx ) {
cpanm( @params, split /\n/, $stdout );
}
- $stdout = Capture::Tiny::capture_stdout(
- sub {
- safe_exec( 'dzil', 'listdeps', '--missing' );
- }
- );
+ $stdout = capture_stdout {
+ safe_exec( 'dzil', 'listdeps', '--missing' );
+ };
+
if ( $stdout !~ /^\s*$/msx ) {
cpanm( @params, split /\n/, $stdout );
}
@@ -110,10 +47,8 @@ if ( env_is( 'TRAVIS_BRANCH', 'master' ) ) {
else {
cpanm( @params, '--installdeps', '.' );
if ( env_true('AUTHOR_TESTING') or env_true('RELEASE_TESTING') ) {
- require CPAN::Meta;
- my $meta = CPAN::Meta->load_file('META.json');
- my $prereqs = $meta->effective_prereqs;
- my $reqs = $prereqs->requirements_for( 'develop', 'requires' );
+ my $prereqs = parse_meta_json()->effective_prereqs;
+ my $reqs = $prereqs->requirements_for( 'develop', 'requires' );
cpanm( @params, map { $_ . '~' . $reqs->requirements_for_module($_) } $reqs->required_modules );
diff --git a/lib/tools.pm b/lib/tools.pm
new file mode 100644
index 0000000..12a57d0
--- /dev/null
+++ b/lib/tools.pm
@@ -0,0 +1,123 @@
+use strict;
+use warnings;
+
+package tools;
+
+use Cwd qw(cwd);
+
+sub diag {
+ my $handle = \*STDERR;
+ for (@_) {
+ print {$handle} $_;
+ }
+ print {$handle} "\n";
+}
+
+sub env_exists {
+ return exists $ENV{ $_[0] };
+}
+
+sub env_true {
+ return ( env_exists( $_[0] ) and $ENV{ $_[0] } );
+}
+sub env_is { return ( env_exists( $_[0] ) and $ENV{ $_[0] } eq $_[1] ) }
+
+sub safe_exec_nonfatal {
+ my ( $command, @params ) = @_;
+ diag("running $command @params");
+ my $exit = system( $command, @params );
+ if ( $exit != 0 ) {
+ my $low = $exit & 0b11111111;
+ my $high = $exit >> 8;
+ warn "$command failed: $? $! and exit = $high , flags = $low";
+ if ( $high != 0 ) {
+ return $high;
+ }
+ else {
+ return 1;
+ }
+
+ }
+ return 0;
+}
+
+sub safe_exec {
+ my ( $command, @params ) = @_;
+ my $exit_code = safe_exec_nonfatal( $command, @params );
+ if ( $exit_code != 0 ) {
+ exit $exit_code;
+ }
+ return 1;
+}
+
+sub cpanm {
+ my (@params) = @_;
+ my $exit_code = safe_exec_nonfatal( 'cpanm', @params );
+ if ( $exit_code != 0 ) {
+ safe_exec( 'tail', '-n', '200', '/home/travis/.cpanm/build.log' );
+ exit $exit_code;
+ }
+ return 1;
+}
+
+sub git {
+ my (@params) = @_;
+ safe_exec( 'git', @params );
+}
+
+my $got_fixes;
+
+sub get_fixes {
+ return if $got_fixes;
+ my $cwd = cwd();
+ chdir '/tmp';
+ safe_exec( 'git', 'clone', 'https://github.com/kentfredric/cpan-fixes.git' );
+ chdir $cwd;
+ $got_fixes = 1;
+}
+
+sub cpanm_fix {
+ my (@params) = @_;
+ get_fixes();
+ my $cwd = cwd();
+ chdir '/tmp/cpan-fixes';
+ cpanm(@params);
+ chdir $cwd;
+}
+
+sub parse_meta_json {
+ $_[0] ||= 'META.json';
+ require CPAN::Meta;
+ return CPAN::Meta->load_file( $_[0] );
+}
+
+sub capture_stdout(&) {
+ require Capture::Tiny;
+ goto &Capture::Tiny::capture_stdout;
+}
+
+sub import {
+ my ( $self, @args ) = @_;
+
+ my $caller = [caller]->[0];
+
+ my $caller_stash = do {
+ no strict 'refs';
+ *{ $caller . '::' };
+ };
+
+ $caller_stash->{diag} = *diag;
+ $caller_stash->{env_exists} = *env_exists;
+ $caller_stash->{env_true} = *env_true;
+ $caller_stash->{env_is} = *env_is;
+ $caller_stash->{safe_exec_nonfatal} = *safe_exec_nonfatal;
+ $caller_stash->{safe_exec} = *safe_exec;
+ $caller_stash->{cpanm} = *cpanm;
+ $caller_stash->{git} = *git;
+ $caller_stash->{get_fixes} = *get_fixes;
+ $caller_stash->{cpanm_fix} = *cpanm_fix;
+ $caller_stash->{parse_meta_json} = *parse_meta_json;
+ $caller_stash->{capture_stdout} = *capture_stdout;
+}
+
+1;
diff --git a/report_fail_ctx.pl b/report_fail_ctx.pl
index b8a8c2e..29b8e21 100644
--- a/report_fail_ctx.pl
+++ b/report_fail_ctx.pl
@@ -4,39 +4,10 @@ use strict;
use warnings;
use utf8;
-sub diag { print STDERR @_; print STDERR "\n" }
-sub env_exists { return exists $ENV{ $_[0] } }
-sub env_true { return ( env_exists( $_[0] ) and $ENV{ $_[0] } ) }
-sub env_is { return ( env_exists( $_[0] ) and $ENV{ $_[0] } eq $_[1] ) }
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use tools;
-sub safe_exec_nonfatal {
- my ( $command, @params ) = @_;
- diag("running $command @params");
- my $exit = system( $command, @params );
- if ( $exit != 0 ) {
- my $low = $exit & 0b11111111;
- my $high = $exit >> 8;
- warn "$command failed: $? $! and exit = $high , flags = $low";
- if ( $high != 0 ) {
- return $high;
- }
- else {
- return 1;
- }
-
- }
- return 0;
-}
-
-sub safe_exec {
- my ( $command, @params ) = @_;
- my $exit_code = safe_exec_nonfatal( $command, @params );
- if ( $exit_code != 0 ) {
- exit $exit_code;
- }
- return 1;
-}
-
-diag("Last 1000 lines of cpanm build log");
+diag("\e[31mLast 1000 lines of cpanm build log\e[0m");
safe_exec( 'tail', '-n', '1000', $ENV{HOME} . '/.cpanm/build.log' );
diff --git a/script.pl b/script.pl
index b4dde39..7a9d3e2 100644
--- a/script.pl
+++ b/script.pl
@@ -4,38 +4,9 @@ use strict;
use warnings;
use utf8;
-sub diag { print STDERR @_; print STDERR "\n" }
-sub env_exists { return exists $ENV{ $_[0] } }
-sub env_true { return ( env_exists( $_[0] ) and $ENV{ $_[0] } ) }
-sub env_is { return ( env_exists( $_[0] ) and $ENV{ $_[0] } eq $_[1] ) }
-
-sub safe_exec_nonfatal {
- my ( $command, @params ) = @_;
- diag("running $command @params");
- my $exit = system( $command, @params );
- if ( $exit != 0 ) {
- my $low = $exit & 0b11111111;
- my $high = $exit >> 8;
- warn "$command failed: $? $! and exit = $high , flags = $low";
- if ( $high != 0 ) {
- return $high;
- }
- else {
- return 1;
- }
-
- }
- return 0;
-}
-
-sub safe_exec {
- my ( $command, @params ) = @_;
- my $exit_code = safe_exec_nonfatal( $command, @params );
- if ( $exit_code != 0 ) {
- exit $exit_code;
- }
- return 1;
-}
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use tools;
if ( not env_exists('TRAVIS') ) {
diag('Is not running under travis!');
diff --git a/sterilize_env.pl b/sterilize_env.pl
index 9e250c0..c000827 100644
--- a/sterilize_env.pl
+++ b/sterilize_env.pl
@@ -1,50 +1,10 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use utf8;
-sub diag { print STDERR @_; print STDERR "\n" }
-sub env_exists { return exists $ENV{ $_[0] } }
-sub env_true { return ( env_exists( $_[0] ) and $ENV{ $_[0] } ) }
-sub env_is { return ( env_exists( $_[0] ) and $ENV{ $_[0] } eq $_[1] ) }
-
-sub safe_exec_nonfatal {
- my ( $command, @params ) = @_;
- diag("running $command @params");
- my $exit = system( $command, @params );
- if ( $exit != 0 ) {
- my $low = $exit & 0b11111111;
- my $high = $exit >> 8;
- warn "$command failed: $? $! and exit = $high , flags = $low";
- if ( $high != 0 ) {
- return $high;
- }
- else {
- return 1;
- }
-
- }
- return 0;
-}
-
-sub safe_exec {
- my ( $command, @params ) = @_;
- my $exit_code = safe_exec_nonfatal( $command, @params );
- if ( $exit_code != 0 ) {
- exit $exit_code;
- }
- return 1;
-}
-
-sub cpanm {
- my (@params) = @_;
- my $exit_code = safe_exec_nonfatal( 'cpanm', @params );
- if ( $exit_code != 0 ) {
- safe_exec( 'tail', '-n', '200', '/home/travis/.cpanm/build.log' );
- exit $exit_code;
- }
- return 1;
-}
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use tools;
sub no_sterile_warning {
if ( env_is( 'TRAVIS_PERL_VERSION', '5.8' ) or env_is( 'TRAVIS_PERL_VERSION', '5.10' ) ) {
@@ -109,6 +69,7 @@ for my $perl_ver ( keys %{$extra_sterile} ) {
for my $libdir (@all_libs) {
for my $removal ( @{ $fixups->{remove} } ) {
my $path = $libdir . '/' . $removal;
+ diag("\e[32m ? $path \e[0m");
if ( -e -f $path ) {
unlink $path;
diag("Removed $path");
diff --git a/sync_tree.pl b/sync_tree.pl
index f7ceb58..a9d60fa 100755
--- a/sync_tree.pl
+++ b/sync_tree.pl
@@ -1,36 +1,16 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use utf8;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use tools;
use Path::FindDev qw( find_dev );
my $root = find_dev('./');
chdir "$root";
-sub diag {
- print STDERR @_;
- print STDERR "\n";
-}
-
-sub safe_exec {
- my ( $command, @params ) = @_;
- diag("running $command @params");
- my $exit = system( $command, @params );
- if ( $exit != 0 ) {
- my $low = $exit & 0b11111111;
- my $high = $exit >> 8;
- warn "$command failed: $? $! and exit = $high , flags = $low";
- if ( $high != 0 ) {
- exit $high;
- }
- else {
- exit 1;
- }
- }
- return 1;
-}
-
sub git_subtree {
safe_exec( 'git', 'subtree', @_ );
}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmoosex-has-sugar-perl.git
More information about the Pkg-perl-cvs-commits
mailing list