view release on metacpan or  search on metacpan

builder/Affix/Builder.pm  view on Meta::CPAN

            say "=" x 60;
            push @fuzz_scripts, $script->stringify;
        }
        if (@fuzz_scripts) {
            local $ENV{FUZZ_MAX_ITER} = $iters;
            local $ENV{FUZZ_TIMEOUT}  = $to;
            local $ENV{FUZZ_VERBOSE}  = $verbose_fuzz;
            my %harness_args
                = ( ( verbosity => $verbose ), ( color => -t STDOUT ), lib => [ map { rel2abs( catdir( 'blib', $_ ) ) } qw[arch lib] ], );
            my $harness = TAP::Harness::Env->create( \%harness_args );
            my $aggr    = $harness->runtests( sort @fuzz_scripts );
            $failures++ if $aggr->has_errors;
            say "";
        }

        # Smoke test: also quick-build C targets if available
        if ( $args{smoke} || $args{all} ) {
            my $build_pl = path('infix/build.pl');
            if ( -f $build_pl ) {
                for my $name ( sort keys %c_targets ) {
                    say "=" x 60;
                    say "Building C fuzz target: fuzz:$name";
                    say "  $c_targets{$name}";
                    say "=" x 60;
                    my $exit = system( $^X, $build_pl->stringify, "fuzz:$name" );
                    $failures++ if $exit != 0;
                    say "";
                }
            }
            else {
                say "Skipping C fuzz targets (infix/build.pl not found)";
            }
        }
        say "=" x 60;
        if ($failures) {
            say "FAILED: $failures target(s) reported crashes or build errors";
        }
        else {
            say "All fuzz targets clean.";
        }
        return $failures > 0 ? 1 : 0;
    }

    method get_arguments (@sources) {
        $_ = detildefy($_) for grep {defined} $install_base, $destdir, $prefix, values %{$install_paths};
        $install_paths = ExtUtils::InstallPaths->new( dist_name => $meta->name );
        return;
    }

    method Build(@args) {
        my $method = $self->can( 'step_' . $action );
        $method // die "No such action '$action'\n";
        exit $method->( $self, @args );
    }

    method Build_PL() {
        die "Pure perl Affix? Ha! You wish.\n" if $pureperl;
        say sprintf 'Creating new Build script for %s %s', $meta->name, $meta->version;
        $self->write_file( 'Build', sprintf <<'', $^X, __PACKAGE__, __PACKAGE__ );
#!%s
use lib 'builder';
use %s;
my $action = @ARGV && $ARGV[0] =~ /\A\w+\z/ ? shift @ARGV : 'build';
my $opts = {};
while ( @ARGV ) {
    my $a = shift @ARGV;
    if ( $a =~ /^-(\w+)$/ ) { $opts->{$1} = shift @ARGV // 1; }
    elsif ( $a =~ /^-(\w+)=(.+)$/ ) { $opts->{$1} = $2; }
}
%s->new( action => $action )->Build( %%$opts );

        make_executable('Build');
        my @env = defined $ENV{PERL_MB_OPT} ? split_like_shell( $ENV{PERL_MB_OPT} ) : ();
        $self->write_file( '_build_params', encode_json( [ \@env, \@ARGV ] ) );
        if ( my $dynamic = $meta->custom('x_dynamic_prereqs') ) {
            my %meta = ( %{ $meta->as_struct }, dynamic_config => 1 );
            $self->get_arguments( \@env, \@ARGV );
            require CPAN::Requirements::Dynamic;
            my $dynamic_parser = CPAN::Requirements::Dynamic->new();
            my $prereq         = $dynamic_parser->evaluate($dynamic);
            $meta{prereqs} = $meta->effective_prereqs->with_merged_prereqs($prereq)->as_string_hash;
            $meta = CPAN::Meta->new( \%meta );
        }
        $meta->save(@$_) for ['MYMETA.json'];
    }

    sub find ( $pattern, $base ) {
        $base = path($base) unless builtin::blessed $base;
        my $blah = $base->visit(
            sub ( $path, $state ) {
                $state->{$path} = $path if $path =~ $pattern;
            },
            { recurse => 1 }
        );
        values %$blah;
    }

    # infix builder
    method step_clone_infix() {
        return if cwd->absolute->child('infix')->exists;
        my $clone_dir = cwd->absolute->child('infix');
        die 'Failed to clone infix' if system( 'git', 'clone', '--depth', '1', 'https://github.com/sanko/infix.git', $clone_dir->stringify );
    }

    method step_infix () {
        $self->step_clone_infix();
        my $cwd       = cwd->absolute;
        my $infix_dir = $cwd->child('infix');

        # Use architecture-specific directory to avoid collision on shared filesystems (WSL vs Windows)
        my $build_lib = $infix_dir->child( 'build_lib', $Config{archname} );

        # If library already exists and is newer than source, we are good.
        my $is_msvc  = ( $Config{cc} =~ /cl(\.exe)?$/i );
        my $lib_ext  = $is_msvc ? '.lib' : '.a';
        my $lib_pre  = $is_msvc ? ''     : 'lib';
        my $lib_file = $build_lib->child( $lib_pre . 'infix' . $lib_ext );
        my $src_file = $infix_dir->child( 'src', 'infix.c' );
        if ( -e $lib_file && !$force ) {

            # Check timestamps to ensure we rebuild if source changed