view release on metacpan or  search on metacpan

lib/App/cpanminus/fatscript.pm  view on Meta::CPAN

      bless {%{ $opts || {} }, META_CONTENT => $meta}, $class;
  }
  
  # from PAUSE::pmfile::examine_fio
  sub parse {
      my ($self, $pmfile) = @_;
  
      $pmfile =~ s|\\|/|g;
  
      my($filemtime) = (stat $pmfile)[9];
      $self->{MTIME} = $filemtime;
      $self->{PMFILE} = $pmfile;
  
      unless ($self->_version_from_meta_ok) {
          my $version;
          unless (eval { $version = $self->_parse_version; 1 }) {
            $self->_verbose(1, "error with version in $pmfile: $@");
            return;
          }
  
          $self->{VERSION} = $version;
          if ($self->{VERSION} =~ /^\{.*\}$/) {
              # JSON error message
          } elsif ($self->{VERSION} =~ /[_\s]/ && !$self->{ALLOW_DEV_VERSION} && !$ALLOW_DEV_VERSION){   # ignore developer releases and "You suck!"
              return;
          }
      }
  
      my($ppp) = $self->_packages_per_pmfile;
      my @keys_ppp = $self->_filter_ppps(sort keys %$ppp);
      $self->_verbose(1,"Will check keys_ppp[@keys_ppp]\n");
  
      #
      # Immediately after each package (pmfile) examined contact
      # the database
      #
  
      my ($package, %errors);
      my %checked_in;
    DBPACK: foreach $package (@keys_ppp) {
          # this part is taken from PAUSE::package::examine_pkg
          # and PAUSE::package::_pkg_name_insane
          if ($package !~ /^\w[\w\:\']*\w?\z/
           || $package !~ /\w\z/
           || $package =~ /:/ && $package !~ /::/
           || $package =~ /\w:\w/
           || $package =~ /:::/
          ){
              $self->_verbose(1,"Package[$package] did not pass the ultimate sanity check");
              delete $ppp->{$package};
              next;
          }
  
          if ($self->{USERID} && $self->{PERMISSIONS} && !$self->_perm_check($package)) {
              delete $ppp->{$package};
              next;
          }
  
          # Check that package name matches case of file name
          {
            my (undef, $module) = split m{/lib/}, $self->{PMFILE}, 2;
            if ($module) {
              $module =~ s{\.pm\z}{};
              $module =~ s{/}{::}g;
  
              if (lc $module eq lc $package && $module ne $package) {
                # warn "/// $self->{PMFILE} vs. $module vs. $package\n";
                $errors{$package} = {
                  indexing_warning => "Capitalization of package ($package) does not match filename!",
                  infile => $self->{PMFILE},
                };
              }
            }
          }
  
          my $pp = $ppp->{$package};
          if ($pp->{version} && $pp->{version} =~ /^\{.*\}$/) { # JSON parser error
              my $err = JSON::PP::decode_json($pp->{version});
              if ($err->{x_normalize}) {
                  $errors{$package} = {
                      normalize => $err->{version},
                      infile => $pp->{infile},
                  };
                  $pp->{version} = "undef";
              } elsif ($err->{openerr}) {
                  $pp->{version} = "undef";
                  $self->_verbose(1,
                                qq{Parse::PMFile was not able to
          read the file. It issued the following error: C< $err->{r} >},
                                );
                  $errors{$package} = {
                      open => $err->{r},
                      infile => $pp->{infile},
                  };
              } else {
                  $pp->{version} = "undef";
                  $self->_verbose(1, 
                                qq{Parse::PMFile was not able to
          parse the following line in that file: C< $err->{line} >
  
          Note: the indexer is running in a Safe compartement and cannot
          provide the full functionality of perl in the VERSION line. It
          is trying hard, but sometime it fails. As a workaround, please
          consider writing a META.yml that contains a 'provides'
          attribute or contact the CPAN admins to investigate (yet
          another) workaround against "Safe" limitations.)},
  
                                );
                  $errors{$package} = {
                      parse_version => $err->{line},
                      infile => $err->{file},
                  };
              }
          }
  
          # Sanity checks
  
          for (
              $package,
              $pp->{version},
          ) {