view release on metacpan or  search on metacpan

lib/Doit.pm  view on Meta::CPAN

	} else {
	    my @text = split '', $text;
	    $text = q{"};
	    for (my $i = 0; ; $i++) {
		my $bs_count = 0;
		while ( $i < @text && $text[$i] eq "\\" ) {
		    $i++;
		    $bs_count++;
		}
		if ($i > $#text) {
		    $text .= "\\" x ($bs_count * 2);
		    last;
		} elsif ($text[$i] eq q{"}) {
		    $text .= "\\" x ($bs_count * 2 + 1);
		} else {
		    $text .= "\\" x $bs_count;
		}
		$text .= $text[$i];
	    }
	    $text .= q{"};
	}

	return $text;
    }

    # direct port of code from win32.c
    sub _has_shell_metachars {
	my $string = shift;
	my $inquote = 0;
	my $quote = '';

	my @string = split '', $string;
	for my $char (@string) {
	    if ($char eq q{%}) {
		return 1;
	    } elsif ($char eq q{'} || $char eq q{"}) {
		if ($inquote) {
		    if ($char eq $quote) {
			$inquote = 0;
			$quote = '';
		    }
		} else {
		    $quote = $char;
		    $inquote++;
		}
	    } elsif ($char eq q{<} || $char eq q{>} || $char eq q{|}) {
		if ( ! $inquote) {
		    return 1;
		}
	    }
	}
	return;
    }
}

{
    package Doit;

    sub import {
	warnings->import;
	strict->import;
    }

    sub unimport {
	warnings->unimport;
	strict->unimport;
    }

    use Doit::Log;

    my $diff_error_shown;
    our @diff_cmd;

    sub _new {
	my $class = shift;
	my $self = bless { }, $class;
	$self;
    }
    sub runner {
	my($self) = @_;
	# XXX hmmm, creating now self-refential data structures ...
	$self->{runner} ||= Doit::Runner->new($self);
    }
	    
    sub dryrunner {
	my($self) = @_;
	# XXX hmmm, creating now self-refential data structures ...
	$self->{dryrunner} ||= Doit::Runner->new($self, dryrun => 1);
    }

    sub init {
	my($class) = @_;
	require Getopt::Long;
	my $getopt = Getopt::Long::Parser->new;
	$getopt->configure(qw(pass_through noauto_abbrev));
	$getopt->getoptions(
			    'dry-run|n' => \my $dry_run,
			   );
	my $doit = $class->_new;
	if ($dry_run) {
	    $doit->dryrunner;
	} else {
	    $doit->runner;
	}
    }

    sub install_generic_cmd {
	my($self, $name, $check, $code, $msg) = @_;
	if (!$msg) {
	    $msg = sub { my($self, $args) = @_; $name . ($args ? " @$args" : '') };
	}
	my $cmd = sub {
	    my($self, @args) = @_;
	    my @commands;
	    my $addinfo = {};
	    if ($check->($self, \@args, $addinfo)) {
		push @commands, {
				 code => sub { $code->($self, \@args, $addinfo) },
				 msg  => $msg->($self, \@args, $addinfo),
				};
	    }