File Coverage

blib/lib/IPC/Open3/Callback/Command.pm

Criterion	Covered	Total	%
statement	15	142	10.5
branch	0	74	0.0
condition	0	28	0.0
subroutine	5	24	20.8
pod			n/a
total	20	268	7.4

use strict;
use warnings;

package IPC::Open3::Callback::Command;
$IPC::Open3::Callback::Command::VERSION = '1.17';
# ABSTRACT: A utility class that provides subroutines for building shell command strings.

use Exporter qw(import);
our @EXPORT_OK =
    qw(batch_command command command_options cp_command mkdir_command pipe_command rm_command sed_command write_command);

use File::Spec;

sub batch_command {
    my ( @commands, $batch_options, $command_options );
    (@commands) = @_;
    $command_options = pop(@commands)
        if ( ref( $commands[$#commands] ) eq 'IPC::Open3::Callback::Command::CommandOptions' );
    $batch_options = pop(@commands) if ( ref( $commands[$#commands] ) eq 'HASH' );

    push( @commands, $command_options ) if ($command_options);

    wrap(
        $batch_options || {},
        @commands,
        sub {
            return @_;
        }
    );
}

sub command_options {
    return IPC::Open3::Callback::Command::CommandOptions->new(@_);
}

sub command {
    wrap(
        {},
        @_,
        sub {
            return shift;
        }
    );
}

sub cp_command {
    my ( $source_path, $source_command_options, $destination_path, $destination_command_options,
        %cp_options );
    $source_path            = _escape_path(shift);
    $source_command_options = shift
        if ( ref( $_[0] ) eq 'IPC::Open3::Callback::Command::CommandOptions' );
    $destination_path            = _escape_path(shift);
    $destination_command_options = shift
        if ( ref( $_[0] ) eq 'IPC::Open3::Callback::Command::CommandOptions' );
    %cp_options = @_;

    $source_command_options      = command_options() if ( !$source_command_options );
    $destination_command_options = command_options() if ( !$destination_command_options );

    my $source_command;
    my $destination_command;
    if ( $cp_options{file} ) {

        # is a file, so use cat | dd
        if ( $cp_options{compress} ) {
            $source_command = command( "gzip -c $source_path", $source_command_options );
            $destination_command =
                pipe_command( "gunzip", "dd of=$destination_path", $destination_command_options );
        }
        else {
            $source_command = command( "cat $source_path", $source_command_options );
            $destination_command =
                command( "dd of=$destination_path", $destination_command_options );
        }
    }
    else {
        # is a directory, so use tar or unzip
        if ( $cp_options{archive} && $cp_options{archive} eq 'zip' ) {
            my $temp_zip = File::Spec->catfile( $destination_path,
                $cp_options{unzip_temp_file} || "temp_cp_command.zip" );
            $source_command =
                command(
                batch_command( "cd $source_path", "zip -qr - .", { subshell => "bash -c " } ),
                $source_command_options );
            $destination_command = batch_command(
                "dd of=$temp_zip",     "unzip -qod $destination_path $temp_zip",
                rm_command($temp_zip), $destination_command_options
            );
        }
        else {
            # default, use tar
            my @parts             = ("tar c -C $source_path .");
            my @destination_parts = ();
            if ( $cp_options{status} ) {
                push(
                    @parts,
                    join(
                        '',
                        'pv -f -s `',
                        _sudo_command(
                            $source_command_options
                                && $source_command_options->get_sudo_username(),
                            pipe_command( "du -sb $source_path", 'cut -f1' )
                        ),
                        '`'
                    )
                );
            }
            if ( $cp_options{compress} ) {
                push( @parts,             'gzip' );
                push( @destination_parts, 'gunzip' );
            }
            push(
                @destination_parts,
                _sudo_command(
                    $destination_command_options
                        && $destination_command_options->get_sudo_username(),
                    "tar x -C $destination_path"
                )
            );

            $source_command = command( pipe_command(@parts), $source_command_options );
            $destination_command = command( pipe_command(@destination_parts),
                $destination_command_options->clone( sudo_username => undef ) );
        }
    }

    return pipe_command( $source_command, $destination_command );
}

sub mkdir_command {
    wrap(
        {},
        @_,
        sub {
            return 'mkdir -p "' . join( '" "', @_ ) . '"';
        }
    );
}

sub pipe_command {
    wrap(
        { command_separator => '|' },
        @_,
        sub {
            return @_;
        }
    );
}

sub _quote_command {
    my ($command) = @_;
    $command =~ s/\\/\\\\/g;
    $command =~ s/`/\\`/g;    # for `command`
    $command =~ s/"/\\"/g;
    return "\"$command\"";
}

sub _escape_path {
    my ($path) = @_;
    $path =~ s/(['"`\s])/\\$1/g;
    return $path;
}

sub rm_command {
    wrap(
        {},
        @_,
        sub {
            return 'rm -rf "' . join( '" "', @_ ) . '"';
        }
    );
}

sub sed_command {
    wrap(
        {},
        @_,
        sub {
            my @args    = @_;
            my $options = {};

            if ( ref( $args[$#args] ) eq 'HASH' ) {
                $options = pop(@args);
            }

            my $command = 'sed';
            $command .= ' -i' if ( $options->{in_place} );
            if ( defined( $options->{temp_script_file} ) ) {
                my $temp_script_file_name = $options->{temp_script_file}->filename();
                print( { $options->{temp_script_file} } join( ' ', '', map {"$_;"} @args ) )
                    if ( scalar(@args) );
                print(
                    { $options->{temp_script_file} } join( ' ',
                        '',
                        map {"s/$_/$options->{replace_map}{$_}/g;"}
                            keys( %{ $options->{replace_map} } ) )
                ) if ( defined( $options->{replace_map} ) );
                $options->{temp_script_file}->flush();
                $command .= " -f $temp_script_file_name";
            }
            else {
                $command .= join( ' ', '', map {"-e '$_'"} @args ) if ( scalar(@args) );
                $command .= join( ' ',
                    '',
                    map {"-e 's/$_/$options->{replace_map}{$_}/g'"}
                        keys( %{ $options->{replace_map} } ) )
                    if ( defined( $options->{replace_map} ) );
            }
            $command .= join( ' ', '', @{ $options->{files} } ) if ( $options->{files} );

            return $command;
        }
    );
}

sub _sudo_command {
    my ( $sudo_username, $command ) = @_;
    if ( defined($sudo_username) ) {
        $command = "sudo " . ( $sudo_username ? "-u $sudo_username " : '' ) . $command;
    }
    return $command;
}

sub write_command {
    my ( $filename, @lines, $write_options, $command_options );
    $filename        = shift;
    @lines           = @_;
    $command_options = pop(@lines)
        if ( ref( $lines[$#lines] ) eq 'IPC::Open3::Callback::Command::CommandOptions' );
    $write_options = pop(@lines) if ( ref( $lines[$#lines] ) eq 'HASH' );

    my $remote_command = "dd of=$filename";
    if ( defined($write_options) && defined( $write_options->{mode} ) ) {
        if ( defined($command_options) ) {
            $remote_command =
                batch_command( $remote_command, "chmod $write_options->{mode} $filename",
                $command_options );
        }
        elsif ( defined($command_options) ) {
            $remote_command =
                batch_command( $remote_command, "chmod $write_options->{mode} $filename" );
        }
    }
    elsif ( defined($command_options) ) {
        $remote_command = command( $remote_command, $command_options );
    }

    my $line_separator =
        ( defined($write_options) && defined( $write_options->{line_separator} ) )
        ? $write_options->{line_separator}
        : '\n';
    return pipe_command( 'printf "' . join( $line_separator, @lines ) . '"', $remote_command );
}

# Handles wrapping commands with possible ssh and command prefix
sub wrap {
    my $wrap_options = shift;
    my $builder      = pop;
    my @args         = @_;
    my ( $ssh, $username, $hostname, $sudo_username, $pretty );

    if ( ref( $args[$#args] ) eq 'IPC::Open3::Callback::Command::CommandOptions' ) {
        my $options = pop(@args);
        $ssh           = $options->get_ssh() || 'ssh';
        $username      = $options->get_username();
        $hostname      = $options->get_hostname();
        $sudo_username = $options->get_sudo_username();
        $pretty        = $options->get_pretty();
    }

    my $destination_command = '';
    my $command_separator   = $wrap_options->{command_separator} || ';';
    my $commands            = 0;
    foreach my $command ( &$builder(@args) ) {
        if ( defined($command) ) {
            if ( $commands++ > 0 ) {
                $destination_command .= $command_separator;
                if ($pretty) {
                    $destination_command .= "\n";
                }
            }

            $command =~ s/^(.*?[^\\]);$/$1/;    # from find -exec

            $command = _sudo_command( $sudo_username, $command );

            $destination_command .= $command;
        }
    }

    if ( $wrap_options->{subshell} ) {
        $destination_command = $wrap_options->{subshell} . _quote_command($destination_command);
    }

    if ( !defined($username) && !defined($hostname) ) {

        # silly to ssh to localhost as current user, so dont
        return $destination_command;
    }

    my $userAt =
        $username
        ? ( ( $ssh =~ /plink(?:\.exe)?$/ ) ? "-l $username " : "$username\@" )
        : '';

    $destination_command = _quote_command($destination_command);
    return "$ssh $userAt" . ( $hostname || 'localhost' ) . " $destination_command";
}

package IPC::Open3::Callback::Command::CommandOptions;
$IPC::Open3::Callback::Command::CommandOptions::VERSION = '1.17';
use parent qw(Class::Accessor);
__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_ro_accessors(qw(hostname pretty ssh sudo_username username));

sub new {
    my ( $class, @args ) = @_;
    return bless( {}, $class )->_init(@args);
}

sub clone {
    my ( $instance, %options ) = @_;
    if ( exists( $instance->{hostname} ) && !exists( $options{hostname} ) ) {
        $options{hostname} = $instance->{hostname};
    }
    if ( exists( $instance->{ssh} ) && !exists( $options{ssh} ) ) {
        $options{ssh} = $instance->{ssh};
    }
    if ( exists( $instance->{username} ) && !exists( $options{username} ) ) {
        $options{username} = $instance->{username};
    }
    if ( exists( $instance->{sudo_username} ) && !exists( $options{sudo_username} ) ) {
        $options{sudo_username} = $instance->{sudo_username};
    }
    if ( exists( $instance->{pretty} ) && !exists( $options{pretty} ) ) {
        $options{pretty} = $instance->{pretty};
    }
    return new( ref($instance), %options );
}

sub _init {
    my ( $self, %options ) = @_;

    $self->{hostname}      = $options{hostname}      if ( defined( $options{hostname} ) );
    $self->{ssh}           = $options{ssh}           if ( defined( $options{ssh} ) );
    $self->{username}      = $options{username}      if ( defined( $options{username} ) );
    $self->{sudo_username} = $options{sudo_username} if ( defined( $options{sudo_username} ) );
    $self->{pretty}        = $options{pretty}        if ( defined( $options{pretty} ) );

    return $self;
}

1;

__END__