view release on metacpan or  search on metacpan

lib/Pcore/Dist/Build/Deploy.pm  view on Meta::CPAN

# TODO under windows acquire superuser automatically with use Win32::RunAsAdmin qw[force];

sub BUILDARGS ( $self, $args ) {
    $args->{devel} = $args->{recommends} = $args->{suggests} = 1 if $args->{all};

    return $args;
}

sub run ($self) {
    my $chdir_guard = P->file->chdir( $self->{dist}->{root} );

    # deps
    exit 3 if $self->{deps} && !$self->_deps;

    # build
    exit 3 if !$self->_build;

    # chmod
    $self->_chmod;

    # install
    exit 3 if $self->{install} && !$self->_install;

    return;
}

sub _chmod ($self) {
    print 'chmod ... ';

    if ( !$MSWIN ) {
        for my $path ( ( P->path->read_dir( max_depth => 0 ) // [] )->@* ) {

            # directory
            if ( -d $path ) {
                P->file->chmod( 'rwxr-xr-x', $path ) or say "$!: $path";
            }

            # file
            else {
                my $is_exe;

                if ( !defined $path->{suffix} && ( $path->{dirname} eq 'bin' || $path->{dirname} eq 'script' ) ) {
                    $is_exe = 1;
                }
                elsif ( defined $path->{suffix} && ( $path->{suffix} eq 'sh' || lc $path->{suffix} eq 'pl' || $path->{suffix} eq 't' ) ) {
                    $is_exe = 1;
                }

                # executable script
                if ($is_exe) {
                    P->file->chmod( 'rwxr-xr-x', $path ) or say "$!: $path";
                }

                # non-executable file
                else {
                    P->file->chmod( 'rw-r--r--', $path ) or say "$!: $path";
                }
            }

            chown $>, $), $path or say "$!: $path";    # EUID, EGID
        }
    }

    say 'done';

    return;
}

sub _deps ($self) {
    if ( -f 'cpanfile' ) {
        my @args = (                                   #
            'cpanm',
            '--with-feature', ( $MSWIN ? 'windows' : 'linux' ),
            ( $self->{devel}      ? '--with-develop'    : () ),
            ( $self->{recommends} ? '--with-recommends' : () ),
            ( $self->{suggests}   ? '--with-suggests'   : () ),
            ( $self->{verbose}    ? '--verbose'         : () ),
            '--metacpan', '--installdeps', q[.],
        );

        say join $SPACE, @args;

        P->sys->run_proc( \@args ) or return;
    }

    return 1;
}

sub _build ($self) {
    eval {
        for my $file ( ( P->path("$self->{dist}->{root}/lib")->read_dir( max_depth => 0, abs => 1, is_dir => 0 ) // [] )->@* ) {
            if ( $file =~ /[.]PL\z/sm ) {
                my $res = P->sys->run_proc( [ $^X, $file, $file =~ s/[.]PL\z//smr ] );

                if ( !$res ) {
                    say qq["$file" return ] . $res;

                    die;
                }
            }
        }
    };

    return $@ ? 0 : 1;
}

sub _install ($self) {
    if ( !P->sys->is_superuser ) {
        say qq[Root privileges required to deploy pcore at system level.];

        return;
    }

    my $canon_dist_root = P->path( $self->{dist}->{root} );

    my $canon_bin_dir = "$canon_dist_root/bin";

    my $workspace_dir_canon = P->path("$canon_dist_root/../")->to_abs;

    if ($MSWIN) {