view release on metacpan or  search on metacpan

MrShell.pm  view on Meta::CPAN

sub set_logfile_option {
    my $this = shift;
    my $file = shift;
    my $trunc = shift;

    unless( our $already_compiled++ ) {
        my $load_ansi_filter_package = q {
            package App::MrShell::ANSIFilter;
            use Symbol;
            use Tie::Handle;
            use base 'Tie::StdHandle';

            my %orig;

            sub PRINT {
                my $this = shift;
                my @them = @_;
                s/\e\[[\d;]+m//g for @them;
                print {$orig{$this}} @them;
            }

            sub filtered_handle {
                my $pfft = gensym();
                my $it = tie *{$pfft}, __PACKAGE__ or die $!;
                $orig{$it} = shift;
                $pfft;
            }

        1};

        eval $load_ansi_filter_package or die $@; ## no critic -- sometimes this kind of eval is ok
        # (This probably isn't one of them.)
    }

    open my $log, ($trunc ? ">" : ">>"), $file or croak "couldn't open $file for write: $!"; ## no critic -- I mean to pass this around, shut up

    $this->{_log_fh} = App::MrShell::ANSIFilter::filtered_handle($log);

    return $this;
}
# }}}
# set_debug_option {{{
sub set_debug_option {
    my $this = shift;
    my $val = shift;

    # -d 0 and -d 1 are the same
    # -d 2 is a level up, -d 4 is even more
    # $val==undef clears the setting

    if( not defined $val ) {
        delete $this->{debug};
        return $this;
    }

    $this->{debug} = $val ? $val : 1;

    return $this;
}
# }}}
# set_no_command_escapes_option {{{
sub set_no_command_escapes_option {
    my $this = shift;

    $this->{no_command_escapes} = shift || 0;

    return $this;
}
# }}}

# groups {{{
sub groups {
    my $this = shift;

    return unless $this->{groups};
    return wantarray ? %{$this->{groups}} : $this->{groups};
}
# }}}

# set_usage_error($&) {{{
sub set_usage_error($&) { ## no critic -- prototypes are bad how again?
    my $this = shift;
    my $func = shift;
    my $pack = caller;
    my $name = $pack . "::$func";
    my @args = @_;

    $this->{_usage_error} = sub {
        no strict 'refs'; ## no critic -- how would you call this by name without this?
        $name->(@args)
    };

    return $this;
}
# }}}
# read_config {{{
sub read_config {
    my ($this, $that) = @_;

    $this->{_conf} = Config::Tiny->read($that) if -f $that;

    for my $group (keys %{ $this->{_conf}{groups} }) {
        $this->set_group_option( $group => $this->{_conf}{groups}{$group} );
    }

    if( my $c = $this->{_conf}{options}{'shell-command'} ) {
        $this->set_shell_command_option( $c );
    }

    if( my $c = $this->{_conf}{options}{'logfile'} ) {
        my $t = $this->{_conf}{options}{'truncate-logfile'};
        my $v = ($t ? 1:0);
           $v = 0 if $t =~ m/(?:no|false)/i;

        $this->set_logfile_option($c, $v);
    }

    if( my $c = $this->{_conf}{options}{'no-command-escapes'} ) {
        my $v = ($c ? 1:0);
           $v = 0 if $c =~ m/(?:no|false)/i;

        $this->set_no_command_escapes_option( $v );
    }

    return $this;
}
# }}}
# set_hosts {{{
sub set_hosts {
    my $this = shift;

    $this->{hosts} = [ $this->_process_hosts(@_) ];

    return $this;
}
# }}}
# queue_command {{{
sub queue_command {
    my $this = shift;
    my @hosts = @{$this->{hosts}};

    unless( @hosts ) {
        if( my $h = $this->{_conf}{options}{'default-hosts'} ) {
            @hosts = $this->_process_hosts( $this->_process_space_delimited($h) );

        } else {
            if( my $e = $this->{_usage_error} ) {
                warn "Error: no hosts specified\n";
                $e->();

            } else {
                croak "set_hosts before issuing queue_command";
            }
        }
    }

    for my $h (@hosts) {
        push @{$this->{_cmd_queue}{$h}}, [@_]; # make a real copy
    }

    return $this;
}
# }}}
# run_queue {{{
sub run_queue {
    my $this = shift;

    $this->{_session} = POE::Session->create( inline_states => {
        _start       => sub { $this->poe_start(@_) },
        child_stdout => sub { $this->line(1, @_) },
        child_stderr => sub { $this->line(2, @_) },
        child_signal => sub { $this->sigchld(@_) },
        stall_close  => sub { $this->_close(@_) },
        ErrorEvent   => sub { $this->error_event },
    });

    POE::Kernel->run();

    return $this;
}
# }}}

MrShell.pm  view on Meta::CPAN

        }

        delete $this->{_pid}{ $kid->PID };

    } else {
        $_[KERNEL]->yield( stall_close => $wid, $count+1 );
    }

    return;
}
# }}}
# error_event {{{
sub error_event {
    my $this = shift;
    my ($operation, $errnum, $errstr, $wid) = @_[ARG0 .. ARG3];
    my ($kid, $host, $cmdno, @c) = @{ delete $this->{_wid}{$wid} || return };
    delete $this->{_pid}{ $kid->PID };

    $errstr = "remote end closed" if $operation eq "read" and not $errnum;
    $this->std_msg($host, $cmdno, 0, RED."-- $operation error $errnum: $errstr --");

    return;
}
# }}}

# set_subst_vars {{{
sub set_subst_vars {
    my $this = shift;

    while( my ($k,$v) = splice @_, 0, 2 ) {
        $this->{_subst}{$k} = $v unless exists $this->{_subst}{$k};
    }

    return $this;
}
# }}}
# subst_cmd_vars {{{
sub subst_cmd_vars {
    my $this = shift;
    my %h = %{ delete($this->{_subst}) || {} };
    my $host = $h{'%h'};

    my @c = @_; # copy this so it doesn't get altered upstream
                # (I'd swear I shoulnd't need to do this at all, but it's
                #  proovably true that I do.)

    if( $host =~ m/\b(?!<\\)!/ ) {
        my @hosts = split '!', $host;

        my @indexes_of_replacements;
        for(my $i=0; $i<@c; $i++) {
            if( $c[$i] eq '%h' ) {
                splice @c, $i, 1, $hosts[0];

                push @indexes_of_replacements, $i;

                for my $h (reverse @hosts[1 .. $#hosts]) {
                    splice @c, $i+1, 0, @c[0 .. $i-1] => $h;
                    push @indexes_of_replacements, $i+1 + $indexes_of_replacements[-1];

                    unless( $this->{no_command_escapes} ) {
                        for my $arg (@c[$i+1 .. $#c]) {

                            # NOTE: This escaping is going to be an utter pain to maintain...

                            $arg =~ s/([`\$])/\\$1/g;

                            if( $arg =~ m/[\s()]/ ) {
                                $arg =~ s/([\\"])/\\$1/g;
                                $arg = "\"$arg\"";
                            }
                        }
                    }
                }
            }
        }

        my $beg = 0;
        for my $i (@indexes_of_replacements) {
            if( $c[$i] =~ s/^([\w.\-_]+)@// ) {
                my $u = $1;
                for(@c[$beg .. $i-1]) {
                    s/^(\[\%u\]|\[\](?=\%u))//;
                    $_ = $u if $_ eq '%u';
                }

            } else {
                # NOTE: there's really no need to go through and remove [%u]
                # conditional options, they'll automatically get nuked below
                $c[$i] =~ s/\\@/@/g;
            }
            $beg = $i+1;
        }

        delete $h{'%h'};

    } else {
        $h{'%h'} =~ s/\\!/!/g;
    }

    if( $h{'%h'} ) {
        $h{'%u'} = $1 if $h{'%h'} =~ s/^([\w.\-_]+)@//;
        $h{'%h'} =~ s/\\@/@/g;
    }

    @c = map {exists $h{$_} ? $h{$_} : $_}
         map { m/^\[([^\[\]]+)\]/ ? ($h{$1} ? do{s/^\[\Q$1\E\]//; $_} : ()) : ($_) } ## no critic: why on earth not?
         map { s/\[\]\%(\w+)/[\%$1]\%$1/; $_ }                                       ## no critic: why on earth not?
         @c;

    if( $this->{debug} ) {
        local $" = ")(";
        $this->std_msg($host, $h{'%n'}, 0, BOLD.BLACK."DEBUG: exec(@c)");
    }

    return @c;
}
# }}}
# start_queue_on_host {{{
sub start_queue_on_host {
    my ($this, $kernel => $host, $cmdno, $cmd, @next) = @_;