view release on metacpan or  search on metacpan

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

    }

    # Process other arguments.  The first two non-option arguments are dest
    # dir and project dir, if --from and --to were not given.
    $hrOptsOut->{DEST_DIR} //= $params{from}->[0] if @{$params{from}};
    $hrOptsOut->{PROJ_DIR} //= $params{from}->[1] if @{$params{from}}>1;

    # Sanity check VERBOSE2, and give it a default of 0
    my $v2 = $hrOptsOut->{VERBOSE2} // 0;
    $v2 = 1 if $v2 eq '';   # --verbose without value === --verbose=1
    die "--verbose requires a positive numeric argument"
        if (defined $v2) && ( !looks_like_number($v2) || (int($v2) < 0) );
    $hrOptsOut->{VERBOSE2} = int($v2 // 0);

} #_parse_command_line() }}}2

# }}}1
# === Main worker code ================================================== {{{1


sub _execute_hopen_file {       # Load and run a single hopen file {{{2

=head2 _execute_hopen_file

Execute a single hopen file, but B<do not> run the DAG.  Usage:

    _execute_hopen_file($filename[, options...])

This function takes input from L</$_hrData> unless a C<< DATA=>{...} >> option
is given.  This function updates L</$_hrData> based on the results.

Options are:

=over

=item phase

If given, force the phase to be the one specified.

=item quiet

If truthy, suppress extra output.

=item libs

If given, it must be an arrayref of directories.  Each of those will be
turned into a C<use lib> statement (see L<lib>) in the generated source.

=back

=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";

    my $lib_dirs = '';
    if($opts{libs}) {
        $lib_dirs .= "use lib '" .  (dir($_)->absolute =~ s/'/\\'/gr) .  "';\n"
            foreach @{$opts{libs}};
    }

    # == Make the hopen file into a package we can eval ==

    my ($friendly_name, $pkg_name, $file_text, $phase_text);

    $phase_text = q(
        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.

    # -- Build the package

    # TODO move phase-setting to App::hopen::MYhopen
    # TODO set $App::hopen::MYhopen::IsMYH to indicate whether or not this
    # file is MY.hopen.pl.
    my $src = line_mark_string <<EOT ;
{
    package __Rpkg_$pkg_name;
    use App::hopen::HopenFileKit "\Q$friendly_name\E";
        # \\Q and \\E since, on Windows, \$friendly_name is likely to
        # include backslashes.

    # Other lib dirs
    $lib_dirs
    # /Other lib dirs

    # Other phase text
    $phase_text
    # /Other phase text
EOT

    # Now shadow $Phase so the hopen file can't change it without
    # really trying!  Note that we actually interpolate the current
    # phase in as a literal so that it's read-only (see perlmod).

    unless($setting_phase_allowed) {
        $src .= line_mark_string <<EOT;
    our \$Phase;
    local *Phase = \\"$Phase";
EOT
    }

    # Run the code given in the hopen file.  Wrap it in a named BLOCK so that
    # Phases::on() will work, but don't rely on the return value of that
    # BLOCK (per perlsyn).

    $src .= line_mark_string <<EOT;

    sub __Rsub_$pkg_name {
        my \$__R_retval;
        __R_DO: {
            \$__R_retval = do {   # return statements in here will exit the Rsub
#line 1 "$friendly_name"
$file_text
            }; # do{}
        } #__R_DO
EOT

    # If the file_text did not expressly return(), control will reach the
    # following block, where we get the correct return value.  If the file_text