view release on metacpan or  search on metacpan

lib/Perl/PrereqScanner/NotQuiteLite.pm  view on Meta::CPAN

        $mapping{keyword}{$name} = [
          $parser,
          $fqfn_mapping->{$name},
          $module,
        ];
      }
    }
  }
  $args{_} = \%mapping;

  bless \%args, $class;
}

sub _get_parsers {
  my ($class, $list) = @_;
  my @parsers;
  my %should_ignore;
  for my $parser (@{$list || [qw/:default/]}) {
    if ($parser eq ':installed') {
      require Module::Find;
      push @parsers, Module::Find::findsubmod("$class\::Parser");
    } elsif ($parser eq ':bundled') {
      push @parsers, map {"$class\::Parser::$_"} @BUNDLED_PARSERS;
    } elsif ($parser eq ':default') {
      push @parsers, map {"$class\::Parser::$_"} @DEFAULT_PARSERS;
    } elsif ($parser =~ s/^\+//) {
      push @parsers, $parser;
    } elsif ($parser =~ s/^\-//) {
      $should_ignore{"$class\::Parser\::$parser"} = 1;
    } elsif ($parser =~ /^$class\::Parser::/) {
      push @parsers, $parser;
    } else {
      push @parsers, "$class\::Parser\::$parser";
    }
  }
  grep {!$should_ignore{$_}} @parsers;
}

sub scan_file {
  my ($self, $file) = @_;
  _debug("START SCANNING $file") if DEBUG;
  print STDERR " Scanning $file\n" if $self->{verbose};
  open my $fh, '<', $file or croak "Can't open $file: $!";
  my $code = do { local $/; <$fh> };
  $self->{file} = $file;
  $self->scan_string($code);
}

sub scan_string {
  my ($self, $string) = @_;

  $string = '' unless defined $string;

  my $c = Perl::PrereqScanner::NotQuiteLite::Context->new(%$self);

  if ($self->{quick}) {
    $c->{file_size} = length $string;
    $self->_skim_string($c, \$string) if $c->{file_size} > 30_000;
  }

  # UTF8 BOM
  if ($string =~ s/\A(\xef\xbb\xbf)//s) {
    utf8::decode($string);
    $c->{decoded} = 1;
  }
  # Other BOMs (TODO: also decode?)
  $string =~ s/\A(\x00\x00\xfe\xff|\xff\xfe\x00\x00|\xfe\xff|\xff\xfe)//s;

  # normalize
  if ("\n" eq "\015") {
    $string =~ s/(?:\015?\012)/\n/gs;
  } elsif ("\n" eq "\012") {
    $string =~ s/(?:\015\012?)/\n/gs;
  } elsif ("\n" eq "\015\012") {
    $string =~ s/(?:\015(?!\012)|(?<!\015)\012)/\n/gs;
  } else {
    $string =~ s/(?:\015\012|\015|\012)/\n/gs;
  }
  $string =~ s/[ \t]+/ /g;
  $string =~ s/(?: *\n)+/\n/gs;

  # FIXME
  $c->{stack} = [];
  $c->{errors} = [];
  $c->{callback} = {
    use     => \&_use,
    require => \&_require,
    no      => \&_no,
  };
  $c->{wants_doc} = 0;

  pos($string) = 0;

  {
    local $@;
    eval { $self->_scan($c, \$string, 0) };
    push @{$c->{errors}}, "Scan Error: $@" if $@;
    if ($c->{redo}) {
      delete $c->{redo};
      delete $c->{ended};
      @{$c->{stack}} = ();
      redo;
    }
  }

  if (@{$c->{stack}} and !$c->{quick}) {
    require Data::Dump;
    push @{$c->{errors}}, Data::Dump::dump($c->{stack});
  }

  $c->remove_inner_packages_from_requirements;
  $c->merge_perl;

  $c;
}

sub _skim_string {
  my ($self, $c, $rstr) = @_;
  my $pos = pos($$rstr) || 0;
  my $last_found = 0;
  my $saw_moose;
  my $re = qr/\G.*?\b((?:use|require|no)\s+(?:[A-Za-z][A-Za-z0-9_]*::)*[A-Za-z][A-Za-z0-9_]*)/;
  while(my ($match) = $$rstr =~ /$re/gc) {
    $last_found = pos($$rstr) + length $match;
    if (!$saw_moose and $match =~ /^use\s+(?:Mo(?:o|(?:[ou]se))?X?|MooseX::Declare)\b/) {
      $re = qr/\G.*?\b((?:(?:use|require|no)\s+(?:[A-Za-z][A-Za-z0-9_]*::)*[A-Za-z][A-Za-z0-9_]*)|(?:(?:extends|with)\s+(?:["']|q[a-z]*[^a-zA-Z0-9_])(?:[A-Za-z][A-Za-z0-9_]*::)*[A-Za-z][A-Za-z0-9_]*))/;