view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

    - extension CmdEditLine - \e
    - extension CmdSetDBMS - set serveroutput on/off
    - extension OracleSQL innovation - dbms_output mempool support
    - extension CmdClipboard innovation - \unioncopy

0.24 <20020923> 
    - dbMan::Interface::cmdline innovation - history_add()
    - dbMan::Interface innovation - history_add()
    - extension CmdLongSQL innovation - long sql one line history
    - extension ClipboardInfo - info messages about \copy
    - extension Clipboard - clipboard engine
    - extension CmdClipboard - \copy, \paste
    - extension CmdStandardSQL innovation - execute command

0.23 <20020922>
    - extension SQLOutputPlain - self-NULL converting (without "")
    - extension SQLOutputNULL - for plain format don't convert NULLs
    - extension Format
    - extension CmdFormat - \f()
    - extension Quit innovation - complete bugfixed
    - extension StandardSQL innovation - corrected NULL bug

lib/DBIx/dbMan/Extension/Clipboard.pm  view on Meta::CPAN

sub IDENTIFICATION { return "000001-000065-000006"; }

sub preference { return 80; }

sub known_actions { return [ qw/SQL_RESULT/ ]; }

sub init {
	my $obj = shift;

	$obj->{prompt_title} = $obj->{-config}->prompt_clipboard || '[clip]';
}

sub handle_action {
	my ($obj,%action) = @_;

	$action{processed} = 1;
	if ($action{action} eq 'SQL_RESULT' and $action{copy_to_clipboard} and ref $action{result} eq 'ARRAY') {
		delete $action{copy_to_clipboard};
		if ($action{union_clipboard}) {
			my $clip = $obj->{-mempool}->get('clipboard');
			if (exists $clip->{-result}) {
				if (scalar @{$action{result}->[0]} != scalar @{$clip->{-result}->[0]}) {
					$action{output_info} = "Cannot union copy results with different number of columns.\n";
				} else { 
					my @res = map { [ @$_ ] } @{$action{result}};
					$clip->{-result} = [ @{$clip->{-result}}, @res ];
					$obj->{-mempool}->set('clipboard',$clip);
					$action{output_info} = "Union copy to clipboard done.\n";
				}
			} else {
				delete $action{union_clipboard};
			}
		} 
		unless ($action{union_clipboard}) {
			my $res;  $res = [ map { [ @$_ ] } @{$action{result}} ];
			$obj->{-mempool}->set('clipboard',{ -result => $res, -fieldnames => $action{fieldnames}, -fieldtypes => $action{fieldtypes}});
			$action{output_info} = "Copy to clipboard done.\n";
		}
		delete $action{processed};
		$obj->{-interface}->prompt($action{clipboard_prompt_num},$obj->{prompt_title});
		$obj->{-interface}->rebuild_menu();
	}

	return %action;
}

lib/DBIx/dbMan/Extension/CmdClipboard.pm  view on Meta::CPAN

}

sub done {
	my $obj = shift;
	$obj->{-interface}->deregister_prompt($obj->{prompt_num});
}

sub menu {
	my $obj = shift;

	my $clip = $obj->{-mempool}->get('clipboard');
	if (defined $clip and ref $clip eq 'HASH' and keys %$clip) {
		return ( { label => 'Output', submenu => [
				{ label => 'Clipboard', submenu => [
					{ label => 'Show clipboard',
						action => { action => 'COMMAND',
							cmd => 'show clipboard' } },
					{ label => 'Clear clipboard',
						action => { action => 'COMMAND', cmd => '\\clear' } }
			] } ] } );
	} else {
		return ();
	}
}

sub handle_action {
	my ($obj,%action) = @_;

	$action{processed} = 1;
	if ($action{action} eq 'COMMAND') {
		if ($action{cmd} =~ s/^\\copy\s+//i) {
			$obj->{-mempool}->set('clipboard',{});
			$obj->{-interface}->prompt($obj->{prompt_num},'');
			$action{copy_to_clipboard} = 1;
			$action{clipboard_prompt_num} = $obj->{prompt_num};
			delete $action{processed};
		} elsif ($action{cmd} =~ s/^\\unioncopy\s+//i) {
			$action{copy_to_clipboard} = 1;
			$action{union_clipboard} = 1;
			$action{clipboard_prompt_num} = $obj->{prompt_num};
			delete $action{processed};
		} elsif ($action{cmd} =~ /^\\clear$/i) {
			$obj->{-mempool}->set('clipboard',{});
			$obj->{-interface}->prompt($obj->{prompt_num},'');
			$action{action} = 'OUTPUT';
			$action{output} = "Clipboard cleared.\n";
			$obj->{-interface}->rebuild_menu();
		} elsif ($action{cmd} =~ /^\\paste(\s+(.*))?$/) {
			unless ($1) {
				$action{action} = 'OUTPUT';
				$action{output} = "You must specify insert-like command after \\paste.\n";
			} else {
				my $sql = $2;
				my $clip = $obj->{-mempool}->get('clipboard');
				if (exists $clip->{-result}) {
					for (@{$clip->{-result}}) {
                                		my $newaction = { action => 'SQL', sql => $sql, type => 'do', placeholders => $_ };
                                		$obj->{-interface}->add_to_actionlist($newaction);
					}
					$action{action} = 'OUTPUT';
					$action{output} = "Pasting from clipboard inserted into actionlist buffer.\n";
				} else {
					$action{action} = 'OUTPUT';
					$action{output} = "No data in clipboard.\n";
				}
			}
		} elsif ($action{cmd} =~ /^show\s+clipboard$/i) {
			my $clip = $obj->{-mempool}->get('clipboard');
			if (exists $clip->{-result}) {
				$action{action} = 'SQL_RESULT';
				$action{result} = $clip->{-result};
				$action{fieldnames} = $clip->{-fieldnames};
				$action{fieldtypes} = $clip->{-fieldtypes};
				$action{type} = 'select';
			} else {
				$action{action} = 'OUTPUT';
				$action{output} = "No data in clipboard.\n";
			}
			delete $action{processed};
		}
	}

	return %action;
}

sub cmdhelp {
	return [
		'\copy <command>' => 'Copy output of <command> to clipboard (<command> must be select-like command)',
		'\unioncopy <command>' => 'Appending output of <command> to clipboard (<command> must be select-like command)',
		'\paste <command>' => 'Paste block from clipboard into insert-like <command> with bind variables',
		'\clear' => 'Clear contents of clipboard',
		'SHOW CLIPBOARD' => 'Show contents of clipboard'
	];
}


sub restart_complete {
	my ($obj,$text,$line,$start) = @_;
	my %action = (action => 'LINE_COMPLETE', text => $text, line => $line,
		start => $start);
	do {
		%action = $obj->{-core}->handle_action(%action);