view release on metacpan or  search on metacpan

lib/App/Critique/Command/collect.pm  view on Meta::CPAN

    );

    my @partitions = map {
        [
            (($partition_size * $_) - $partition_size) + (($_ == 1) ? 0 : 1),
            ($partition_size * $_),
        ]
    } 1 .. $num_procs;

    # this will come out to length + 1
    # so we want to trim off the end
    $partitions[ -1 ]->[ 1 ]--;
    # then add the remainder here
    $partitions[ -1 ]->[ 1 ] += $remainder;

PROCESS_LOOP:
    while ( @partitions ) {
        my ($start, $end) = @{ shift @partitions };

        #use Data::Dumper;
        #warn Dumper [ $start, $end ];

        $pm->start and next PROCESS_LOOP;

        my @filtered;

        foreach my $i ( $start .. $end ) {
            my $path = $all->[ $i ];

            info('[%d] Processing file %s', $$, $path);
            if ( $filter->( $root, $path ) ) {
                info(BOLD('[%d] Keeping file %s'), $$, $path);
                push @filtered => $path;
            }
        }

        $pm->finish(0, \@filtered);
    }

    $pm->wait_all_children;

    @$all = @filtered_all;
}

sub filter_files_serially {
    my %args   = @_;
    my $root   = $args{root}; # the reason for `root` is to pass to the filter
    my $all    = $args{files};
    my $filter = $args{filter};

    local $SIG{INT} = sub { $PAUSE_PROCESSING++ };

    my $num_processed = 0;

    my @filtered_all;
    while ( @$all ) {
        if ( $PAUSE_PROCESSING ) {
            warning('[processing paused]');

        PROMPT:
            my $continue = prompt_str(
                '>> (r)esume (h)alt (a)bort | (s)tatus ',
                {
                    valid   => sub { $_[0] =~ m/[rhas]{1}/ },
                    default => 'r',
                }
            );

            if ( $continue eq 'r' ) {
                warning('[resuming]');
                $PAUSE_PROCESSING = 0;
            }
            elsif ( $continue eq 'h' ) {
                warning('[halt processing - retaining results accumulated so far]');
                last;
            }
            elsif ( $continue eq 'a' ) {
                warning('[abort processing - discarding all results]');
                @filtered_all = ();
                last;
            }
            elsif ( $continue eq 's' ) {
                warning( join "\n" => @filtered_all );
                warning('[Processed %d files so far]', $num_processed );
                warning('[Accumulated %d files so far]', scalar @filtered_all );
                goto PROMPT;
            }
        }

        my $path = shift @$all;

        info('Processing file %s', $path);
        if ( $filter->( $root, $path ) ) {
            info(BOLD('Keeping file %s'), $path);
            push @filtered_all => $path;
        }

        $num_processed++;
    }

    @$all = @filtered_all;
}

sub find_all_perl_files {
    my %args = @_;
    my $root = $args{root}; # the reason for `root` is to have nicer output (just FYI)
    my $path = $args{path};
    my $acc  = $args{accumulator};

    if ( $path->is_file ) {
        # ignore anything but perl files ...
        return unless is_perl_file( $path->stringify );

        info('... adding file (%s)', $path->relative( $root )); # this should be the only usafe of root
        push @$acc => $path;
    }
    elsif ( -l $path ) { # Path::Tiny does not have a test for symlinks
        ;
    }
    else {
        my @children = $path->children( qr/^[^.]/ );