App-hopen

 view release on metacpan or  search on metacpan

lib/App/hopen.pm  view on Meta::CPAN

=cut

    my $fn = shift or croak 'Need a file to run';
    my %opts = @_;
    $Phase = $opts{phase} if $opts{phase};

    my $merger = Hash::Merge->new('RETAINMENT_PRECEDENT');

    # == Set up code pieces related to phase control ==

    my ($set_phase, $cannot_set_phase, $cannot_set_phase_warn);
    my $setting_phase_allowed = false;

    # Note: all phase-setting functions succeed if there was nothing
    # for them to do!

    $set_phase = q(
        sub can_set_phase { true }
        sub set_phase {
            my $new_phase = shift or croak 'Need a phase';
            return if $App::hopen::BuildSystemGlobals::Phase eq $new_phase;
            croak "Phase $new_phase is not one of the ones I know about (" .
                join(', ', @PHASES) . ')'
                    unless defined phase_idx($new_phase);
            $App::hopen::BuildSystemGlobals::Phase = $new_phase;
            $App::hopen::_did_set_phase = true;
    ) .
    ($opts{quiet} ? '' : 'say "Running $new_phase phase";') . "}\n";

    $cannot_set_phase = q(
        sub can_set_phase { false }
        sub set_phase {
            my $new_phase = shift // '';
            return if $App::hopen::BuildSystemGlobals::Phase eq $new_phase;
            croak "I'm sorry, but this file (``$FILENAME'') is not allowed to set the phase"
        }
    );

    $cannot_set_phase_warn = q(
        sub can_set_phase { false }
        sub set_phase {
            my $new_phase = shift // '';
            return if $App::hopen::BuildSystemGlobals::Phase eq $new_phase;
    ) .
    ($opts{quiet} ? '' :
        q(
            warn "``$FILENAME'': Ignoring attempt to set phase";
        )
    ) . "}\n";

lib/App/hopen.pm  view on Meta::CPAN

        use App::hopen::Phases ':all';
    );

    # -- Load the file

    if(ref $fn eq 'HASH') {       # it's a -e
        hlog { 'Processing', $fn->{name} };
        $file_text = $fn->{text};
        $friendly_name = $fn->{name};
        $pkg_name = 'CmdLineE' . $fn->{num} . '_' . $_hf_pkg_idx++;
        $phase_text .= defined($opts{phase}) ? $cannot_set_phase : $set_phase;
            # -e's can set phase unless --phase was specified

    } else {
        hlog { 'Processing', $fn };
        $file_text = file($fn)->slurp;
        $pkg_name = ($fn =~ s/[^a-zA-Z0-9]/_/gr) . '_' . $_hf_pkg_idx++;
        $friendly_name = $fn;

        if( isMYH($fn) and !defined($opts{phase}) ) {
            # MY.hopen.pl files can set $Phase unless --phase was given.
            $phase_text .= $set_phase;
            $setting_phase_allowed = true;

        } else {
            # For MY.hopen.pl, when --phase is set, set_phase doesn't croak.
            # If this were not the case, every second or subsequent run
            # of hopen(1) would croak if --phase were specified!
            $phase_text .= isMYH($fn) ? $cannot_set_phase_warn : $cannot_set_phase;
            # TODO? permit regular hopen files to set the the phase if
            # neither MYH nor the command line did, and we're at the first
            # phase.  This is so the hopen file can say `set_phase 'Gen';`
            # if there's nothing to do during Check.
        }
    } #endif -e else

    $friendly_name =~ s{"}{-}g;
        # as far as I can tell, #line can't handle embedded quotes.

xt/boilerplate.t  view on Meta::CPAN

#!perl
use 5.014;
use strict; use warnings;
use warnings;
use Test::More;
use File::Globstar 'globstar';

sub not_in_file_ok {
    my ($filename, %regex) = @_;
    open( my $fh, '<', $filename )
        or die "couldn't open $filename for reading: $!";

    my %violated;

    while (my $line = <$fh>) {
        while (my ($desc, $regex) = each %regex) {
            if ($line =~ $regex) {
                push @{$violated{$desc}||=[]}, $.;

xt/boilerplate.t  view on Meta::CPAN

    if (%violated) {
        fail("$filename contains boilerplate text");
        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
    } else {
        pass("$filename contains no boilerplate text");
    }
}

sub module_boilerplate_ok {
    my ($module) = @_;
    not_in_file_ok($module =>
        'the great new $MODULENAME'   => qr/ - The great new /,
        'boilerplate description'     => qr/Quick summary of what the module/,
        'stub function definition'    => qr/function[12]/,
    );
}


not_in_file_ok(README =>
"The README is used..."       => qr/The README is used/,
"'version information here'"  => qr/to provide version information/,
);

not_in_file_ok(Changes =>
"placeholder date/time"       => qr(Date/time)
);

module_boilerplate_ok $_ foreach
    grep { $_ !~ m/TEMPLATE/ } globstar('lib/**/*.pm');

done_testing();