App-hopen

 view release on metacpan or  search on metacpan

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

434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
=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

495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
    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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#!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

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
    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();