view release on metacpan or  search on metacpan

lib/Parse/PMFile.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},
        ) {