view release on metacpan or  search on metacpan

lib/DBI/Shell.pm  view on Meta::CPAN

		$sh->print_buffer_nop ($i+1, ":\n", $sh->{chistory}->[$i], "--------\n");
		foreach my $rowref (@{$sh->{rhistory}[$i]}) {
			$sh->print_buffer_nop("    ", join(", ", map { defined $_ ? $_ : q{undef} }@$rowref), "\n");
		}
    }
return;
}

sub do_rhistory {
    my ($sh, @args) = @_;
    for(my $i = 0; $i < @{$sh->{rhistory}}; $i++) {
		$sh->print_buffer_nop ($i+1, ":\n");
		foreach my $rowref (@{$sh->{rhistory}[$i]}) {
			$sh->print_buffer_nop ("    ", join(", ", map { defined $_ ? $_ : q{undef} }@$rowref), "\n");
		}
    }
return;
}


sub do_get {
    my ($sh, $num, @args) = @_;
	# If get is called without a number, retrieve the last command.
	unless( $num ) {
		$num = ($#{$sh->{chistory}} + 1);	

	}
	# Allow for negative history.  If called with -1, get the second
	# to last command execute, -2 third to last, ...
	if ($num and $num =~ /^\-\d+$/) {
		$sh->print_buffer_nop("Negative number $num: \n");
		$num = ($#{$sh->{chistory}} + 1) + $num;
		$sh->print_buffer_nop("Changed number $num: \n");
	}

    if (!$num or $num !~ /^\d+$/ or !defined($sh->{chistory}->[$num-1])) {
		return $sh->err("No such command number '$num'. Use /chistory to list previous commands.");
    }
    $sh->{current_buffer} = $sh->{chistory}->[$num-1];
	$sh->print_buffer($sh->{current_buffer});
    return $num;
}


sub do_perl {
    my ($sh, @args) = @_;
	$DBI::Shell::eval::dbh = $sh->{dbh};
    eval "package DBI::Shell::eval; $sh->{current_buffer}";
    if ($@) { $sh->err("Perl failed: $@") }
    return $sh->run_command('clear');
}

#-------------------------------------------------------------
# Ping the current database connection.
#-------------------------------------------------------------
sub do_ping {
    my ($sh, @args) = @_;
    return $sh->print_buffer_nop (
	"Connection "
	, $sh->{dbh}->ping() == '0' ? 'Is' : 'Is Not'
	, " alive\n" );
}

sub do_edit {
    my ($sh, @args) = @_;

    $sh->run_command('get', '', $&) if @args and $args[0] =~ /^\d+$/;
    $sh->{current_buffer} ||= $sh->{prev_buffer};
	    
    # Find an area to write a temp file into.
    my $tmp_dir = $sh->{tmp_dir} ||
		$ENV{DBISH_TMP} || # Give people the choice.
	    $ENV{TMP}  ||            # Is TMP set?
	    $ENV{TEMP} ||            # How about TEMP?
	    $ENV{HOME} ||            # Look for HOME?
	    $ENV{HOMEDRIVE} . $ENV{HOMEPATH} || # Last env checked.
	    ".";       # fallback: try to write in current directory.

    my $tmp_file = "$tmp_dir/" . ($sh->{tmp_file} || qq{dbish$$.sql});

	$sh->log( "using tmp file: $tmp_file" ) if $sh->{debug};

    local (*FH);
    open(FH, ">$tmp_file") or
	    $sh->err("Can't create $tmp_file: $!\n", 1);
    print FH $sh->{current_buffer} if defined $sh->{current_buffer};
    close(FH) or $sh->err("Can't write $tmp_file: $!\n", 1);

    my $command = "$sh->{editor} $tmp_file";
    system($command);

    # Read changes back in (editor may have deleted and rewritten file)
    open(FH, "<$tmp_file") or $sh->err("Can't open $tmp_file: $!\n");
    $sh->{current_buffer} = join "", <FH>;
    close(FH) or $sh->err( "Close failed: $tmp_file: $!\n" );
    unlink $tmp_file;

    return $sh->run_command('current');
}


#
# Load a command/file from disk to the current buffer.  Currently this
# overwrites the current buffer with the file loaded.  This may change
# in the future.
#
sub do_load {
    my ($sh, $ufile, @args) = @_;

	unless( $ufile ) {
		$sh->err ( qq{load what file?} );
		return;
	}

	# Load file for from sqlpath.
	my $file = $sh->look_for_file($ufile);

	unless( $file ) {
		$sh->err( qq{Unable to locate file $ufile} );
		return;
	}