Skip to content
Browse files

Add more examples/*.pl programs. Refactor subroutines used in those p…

…rograms into examples/lib/Helper.pm. Improve example programs.
  • Loading branch information...
1 parent a7ebf86 commit 076c71fb2024eaa23e51c5275dfe3dedfbbbec18 @jkeenan committed
Showing with 276 additions and 128 deletions.
  1. +2 −0 MANIFEST
  2. +19 −24 examples/03-refresh_success_list.pl
  3. +20 −104 examples/04-visit_one_distro.pl
  4. +70 −0 examples/05-visit_multiple_distros.pl
  5. +165 −0 examples/lib/Helper.pm
View
2 MANIFEST
@@ -3,6 +3,8 @@ examples/01-distros_with_xs.pl
examples/02-build_distros_with_xs.pl
examples/03-refresh_success_list.pl
examples/04-visit_one_distro.pl
+examples/05-visit_multiple_distros.pl
+examples/lib/Helper.pm
lib/CPAN/Mini/Visit/Simple.pm
lib/CPAN/Mini/Visit/Simple.pod
lib/CPAN/Mini/Visit/Simple/Auxiliary.pm
View
43 examples/03-refresh_success_list.pl
@@ -6,6 +6,10 @@
use Carp;
use Cwd;
use CPAN::Mini::Visit::Simple;
+use lib qw( lib );
+use Helper qw(
+ successful_eumm_or_mb
+);
=head1 NAME
@@ -13,7 +17,7 @@ =head1 NAME
=head1 SYNOPSIS
- perl refresh_success_list.pl
+ perl 03-refresh_success_list.pl /path/to/successful_builds_list.txt
=head1 DESCRIPTION
@@ -55,35 +59,26 @@ =head1 DESCRIPTION
=cut
-my $cwd = cwd();
-my $builds_file = qq|$cwd/success.builds.txt|;
-my (@eumm_distros, @mb_distros);
-open my $IN, '<', $builds_file or croak;
-while (my $d = <$IN>) {
- chomp $d;
- my @data = split /:/, $d;
- if ($data[1] eq 'EUMM') {
- push @eumm_distros, $data[0];
- }
- elsif ($data[1] eq 'MB') {
- push @mb_distros, $data[0];
- }
- else {
- carp "$data[0] mysterious";
- }
-}
-close $IN or croak;
-say "EUMM: ", sprintf "%5d" => scalar @eumm_distros;
-say "MB: ", sprintf "%5d" => scalar @mb_distros;
+croak "Must specify path to file holding list of successful builds"
+ unless (@ARGV == 1 and (-f $ARGV[0]));
+
+my $builds_file = shift @ARGV;
+my ($eumm_ref, $mb_ref) = successful_eumm_or_mb($builds_file);
+say "EUMM: ", sprintf "%5d" => scalar @{$eumm_ref};
+say "MB: ", sprintf "%5d" => scalar @{$mb_ref};
my $self = CPAN::Mini::Visit::Simple->new();
my $id_dir = $self->get_id_dir();
my $refreshed_eumm_list_ref = $self->refresh_list( {
- derived_list => [ map { qq|$id_dir/$_| } @eumm_distros ],
+ derived_list => [ map { qq|$id_dir/$_| } @{$eumm_ref} ],
} );
my $refreshed_mb_list_ref = $self->refresh_list( {
- derived_list => [ map { qq|$id_dir/$_| } @mb_distros ],
+ derived_list => [ map { qq|$id_dir/$_| } @{$mb_ref} ],
} );
#say Dumper $refreshed_eumm_list_ref;
-say Dumper $refreshed_mb_list_ref;
+#say Dumper $refreshed_mb_list_ref;
+
+foreach my $eumm_xs_current (@{$refreshed_eumm_list_ref}) {
+ say $eumm_xs_current;
+}
View
124 examples/04-visit_one_distro.pl
@@ -9,14 +9,21 @@
use File::Find;
use File::Temp qw( tempdir );
use CPAN::Mini::Visit::Simple;
+use lib qw( lib );
+use Helper qw(
+ perform_comparison_builds
+ perform_one_build
+);
=head1 NAME
-03-visit_one_distro.pl - Use the C<get_id_dir()>, C<identify_distros_from_derived_list()> and C<visit()> methods
+04-visit_one_distro.pl - Use the C<get_id_dir()>, C<identify_distros_from_derived_list()> and C<visit()> methods
=head1 SYNOPSIS
- perl visit_one_distro.pl
+ perl 04-visit_one_distro.pl \
+ 'A/AD/ADAMK/Params-Util-1.00.tar.gz' \
+ /path/to/alternate/extutils-parsexs/lib
=head1 DESCRIPTION
@@ -43,118 +50,27 @@ =head1 DESCRIPTION
=cut
-my $starting_dir = cwd();
my $self = CPAN::Mini::Visit::Simple->new();
my $id_dir = $self->get_id_dir();
+croak "Must supply single distro and path to alternate ParseXS"
+ unless ( @ARGV == 2
+ and
+ ( -f qq|$id_dir/$ARGV[0]| )
+ and
+ ( -d $ARGV[1] )
+ );
+my $path_to_single_distro = qq|$id_dir/$ARGV[0]|;
+my $path_to_alternate_module = $ARGV[1];
my $rv = $self->identify_distros_from_derived_list( {
- list => [ "$id_dir/A/AD/ADAMK/Params-Util-1.00.tar.gz", ],
+ list => [ $path_to_single_distro ],
} );
$rv = $self->visit( {
quiet => 1,
action => sub {
my $distro = shift @_;
- my $gitlib = q{/Users/jimk/gitwork/extutils-parsexs/lib};
- my $exit_code = _perform_comparison_builds($distro, $gitlib);
+ my $exit_code = perform_comparison_builds($distro, $path_to_alternate_module);
},
} );
-sub _perform_comparison_builds {
- my ($distro, $gitlib) = @_;
- my $first_exit_code = _perform_one_build($distro);
- carp "$distro did not build" if $first_exit_code;
- my $tdir1 = tempdir ( CLEANUP => 1 );
- my @first_c_files = ();
- find(
- {
- wanted => sub { push @first_c_files, $File::Find::name if (-f $_) }
- },
- '.'
- );
- foreach my $f (@first_c_files) {
- copy $f => qq|$tdir1/| . basename ($f)
- or die "Unable to copy $f: $!";
- }
- system(qq{make clean});
-
- my $second_exit_code = _perform_one_build($distro, $gitlib);
- carp "$distro did not build" if $second_exit_code;
- my $tdir2 = tempdir ( CLEANUP => 1 );
- my @second_c_files = ();
- find(
- {
- wanted => sub { push @second_c_files, $File::Find::name if (-f $_) }
- },
- '.'
- );
- foreach my $f (@second_c_files) {
- copy $f => qq|$tdir2/| . basename ($f)
- or die "Unable to copy $f: $!";
- }
-
- my @copied_first_files = glob("$tdir1/*.c");
- foreach my $g (@copied_first_files) {
- my $base = basename($g);
- say STDERR "Trying to diff $base ...";
- my $revised = qq|$tdir2/$base|;
- if ( -f $revised ) {
- system( qq{ diff -Bw $g $revised } );
- }
- }
-}
-
-sub _perform_one_build {
- my ($distro, $gitlib) = @_;
- my $tdir = cwd();
- say STDERR "Studying $distro in $tdir";
- return unless (-f 'Makefile.PL' or -f 'Build.PL');
- my ($bfile, $bprogram, $builder, $exit_code);
- if (-f 'Build.PL') {
- # This part not yet developed properly.
- # I'll need to make sure that on the second build ./Build points to
- # proper directory.
- $bfile = q{Build.PL};
- $bprogram = q{./Build};
- $builder = q{MB};
- }
- else {
- # Hack to get EUMM to DWIM:
- # By shift-ing $gitlib onto @INC, in running Makefile.PL perl first
- # uses modules found in $gitlib. My devel version of EUPXS is, of
- # course, found there, as is an unaltered version of xsubpp.
- # EUMM begins at the 0th-element of @INC in its
- # search for XSUBPPDIR, so it stores $gitlib/ExtUtils in that
- # attribute and uses the version of xsubpp there to compile.
- #
- # XSUBPPDIR = /Users/jimk/gitwork/extutils-parsexs/lib/ExtUtils
- # XSUBPP = $(XSUBPPDIR)$(DFSEP)xsubpp
- # XSUBPPRUN = $(PERLRUN) $(XSUBPP)
- # XSPROTOARG =
- # XSUBPPDEPS = /usr/local/lib/perl5/5.10.1/ExtUtils/typemap $(XSUBPP)
- # XSUBPPARGS = -typemap /usr/local/lib/perl5/5.10.1/ExtUtils/typemap
- # XSUBPP_EXTRA_ARGS =
- #
- # Note that we're still using the default 'typemap' associated with
- # the installed perl.
- #
- # PROBLEM: The call to 'xsubpp' performed by 'make' needs to be
- # something like:
- # /usr/local/bin/perl/ -I$gitlib $(XSUBPP) so that we read the variant
- # ParseXS.pm.
- # XSUBPPPARENTDIR = /Users/jimk/gitwork/extutils-parsexs/lib
- # XSUBPP = $(XSUBPPDIR)$(DFSEP)xsubpp
- # XSUBPPRUN = $(PERLRUN) -I$(XSUBPPPARENTDIR) $(XSUBPP)
- #
- # SOLUTION: Hack up a version of ExtUtils::MM_Unix to permit an
- # assignment to XSUBPPPARENTDIR. Place this version in that same
- # directory!
-
- $bfile = defined $gitlib
- ? qq{-I$gitlib Makefile.PL}
- : q{Makefile.PL};
- $bprogram = q{make};
- $builder = q{EUMM};
- }
- $exit_code = system(qq{$^X $bfile && $bprogram});
-}
View
70 examples/05-visit_multiple_distros.pl
@@ -0,0 +1,70 @@
+#!/usr/local/bin/perl
+use strict;
+use warnings;
+use feature qw( :5.10 );
+use Data::Dumper;$Data::Dumper::Indent=1;
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Copy;
+use File::Find;
+use File::Temp qw( tempdir );
+use CPAN::Mini::Visit::Simple;
+use Scalar::Util qw( looks_like_number );
+use Tie::File;
+use lib qw( lib );
+use Helper qw(
+ prepare_list_of_random_distros
+ perform_comparison_builds
+);
+
+
+=head1 NAME
+
+05-visit_multiple_distros.pl
+
+=head1 SYNOPSIS
+
+ perl 05-visit_multiple_distros.pl \
+ /path/to/eumm_xs_current.txt \
+ 5 \
+ /path/to/alternate/extutils-parsexs/lib
+
+=head1 DESCRIPTION
+
+Specify a file holding a list of distributions with XS that build successfully
+with ExtUtils::MakeMaker; the number of distributions to test; and a path to
+the alternate version of ExtUtils::ParseXS. The program will select that
+number of distributions in a pseudo-random manner and test them with both old
+and new ParseXS.
+
+=cut
+
+croak "Will need 3 command-line arguments" unless @ARGV == 3;
+croak "Must supply path to list of files with XS that build successfully with EUMM"
+ unless (-f $ARGV[0]);
+my $eumm_file = shift @ARGV;
+croak "Must supply number of distributions to be visited"
+ unless looks_like_number($ARGV[0]);
+my $count = shift @ARGV;
+croak "Must path to alternate ParseXS"
+ unless (-d $ARGV[0]);
+my $path_to_alternate_module = $ARGV[0];
+
+my $selected_distros_ref = prepare_list_of_random_distros($eumm_file, $count);
+
+my $self = CPAN::Mini::Visit::Simple->new();
+my $id_dir = $self->get_id_dir();
+
+my $rv = $self->identify_distros_from_derived_list( {
+ list => $selected_distros_ref,
+} );
+
+$rv = $self->visit( {
+ quiet => 1,
+ action => sub {
+ my $distro = shift @_;
+ my $exit_code = perform_comparison_builds($distro, $path_to_alternate_module);
+ },
+} );
+
View
165 examples/lib/Helper.pm
@@ -0,0 +1,165 @@
+package Helper;
+use 5.010;
+use strict;
+use warnings;
+our @ISA = qw( Exporter );
+our @EXPORT_OK = qw(
+ perform_comparison_builds
+ perform_one_build
+ successful_eumm_or_mb
+ prepare_list_of_random_distros
+);
+use Carp;
+use Cwd;
+use Data::Dumper;$Data::Dumper::Indent=1;
+use File::Copy;
+use File::Find;
+use File::Basename;
+use File::Temp qw( tempdir );
+use Tie::File;
+
+sub perform_comparison_builds {
+ my ($distro, $gitlib) = @_;
+ my $first_exit_code = perform_one_build($distro);
+ carp "$distro did not build" if $first_exit_code;
+ my $tdir1 = tempdir ( CLEANUP => 1 );
+ my @first_c_files = ();
+ find(
+ {
+ wanted => sub { push @first_c_files, $File::Find::name if (-f $_) }
+ },
+ '.'
+ );
+ foreach my $f (@first_c_files) {
+ copy $f => qq|$tdir1/| . basename ($f)
+ or die "Unable to copy $f: $!";
+ }
+ system(qq{make clean});
+
+ my $second_exit_code = perform_one_build($distro, $gitlib);
+ carp "$distro did not build" if $second_exit_code;
+ my $tdir2 = tempdir ( CLEANUP => 1 );
+ my @second_c_files = ();
+ find(
+ {
+ wanted => sub { push @second_c_files, $File::Find::name if (-f $_) }
+ },
+ '.'
+ );
+ foreach my $f (@second_c_files) {
+ copy $f => qq|$tdir2/| . basename ($f)
+ or die "Unable to copy $f: $!";
+ }
+
+ my @copied_first_files = glob("$tdir1/*.c");
+ foreach my $g (@copied_first_files) {
+ my $base = basename($g);
+ say STDERR "Trying to diff $base ...";
+ my $revised = qq|$tdir2/$base|;
+ if ( -f $revised ) {
+ system( qq{ diff -Bw $g $revised } );
+ }
+ }
+}
+
+sub perform_one_build {
+ my ($distro, $gitlib) = @_;
+ my $tdir = cwd();
+ say STDERR "Studying $distro in $tdir";
+ return unless (-f 'Makefile.PL' or -f 'Build.PL');
+ my ($bfile, $bprogram, $builder, $exit_code);
+ if (-f 'Build.PL') {
+ # This part not yet developed properly.
+ # I'll need to make sure that on the second build ./Build points to
+ # proper directory.
+ $bfile = q{Build.PL};
+ $bprogram = q{./Build};
+ $builder = q{MB};
+ }
+ else {
+ # Hack to get EUMM to DWIM:
+ # By shift-ing $gitlib onto @INC, in running Makefile.PL perl first
+ # uses modules found in $gitlib. My devel version of EUPXS is, of
+ # course, found there, as is an unaltered version of xsubpp.
+ # EUMM begins at the 0th-element of @INC in its
+ # search for XSUBPPDIR, so it stores $gitlib/ExtUtils in that
+ # attribute and uses the version of xsubpp there to compile.
+ #
+ # XSUBPPDIR = /Users/jimk/gitwork/extutils-parsexs/lib/ExtUtils
+ # XSUBPP = $(XSUBPPDIR)$(DFSEP)xsubpp
+ # XSUBPPRUN = $(PERLRUN) $(XSUBPP)
+ # XSPROTOARG =
+ # XSUBPPDEPS = /usr/local/lib/perl5/5.10.1/ExtUtils/typemap $(XSUBPP)
+ # XSUBPPARGS = -typemap /usr/local/lib/perl5/5.10.1/ExtUtils/typemap
+ # XSUBPP_EXTRA_ARGS =
+ #
+ # Note that we're still using the default 'typemap' associated with
+ # the installed perl.
+ #
+ # PROBLEM: The call to 'xsubpp' performed by 'make' needs to be
+ # something like:
+ # /usr/local/bin/perl/ -I$gitlib $(XSUBPP) so that we read the variant
+ # ParseXS.pm.
+ # XSUBPPPARENTDIR = /Users/jimk/gitwork/extutils-parsexs/lib
+ # XSUBPP = $(XSUBPPDIR)$(DFSEP)xsubpp
+ # XSUBPPRUN = $(PERLRUN) -I$(XSUBPPPARENTDIR) $(XSUBPP)
+ #
+ # SOLUTION: Hack up a version of ExtUtils::MM_Unix to permit an
+ # assignment to XSUBPPPARENTDIR. Place this version in that same
+ # directory!
+
+ $bfile = defined $gitlib
+ ? qq{-I$gitlib Makefile.PL}
+ : q{Makefile.PL};
+ $bprogram = q{make};
+ $builder = q{EUMM};
+ }
+ $exit_code = system(qq{$^X $bfile && $bprogram});
+}
+
+sub successful_eumm_or_mb {
+ my $builds_file = shift;
+ my (@eumm_distros, @mb_distros);
+ open my $IN, '<', $builds_file
+ or croak "Unable to open $builds_file";
+ while (my $d = <$IN>) {
+ chomp $d;
+ my @data = split /:/, $d;
+ if ($data[1] eq 'EUMM') {
+ push @eumm_distros, $data[0];
+ }
+ elsif ($data[1] eq 'MB') {
+ push @mb_distros, $data[0];
+ }
+ else {
+ carp "$data[0] mysterious";
+ }
+ }
+ close $IN or croak "Unable to close $builds_file";
+ return (\@eumm_distros, \@mb_distros);
+}
+
+sub prepare_list_of_random_distros {
+ my ($eumm_file, $count) = @_;
+ my (@all_good_eumm_xs_distros, @indices, @selected_eumm_xs_distros);
+ tie @all_good_eumm_xs_distros, 'Tie::File', $eumm_file
+ or croak "Unable to tie";
+ my $good_distro_count = scalar(@all_good_eumm_xs_distros);
+ my $rand = int(rand($good_distro_count));
+ for (my $i=0; $i<$count; $i++) {
+ my $idx = $rand + (3*$i);
+ if ($idx > $good_distro_count) {
+ $idx -= $good_distro_count;
+ }
+ push @indices, $idx;
+ }
+ #say Dumper \@indices;
+ foreach my $idx (@indices) {
+ push @selected_eumm_xs_distros, $all_good_eumm_xs_distros[$idx];
+ }
+ untie @all_good_eumm_xs_distros or croak "Unable to untie";
+ #say Dumper \@selected_eumm_xs_distros;
+ return \@selected_eumm_xs_distros;
+}
+
+1;

0 comments on commit 076c71f

Please sign in to comment.
Something went wrong with that request. Please try again.