File Coverage

blib/lib/Footprintless/Command.pm

Criterion	Covered	Total	%
statement	169	187	90.3
branch	94	114	82.4
condition	27	40	67.5
subroutine	34	34	100.0
pod	10	11	90.9
total	334	386	86.5

use strict;
use warnings;

package Footprintless::Command;
$Footprintless::Command::VERSION = '1.26';
# ABSTRACT: A factory for building common commands
# PODNAME: Footprintless::Command

use Exporter qw(import);
our @EXPORT_OK = qw(
    batch_command
    command
    command_options
    cp_command
    mkdir_command
    pipe_command
    rm_command
    sed_command
    tail_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 'Footprintless::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 {
    wrap(
        {},
        @_,
        sub {
            return shift;
        }
    );
}

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

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 'Footprintless::Command::CommandOptions' );
    $destination_path            = _escape_path(shift);
    $destination_command_options = shift
        if ( ref( $_[0] ) eq 'Footprintless::Command::CommandOptions' );
    %cp_options = @_;

    $source_command_options      = command_options() unless ($source_command_options);
    $destination_command_options = command_options() unless ($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_command(),
                                $source_command_options->get_sudo_username()
                                )
                            : ( undef, undef ),
                            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_command(),
                        $destination_command_options->get_sudo_username()
                        )
                    : ( undef, undef ),
                    "tar --no-overwrite-dir -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 _escape_path {
    my ($path) = @_;
    $path =~ s/(['"`\s])/\\$1/g;
    return $path;
}

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;
    $command =~ s/`/\\`/g;    # for `command`
    $command =~ s/"/\\"/g;
    return "\"$command\"";
}

sub rm_command {
    Footprintless::Command::wrap(
        {},
        @_,
        sub {
            my ( @dirs, @files );
            foreach my $entry (@_) {
                if ( $entry =~ /(?:\/|\\)$/ ) {
                    push( @dirs, $entry );
                }
                else {
                    push( @files, $entry );
                }
            }

            if (@dirs) {
                if (@files) {
                    return batch_command(
                        'rm -rf "' . join( '" "', sort(@dirs) ) . '"',
                        'rm -f "' . join( '" "', sort(@files) ) . '"',
                        { subshell => 'bash -c ' }
                    );
                }
                else {
                    return 'rm -rf "' . join( '" "', sort(@dirs) ) . '"';
                }
            }
            else {
                return 'rm -f "' . join( '" "', sort(@files) ) . '"';
            }
        }
    );
}

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_command, $sudo_username, $command ) = @_;
    if ( defined($sudo_username) ) {
        $command =
              ( $sudo_command  ? "$sudo_command "     : 'sudo ' )
            . ( $sudo_username ? "-u $sudo_username " : '' )
            . $command;
    }
    return $command;
}

sub tail_command {
    Footprintless::Command::wrap(
        {},
        @_,
        sub {
            my ( $file, %options ) = @_;
            my @command = ('tail');
            if ( $options{follow} ) {
                push( @command, '-f' );
            }
            elsif ( $options{lines} ) {
                push( @command, '-n', $options{lines} );
            }
            push( @command, $file );
            return join( ' ', @command );
        }
    );
}

sub write_command {
    my ( $filename, @lines, $write_options, $command_options );
    $filename        = shift;
    @lines           = @_;
    $command_options = pop(@lines)
        if ( ref( $lines[$#lines] ) eq 'Footprintless::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_command, $sudo_username, $pretty );

    if ( ref( $args[$#args] ) eq 'Footprintless::Command::CommandOptions' ) {
        my $options = pop(@args);
        $ssh           = $options->get_ssh() || 'ssh';
        $username      = $options->get_username();
        $hostname      = $options->get_hostname();
        $sudo_command  = $options->get_sudo_command();
        $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_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 Footprintless::Command::CommandOptions;
$Footprintless::Command::CommandOptions::VERSION = '1.26';
sub new {
    return bless( {}, shift )->_init(@_);
}

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_command} ) && !exists( $options{sudo_command} ) ) {
        $options{sudo_command} = $instance->{sudo_command};
    }
    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 get_hostname {
    return $_[0]->{hostname};
}

sub get_pretty {
    return $_[0]->{pretty};
}

sub get_ssh {
    return $_[0]->{ssh};
}

sub get_sudo_command {
    return $_[0]->{sudo_command};
}

sub get_sudo_username {
    return $_[0]->{sudo_username};
}

sub get_username {
    return $_[0]->{username};
}

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_command}  = $options{sudo_command}  if ( defined( $options{sudo_command} ) );
    $self->{sudo_username} = $options{sudo_username} if ( defined( $options{sudo_username} ) );
    $self->{pretty}        = $options{pretty}        if ( defined( $options{pretty} ) );

    return $self;
}

__END__