view release on metacpan or  search on metacpan

lib/CPANPLUS/Dist/Slackware.pm  view on Meta::CPAN

                    $key .= '.gz';
                }
                if ( ref $value eq 'HASH' ) {
                    if (   defined $value->{type}
                        && $value->{type} eq 'link'
                        && defined $value->{from} )
                    {
                        my $from = $value->{from};
                        if ( $from =~ m{/man/man}xms ) {
                            if ( $from !~ m{\.gz$}xms ) {
                                $from .= '.gz';
                                $value->{from} = $from;
                            }
                        }
                    }
                }
            }

            if ( -e "$destdir$key" ) {
                $new_pl->{$key} = $value;
            }
        }
        $new_pl->write($filename);
    }
    return 1;
}

sub _process_installed_files {
    my ( $dist, $param_ref ) = @_;

    my $status  = $dist->status;
    my $module  = $dist->parent;
    my $cb      = $module->parent;
    my $pkgdesc = $status->_pkgdesc;

    my $destdir = $pkgdesc->destdir;

    my $orig_dir = Cwd::cwd();
    if ( !$cb->_chdir( dir => $destdir ) ) {
        return;
    }

    my $fail = 0;
    my @packlists;
    my $wanted = sub {
        my $filename = $_;

        return if $filename eq q{.};

        my @stat = lstat($filename);
        if ( !@stat ) {
            error( loc( q{Could not lstat '%1': %2}, $filename, $OS_ERROR ) );
            return;
        }

        # Skip symbolic links.
        return if -l _;

        # Sanitize the file modes.
        my $perm = ( $stat[2] & oct '0755' ) | oct '0200';
        if ( !chmod $perm, $filename ) {
            error( loc( q{Could not chmod '%1': %2}, $filename, $OS_ERROR ) );
            ++$fail;
        }

        if ( -d $filename ) {

            # Remove empty directories.
            rmdir $filename;
        }
        elsif ( -f $filename ) {
            if ( $filename eq 'perllocal.pod'
                || ( $filename =~ /\.bs$/ && -z $filename ) )
            {
                if ( !unlink $filename ) {
                    error(
                        loc(q{Could not unlink '%1': %2}, $filename,
                            $OS_ERROR
                        )
                    );
                    ++$fail;
                }
            }
            elsif ( $filename eq '.packlist' ) {
                push @packlists, $File::Find::name;
            }
            else {
                my $type = filetype($filename);
                if ( $type =~ /ELF.+(?:executable|shared object)/s ) {
                    if ( !strip($filename) ) {
                        ++$fail;
                    }
                }
            }
        }
    };
    File::Find::finddepth( $wanted, q{.} );

    for my $packlist (@packlists) {
        if ( !$dist->_process_packlist($packlist) ) {
            ++$fail;
        }
    }

    if ( !$cb->_chdir( dir => $orig_dir ) ) {
        ++$fail;
    }

    return ( $fail ? 0 : 1 );
}

sub _make_installdir {
    my ( $dist, $param_ref ) = @_;

    my $status  = $dist->status;
    my $module  = $dist->parent;
    my $cb      = $module->parent;
    my $pkgdesc = $status->_pkgdesc;

    my $installdir = catdir( $pkgdesc->destdir, 'install' );
    return $cb->_mkdir( dir => $installdir );
}