view release on metacpan or  search on metacpan

lib/CPAN/Distribution.pm  view on Meta::CPAN

# no prepare, because prepare is not a command on the shell command line
# TODO: clear instance cache on reload
my %instance;
for my $method (qw(get make test install)) {
    no strict 'refs';
    for my $prefix (qw(pre post)) {
        my $hookname = sprintf "%s_%s", $prefix, $method;
        *$hookname = sub {
            my($self) = @_;
            for my $plugin (@{$CPAN::Config->{plugin_list}}) {
                my($plugin_proper,$args) = split /=/, $plugin, 2;
                $args = "" unless defined $args;
                if ($CPAN::META->has_inst($plugin_proper)){
                    my @args = split /,/, $args;
                    $instance{$plugin} ||= $plugin_proper->new(@args);
                    if ($instance{$plugin}->can($hookname)) {
                        $instance{$plugin}->$hookname($self);
                    }
                } else {
                    $CPAN::Frontend->mydie("Plugin '$plugin_proper' not found for hook '$hookname'");
                }
            }
        };
    }
}

# Accessors
sub cpan_comment {
    my $self = shift;
    my $ro = $self->ro or return;
    $ro->{CPAN_COMMENT}
}

#-> CPAN::Distribution::undelay
sub undelay {
    my $self = shift;
    for my $delayer (
                     "configure_requires_later",
                     "configure_requires_later_for",
                     "later",
                     "later_for",
                    ) {
        delete $self->{$delayer};
    }
}

#-> CPAN::Distribution::is_dot_dist
sub is_dot_dist {
    my($self) = @_;
    return substr($self->id,-1,1) eq ".";
}

# add the A/AN/ stuff
#-> CPAN::Distribution::normalize
sub normalize {
    my($self,$s) = @_;
    $s = $self->id unless defined $s;
    if (substr($s,-1,1) eq ".") {
        # using a global because we are sometimes called as static method
        if (!$CPAN::META->{LOCK}
            && !$CPAN::Have_warned->{"$s is unlocked"}++
           ) {
            $CPAN::Frontend->mywarn("You are visiting the local directory
  '$s'
  without lock, take care that concurrent processes do not do likewise.\n");
            $CPAN::Frontend->mysleep(1);
        }
        if ($s eq ".") {
            $s = "$CPAN::iCwd/.";
        } elsif (File::Spec->file_name_is_absolute($s)) {
        } elsif (File::Spec->can("rel2abs")) {
            $s = File::Spec->rel2abs($s);
        } else {
            $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
        }
        CPAN->debug("s[$s]") if $CPAN::DEBUG;
        unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
            for ($CPAN::META->instance("CPAN::Distribution", $s)) {
                $_->{build_dir} = $s;
                $_->{archived} = "local_directory";
                $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
            }
        }
    } elsif (
        $s =~ tr|/|| == 1
        or
        $s !~ m|[A-Z]/[A-Z-0-9]{2}/[A-Z-0-9]{2,}/|
       ) {
        return $s if $s =~ m:^N/A|^Contact Author: ;
        $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4|;
        CPAN->debug("s[$s]") if $CPAN::DEBUG;
    }
    $s;
}

#-> sub CPAN::Distribution::author ;
sub author {
    my($self) = @_;
    my($authorid);
    if (substr($self->id,-1,1) eq ".") {
        $authorid = "LOCAL";
    } else {
        ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
    }
    CPAN::Shell->expand("Author",$authorid);
}

# tries to get the yaml from CPAN instead of the distro itself:
# EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
sub fast_yaml {
    my($self) = @_;
    my $meta = $self->pretty_id;
    $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
    my(@ls) = CPAN::Shell->globls($meta);
    my $norm = $self->normalize($meta);

    my($local_file);
    my($local_wanted) =
        File::Spec->catfile(
                            $CPAN::Config->{keep_source_where},
                            "authors",