view release on metacpan or  search on metacpan

lib/Multi/Dispatch.pm  view on Meta::CPAN

                                        $^H{'Multi::Dispatch debug'}    = 1; }
  if (grep /\A-?verbose\Z/, @_)       { $^H{'Multi::Dispatch verbose'}  = 1; }
  if (grep /\A-?annotate\Z/, @_)      { $^H{'Multi::Dispatch annotate'} = 1; }

  # Set up for redispatch...
  my $redispatcher = '$' . join q{}, map { ('a'..'z', 'A'..'Z')[rand 52] } 1..20;

  # Enable warnings for this module class...
  warnings->import('Multi::Dispatch');

  Keyword::Simple::define multi       => gen_handler_for('multi', (caller)[0]);
  Keyword::Simple::define multimethod => gen_handler_for('multimethod', (caller)[0]);
}

sub _annotate {
    my ($package, $file) = @_;

    # Only call once per file...
    state $seen;
    return if $seen->{$file}++;

    # Iterate the package's various multis...

lib/Multi/Dispatch.pm  view on Meta::CPAN

    # Generate the dispatch code...
    my $code = q{
            <ADDSELF>
            <VERBOSE>
            my @failures;
            </VERBOSE>
            <DEBUG>
            warn sprintf "\nDispatching call to <NAME>("
                        . join(', ', map({Data::Dump::dump($_)} @_))
                        . ") at %s line %s\\n", (caller)[1,2];
            </DEBUG>
            while (my $variant = shift @variants) {
                # Skip variants that can't possibly work...
                <VERBOSE>
                # Extract the debugging information...
                my ($level, $name, $package, $file, $line)
                    = @{$variant}{qw<level name pack file line>};
                $name = $package.'::'.$name;
                </VERBOSE>

lib/Multi/Dispatch.pm  view on Meta::CPAN

            }

            <UPDISPATCH>

            # If no viable variant, throw an exception (with the extra debugging info)...
            <VERBOSE>
            if (1 == grep /-->/, @failures) {
                die sprintf( "Can't call <NAME>(%s)\\n"
                        . "at %s line %s\\n",
                            join(', ', map({Data::Dump::dump($_)} @_)),
                            (caller)[1,2]), map { s/SKIPPED: //r } grep /-->/, @failures;
            }
            </VERBOSE>
            die sprintf( "No suitable variant for call to <KEYWORD> <NAME>()\\n"
                       . "with arguments: (%s)\\n"
                       . "at %s line %s\\n",
                         join(', ', map({Data::Dump::dump($_)} @_)),
                         (caller)[1,2]) <VERBOSE>, @failures</VERBOSE>;

    } =~ s{ <VERBOSE> (.*?) </VERBOSE> }{ $arg{verbose}  ? $1                             : q{} }egxmsr
      =~ s{   <DEBUG> (.*?) </DEBUG>   }{ $arg{debug}    ? $1                             : q{} }egxmsr
      =~ s{       <VARIANT_CODE>       }{ $arg{invocant} ? q{$_[0]->${\$variant->{code}}(@_[1..$#_])}
                                                         : q{&{$variant->{code}}} }egxmsr
      =~ s{        <ADDSELF>           }{ $arg{invocant} ? "unshift \@_, $arg{invocant};" : q{} }egxmsr
      =~ s{       <UPDISPATCH>         }{ $updispatch }egxmsr
      =~ s{      < ([A-Z_]++) >        }{ $arg{lc $1} // die 'Internal error' }egxmsr
      =~ s{        \s \# \N*           }{}gxmsr;