view release on metacpan or  search on metacpan

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

    $self->debug("Removing tmp-$$") if $CPAN::DEBUG;
    File::Path::rmtree("tmp-$$");
    unless (mkdir "tmp-$$", 0755) {
        $CPAN::Frontend->unrecoverable_error(<<EOF);
Couldn't mkdir '$builddir/tmp-$$': $!

Cannot continue: Please find the reason why I cannot make the
directory
$builddir/tmp-$$
and fix the problem, then retry.

EOF
    }
    if ($CPAN::Signal) {
        return;
    }
    $self->safe_chdir("tmp-$$");

    #
    # Unpack the goods
    #
    my $local_file = $self->{localfile};
    my $ct = eval{CPAN::Tarzip->new($local_file)};
    unless ($ct) {
        $self->{unwrapped} = CPAN::Distrostatus->new("NO");
        delete $self->{build_dir};
        return;
    }
    if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i) {
        $self->{was_uncompressed}++ unless eval{$ct->gtest()};
        $self->untar_me($ct);
    } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
        $self->unzip_me($ct);
    } else {
        $self->{was_uncompressed}++ unless $ct->gtest();
        $local_file = $self->handle_singlefile($local_file);
    }

    # we are still in the tmp directory!
    # Let's check if the package has its own directory.
    my $dh = DirHandle->new(File::Spec->curdir)
        or Carp::croak("Couldn't opendir .: $!");
    my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
    if (grep { $_ eq "pax_global_header" } @readdir) {
        $CPAN::Frontend->mywarn("Your (un)tar seems to have extracted a file named 'pax_global_header'
from the tarball '$local_file'.
This is almost certainly an error. Please upgrade your tar.
I'll ignore this file for now.
See also http://rt.cpan.org/Ticket/Display.html?id=38932\n");
        $CPAN::Frontend->mysleep(5);
        @readdir = grep { $_ ne "pax_global_header" } @readdir;
    }
    $dh->close;
    my $tdir_base;
    my $from_dir;
    my @dirents;
    if (@readdir == 1 && -d $readdir[0]) {
        $tdir_base = $readdir[0];
        $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
        my($mode) = (stat $from_dir)[2];
        chmod $mode | 00755, $from_dir; # JONATHAN/Math-Calculus-TaylorSeries-0.1.tar.gz has 0644
        my $dh2;
        unless ($dh2 = DirHandle->new($from_dir)) {
            my $why = sprintf
                (
                 "Couldn't opendir '%s', mode '%o': %s",
                 $from_dir,
                 $mode,
                 $!,
                );
            $CPAN::Frontend->mywarn("$why\n");
            $self->{writemakefile} = CPAN::Distrostatus->new("NO -- $why");
            return;
        }
        @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
    } else {
        my $userid = $self->cpan_userid;
        CPAN->debug("userid[$userid]");
        if (!$userid or $userid eq "N/A") {
            $userid = "anon";
        }
        $tdir_base = $userid;
        $from_dir = File::Spec->curdir;
        @dirents = @readdir;
    }
    my $packagedir;
    my $eexist = ($CPAN::META->has_usable("Errno") && defined &Errno::EEXIST)
        ? &Errno::EEXIST : undef;
    for(my $suffix = 0; ; $suffix++) {
        $packagedir = File::Spec->catdir($builddir, "$tdir_base-$suffix");
        my $parent = $builddir;
        mkdir($packagedir, 0777) and last;
        if((defined($eexist) && $! != $eexist) || $suffix == 999) {
            $CPAN::Frontend->mydie("Cannot create directory $packagedir: $!\n");
        }
    }
    my $f;
    for $f (@dirents) { # is already without "." and ".."
        my $from = File::Spec->catfile($from_dir,$f);
        my($mode) = (stat $from)[2];
        chmod $mode | 00755, $from if -d $from; # OTTO/Pod-Trial-LinkImg-0.005.tgz
        my $to = File::Spec->catfile($packagedir,$f);
        unless (File::Copy::move($from,$to)) {
            my $err = $!;
            $from = File::Spec->rel2abs($from);
            $CPAN::Frontend->mydie(
                "Couldn't move $from to $to: $err; #82295? ".
                "CPAN::VERSION=$CPAN::VERSION; ".
                "File::Copy::VERSION=$File::Copy::VERSION; ".
                "$from " . (-e $from ? "exists; " : "does not exist; ").
                "$to " . (-e $to ? "exists; " : "does not exist; ").
                "cwd=" . CPAN::anycwd() . ";"
            );
        }
    }
    $self->{build_dir} = $packagedir;
    $self->safe_chdir($builddir);
    File::Path::rmtree("tmp-$$");

    $self->safe_chdir($packagedir);
    $self->_signature_business();
    $self->safe_chdir($builddir);

    return($packagedir,$local_file);
}

#-> sub CPAN::Distribution::pick_meta_file ;
sub pick_meta_file {
    my($self, $filter) = @_;
    $filter = '.' unless defined $filter;

    my $build_dir;
    unless ($build_dir = $self->{build_dir}) {
        # maybe permission on build_dir was missing
        $CPAN::Frontend->mywarn("Warning: cannot determine META.yml without a build_dir.\n");
        return;
    }

    my $has_cm = $CPAN::META->has_usable("CPAN::Meta");
    my $has_pcm = $CPAN::META->has_usable("Parse::CPAN::Meta");

    my @choices;
    push @choices, 'MYMETA.json' if $has_cm;
    push @choices, 'MYMETA.yml' if $has_cm || $has_pcm;
    push @choices, 'META.json' if $has_cm;
    push @choices, 'META.yml' if $has_cm || $has_pcm;

    for my $file ( grep { /$filter/ } @choices ) {
        my $path = File::Spec->catfile( $build_dir, $file );
        return $path if -f $path
    }

    return;
}

#-> sub CPAN::Distribution::parse_meta_yml ;
sub parse_meta_yml {
    my($self, $yaml) = @_;
    $self->debug(sprintf("parse_meta_yml[%s]",$yaml||'undef')) if $CPAN::DEBUG;
    my $build_dir = $self->{build_dir} or die "PANIC: cannot parse yaml without a build_dir";
    $yaml ||= File::Spec->catfile($build_dir,"META.yml");

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

            }
            unless (MM->maybe_command($patchbin)) {
                $CPAN::Frontend->mydie("No external patch command available\n\n".
                                       "Please run 'o conf init /patch/'\n\n");
            }
            $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
            local $ENV{PATCH_GET} = 0; # formerly known as -g0
            unless ($stdpatchargs) {
                my $system = "$patchbin --version |";
                local *FH;
                open FH, $system or die "Could not fork '$system': $!";
                local $/ = "\n";
                my $pversion;
              PARSEVERSION: while (<FH>) {
                    if (/^patch\s+([\d\.]+)/) {
                        $pversion = $1;
                        last PARSEVERSION;
                    }
                }
                if ($pversion) {
                    $stdpatchargs = "-N --fuzz=3";
                } else {
                    $stdpatchargs = "-N";
                }
            }
            my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
            $CPAN::Frontend->myprint("Applying $countedpatches:\n");
            my $patches_dir = $CPAN::Config->{patches_dir};
            for my $patch (@$patches) {
                if ($patches_dir && !File::Spec->file_name_is_absolute($patch)) {
                    my $f = File::Spec->catfile($patches_dir, $patch);
                    $patch = $f if -f $f;
                }
                unless (-f $patch) {
                    CPAN->debug("not on disk: patch[$patch]") if $CPAN::DEBUG;
                    if (my $trydl = $self->try_download($patch)) {
                        $patch = $trydl;
                    } else {
                        my $fail = "Could not find patch '$patch'";
                        $CPAN::Frontend->mywarn("$fail; cannot continue\n");
                        $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
                        delete $self->{build_dir};
                        return;
                    }
                }
                $CPAN::Frontend->myprint("  $patch\n");
                my $readfh = CPAN::Tarzip->TIEHANDLE($patch);

                my $pcommand;
                my($ppp,$pfiles) = $self->_patch_p_parameter($readfh);
                if ($ppp eq "applypatch") {
                    $pcommand = "$CPAN::Config->{applypatch} -verbose";
                } else {
                    my $thispatchargs = join " ", $stdpatchargs, $ppp;
                    $pcommand = "$patchbin $thispatchargs";
                    require Config; # usually loaded from CPAN.pm
                    if ($Config::Config{osname} eq "solaris") {
                        # native solaris patch cannot patch readonly files
                        for my $file (@{$pfiles||[]}) {
                            my @stat = stat $file or next;
                            chmod $stat[2] | 0600, $file; # may fail
                        }
                    }
                }

                $readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again
                my $writefh = FileHandle->new;
                $CPAN::Frontend->myprint("  $pcommand\n");
                unless (open $writefh, "|$pcommand") {
                    my $fail = "Could not fork '$pcommand'";
                    $CPAN::Frontend->mywarn("$fail; cannot continue\n");
                    $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
                    delete $self->{build_dir};
                    return;
                }
                binmode($writefh);
                while (my $x = $readfh->READLINE) {
                    print $writefh $x;
                }
                unless (close $writefh) {
                    my $fail = "Could not apply patch '$patch'";
                    $CPAN::Frontend->mywarn("$fail; cannot continue\n");
                    $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
                    delete $self->{build_dir};
                    return;
                }
            }
            $self->{patched}++;
        }
        return 1;
    }
}

# may return
# - "applypatch"
# - ("-p0"|"-p1", $files)
sub _patch_p_parameter {
    my($self,$fh) = @_;
    my $cnt_files   = 0;
    my $cnt_p0files = 0;
    my @files;
    local($_);
    while ($_ = $fh->READLINE) {
        if (
            $CPAN::Config->{applypatch}
            &&
            /\#\#\#\# ApplyPatch data follows \#\#\#\#/
           ) {
            return "applypatch"
        }
        next unless /^[\*\+]{3}\s(\S+)/;
        my $file = $1;
        push @files, $file;
        $cnt_files++;
        $cnt_p0files++ if -f $file;
        CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]")
            if $CPAN::DEBUG;
    }
    return "-p1" unless $cnt_files;
    my $opt_p = $cnt_files==$cnt_p0files ? "-p0" : "-p1";
    return ($opt_p, \@files);