Plack-App-MCCS

 view release on metacpan or  search on metacpan

local/bin/findrule  view on Meta::CPAN

    next unless -d $dir;
    my @pm = find( name => '*.pm', maxdepth => 1,
                   exec => sub { (my $name = $_) =~ s/\.pm$//;
                                 eval "require File::Find::Rule::$name"; },
                   in => $dir );
}

# what directories are we searching in?
my @where;
while (@ARGV) {
    local $_ = shift @ARGV;
    if (/^-/) {
        unshift @ARGV, $_;
        last;
    }
    push @where, $_;
}

# parse arguments, build a rule object
my $rule = new File::Find::Rule;
while (@ARGV) {

local/lib/perl5/App/Cmd/ArgProcessor.pm  view on Meta::CPAN

use strict;
use warnings;

package App::Cmd::ArgProcessor 0.335;

# ABSTRACT: App::Cmd-specific wrapper for Getopt::Long::Descriptive

sub _process_args {
  my ($class, $args, @params) = @_;
  local @ARGV = @$args;

  require Getopt::Long::Descriptive;
  Getopt::Long::Descriptive->VERSION(0.084);

  my ($opt, $usage) = Getopt::Long::Descriptive::describe_options(@params);

  return (
    $opt,
    [ @ARGV ], # whatever remained
    usage => $usage,

local/lib/perl5/App/Cmd/Tester.pm  view on Meta::CPAN

#pod
#pod =method test_app
#pod
#pod B<Note>: while C<test_app> is a method, it is by default exported as a
#pod subroutine into the namespace that uses App::Cmd::Tester.  In other words: you
#pod probably don't need to think about this as a method unless you want to subclass
#pod App::Cmd::Tester.
#pod
#pod   my $result = test_app($app_class => \@argv_contents);
#pod
#pod This will locally set C<@ARGV> to simulate command line arguments, and will
#pod then call the C<run> method on the given application class (or application).
#pod Output to the standard output and standard error filehandles  will be captured.
#pod
#pod C<$result> is an App::Cmd::Tester::Result object, which has methods to access
#pod the following data:
#pod
#pod   stdout - the output sent to stdout
#pod   stderr - the output sent to stderr
#pod   output - the combined output of stdout and stderr
#pod   error  - the exception thrown by running the application, or undef

local/lib/perl5/App/Cmd/Tester.pm  view on Meta::CPAN

  require IO::TieCombine;
  my $hub = IO::TieCombine->new;

  my $stdout = tie local *STDOUT, $hub, 'stdout';
  my $stderr = tie local *STDERR, $hub, 'stderr';

  my $run_rv;

  my $ok = eval {
    local $TEST_IN_PROGRESS = 1;
    local @ARGV = @$argv;
    $run_rv = $app->run;
    1;
  };

  my $error = $ok ? undef : $@;

  return {
    stdout => $hub->slot_contents('stdout'),
    stderr => $hub->slot_contents('stderr'),
    output => $hub->combined_contents,

local/lib/perl5/App/Cmd/Tester.pm  view on Meta::CPAN

=head2 test_app

B<Note>: while C<test_app> is a method, it is by default exported as a
subroutine into the namespace that uses App::Cmd::Tester.  In other words: you
probably don't need to think about this as a method unless you want to subclass
App::Cmd::Tester.

  my $result = test_app($app_class => \@argv_contents);

This will locally set C<@ARGV> to simulate command line arguments, and will
then call the C<run> method on the given application class (or application).
Output to the standard output and standard error filehandles  will be captured.

C<$result> is an App::Cmd::Tester::Result object, which has methods to access
the following data:

  stdout - the output sent to stdout
  stderr - the output sent to stderr
  output - the combined output of stdout and stderr
  error  - the exception thrown by running the application, or undef

local/lib/perl5/App/Cmd/Tester/CaptureExternal.pm  view on Meta::CPAN

#pod =cut

sub _run_with_capture {
  my ($class, $app, $argv) = @_;

  my $run_rv;

  my ($stdout, $stderr, $ok) = capture {
    eval {
      local $App::Cmd::Tester::TEST_IN_PROGRESS = 1;
      local @ARGV = @$argv;
      $run_rv = $app->run;
      1;
    };
  };

  my $error = $ok ? undef : $@;

  return {
    stdout => $stdout,
    stderr => $stderr,

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

sub new_from_context {
  my ($package, %args) = @_;

  $package->run_perl_script('Build.PL',[],[$package->unparse_args(\%args)]);
  return $package->resume;
}

sub current {
  # hmm, wonder what the right thing to do here is
  local @ARGV;
  return shift()->resume;
}

sub _construct {
  my ($package, %input) = @_;

  my $args   = delete $input{args}   || {};
  my $config = delete $input{config} || {};

  my $self = bless {

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

        my $v = $specs->{$k};
        # Throw an error if specs conflict with our own.
        die "Option specification '$k' conflicts with a " . ref $self
          . " option of the same name"
          if $self->valid_property($k);
        push @specs, $k . (defined $v->{type} ? $v->{type} : '');
        push @specs, $v->{store} if exists $v->{store};
        $args->{$k} = $v->{default} if exists $v->{default};
    }

    local @ARGV = @argv; # No other way to dupe Getopt::Long

    # Get the options values and return them.
    # XXX Add option to allow users to set options?
    if ( @specs ) {
      Getopt::Long::Configure('pass_through');
      Getopt::Long::GetOptions($args, @specs);
    }

    return $args, @ARGV;
}

local/lib/perl5/Perl/Tidy.pm  view on Meta::CPAN

        converged         => 0,
        blinking          => 0,
    };

    # Fix for issue git #57
    $Warn_count = 0;

    # don't overwrite callers ARGV
    # Localization of @ARGV could be avoided by calling GetOptionsFromArray
    # instead of GetOptions, but that is not available before perl 5.10
    local @ARGV   = @ARGV;
    local *STDERR = *STDERR;

    if ( my @bad_keys = grep { !exists $defaults{$_} } keys %input_hash ) {
        local $LIST_SEPARATOR = ')(';
        my @good_keys = sort keys %defaults;
        @bad_keys = sort @bad_keys;
        confess <<EOM;
------------------------------------------------------------------------
Unknown perltidy parameter : (@bad_keys)
perltidy only understands : (@good_keys)

local/lib/perl5/Perl/Tidy.pm  view on Meta::CPAN

    my (
        $roption_string,   $rdefaults, $rexpansion,
        $roption_category, $roption_range
    ) = generate_options();

    #--------------------------------------------------------------
    # set the defaults by passing the above list through GetOptions
    #--------------------------------------------------------------
    my %Opts = ();
    {
        local @ARGV = ();

        # do not load the defaults if we are just dumping perltidyrc
        unless ( $dump_options_type eq 'perltidyrc' ) {
            for my $i ( @{$rdefaults} ) { push @ARGV, "--" . $i }
        }
        if ( !GetOptions( \%Opts, @{$roption_string} ) ) {
            Die(
"Programming Bug reported by 'GetOptions': error in setting default options"
            );
        }

local/lib/perl5/Perl/Tidy.pm  view on Meta::CPAN

        if ($fh_config) {

            my ( $rconfig_list, $death_message ) =
              read_config_file( $fh_config, $config_file, $rexpansion );
            Die($death_message) if ($death_message);

            # process any .perltidyrc parameters right now so we can
            # localize errors
            if ( @{$rconfig_list} ) {
                local @ARGV = @{$rconfig_list};

                expand_command_abbreviations( $rexpansion, \@raw_options,
                    $config_file );

                if ( !GetOptions( \%Opts, @{$roption_string} ) ) {
                    Die(
"Error in this config file: $config_file  \nUse -npro to ignore this file, -h for help'\n"
                    );
                }

                # Anything left in this local @ARGV is an error and must be
                # invalid bare words from the configuration file.  We cannot
                # check this earlier because bare words may have been valid
                # values for parameters.  We had to wait for GetOptions to have
                # a look at @ARGV.
                if (@ARGV) {
                    my $count = @ARGV;
                    my $str   = "\'" . pop(@ARGV) . "\'";
                    while ( my $param = pop(@ARGV) ) {
                        if ( length($str) < 70 ) {
                            $str .= ", '$param'";

local/lib/perl5/Plack/Runner.pm  view on Meta::CPAN

# delay the build process for reloader
sub build(&;$) {
    my $block = shift;
    my $app   = shift || sub { };
    return sub { $block->($app->()) };
}

sub parse_options {
    my $self = shift;

    local @ARGV = @_;

    # From 'prove': Allow cuddling the paths with -I, -M and -e
    @ARGV = map { /^(-[IMe])(.+)/ ? ($1,$2) : $_ } @ARGV;

    my($host, $port, $socket, @listen);

    require Getopt::Long;
    my $parser = Getopt::Long::Parser->new(
        config => [ "no_auto_abbrev", "no_ignore_case", "pass_through" ],
    );

local/lib/perl5/Plack/Util.pm  view on Meta::CPAN

    $class . ".pm";
}

sub _load_sandbox {
    my $_file = shift;

    my $_package = $_file;
    $_package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", unpack("C", $1))/eg;

    local $0 = $_file; # so FindBin etc. works
    local @ARGV = ();  # Some frameworks might try to parse @ARGV

    return eval sprintf <<'END_EVAL', $_package;
package Plack::Sandbox::%s;
{
    my $app = do $_file;
    if ( !$app && ( my $error = $@ || $! )) { die $error; }
    $app;
}
END_EVAL
}