view release on metacpan or  search on metacpan

lib/Sub/Multi/Tiny/Util.pm  view on Meta::CPAN

    $code .= _line_mark_string <<EOT;
            # Create the guard
            my \$guard = Guard::guard {

$restore

            }; #End of guard
EOT

    $code .= _line_mark_string <<'EOT';

            # Copy the parameters into the variables the candidate
            # will access them from
            &$copier;   # $copier gets @_ automatically

            # Pass the guard so the parameters will be reset once \$candidate
            # finishes running.
            @_ = ($guard);

            # Invoke the selected candidate
            goto &$candidate;
        } #dispatcher
EOT

    _hlog { $caller, "dispatcher for $hr->{defined_in}\():\n$code\n" } 2;
    my $sub = eval $code;
    die "Could not create dispatcher for $hr->{defined_in}: $@" if $@;
    return $sub;
} # _complete_dispatcher

=head2 _make_positional_copier

Make a sub to copy from @_ into package variables.  The resulting sub copies
positional parameters.  Usage:

    my $coderef = _make_positional_copier($defined_in, $impl_hashref);

The copier is run under L<strict> and L<warnings>, for what it's worth.

=cut

our $_positional_copier_invocation_number = 0;  # DEBUG
sub _make_positional_copier {
    my ($defined_in, $impl) = @_;
    my $argref = \@_;   # For hlogging

    my @vars;   #DEBUG

    _hlog { require Data::Dumper;
        Data::Dumper->Dump($argref,[qw(mpc_defined_in mpc_impl)]) } 2;

    my $code = _line_mark_string <<'EOT';
use strict;
use warnings;
sub {
EOT

    # XXX DEBUG: Some extra output to try to debug failures on earlier Perls.
    $code .= _line_mark_string <<'EOT';
    if( $] lt '5.018' || $VERBOSE > 1) {
        require Data::Dumper;
        require Test::More;
        Test::More::diag(sprintf("Positional copier invocation %d:\n%s",
            ++$Sub::Multi::Tiny::Util::_positional_copier_invocation_number,
            Data::Dumper->Dump([\@_],['copier_args'])));
    }
EOT

    $code .= _line_mark_string <<'EOT';
    (
EOT

    @vars = map {
        my ($sigil, $name) = $_->{name} =~ m/^(.)(.+)$/;
        "${sigil}$defined_in\::${name}"
    } @{$impl->{args}};

    $code .= join ",\n",
                map { _line_mark_string
                        "        $_" } @vars;

    $code .= _line_mark_string <<'EOT';
    ) = @_;

    if( $] lt '5.018' || $VERBOSE > 1) {
        Test::More::diag(sprintf("After positional copier invocation %d:",
            $Sub::Multi::Tiny::Util::_positional_copier_invocation_number));
        Test::More::diag(join "\n", map {
            sprintf("%s = %s", $_, eval($_))
        } @vars);
    }

} #copier
EOT

    _hlog { "Copier for $impl->{candidate_name}\():\n", $code } 2;
    my $sub = eval $code;
    die "Could not create copier for $impl->{candidate_name}: $@" if $@;
    return $sub;
} #_make_positional_copier

1;
__END__

# Rest of documentation {{{1

=head1 AUTHOR

Chris White E<lt>cxw@cpan.orgE<gt>

=head1 LICENSE

Copyright (C) 2019 Chris White E<lt>cxw@cpan.orgE<gt>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

# }}}1
# vi: set fdm=marker: #