Tuesday, January 13, 2009

txp.pl/ctxp.pl

With a little bit of free time today, I decided to write something similar to TextExpander in Perl. Using getc and setc, it'll put and read from the clipboard of your GUI, respectively:

txp.pl

#!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use Clipboard;
use DBI;

my $usage = ($0 eq 'ctxp.pl' and "Usage: $0 key\n" or "Usage: $0 [ set key value | setf key | setf key | unset key | get key | getc key | list ]\n");

scalar @ARGV || die $usage;
my $action = shift @ARGV;

my $dbh = DBI->connect('dbi:SQLite:dbname=' . $ENV{HOME} . '/.txp_db', '', '');
$dbh->do('CREATE TABLE IF NOT EXISTS expanders(id INTEGER PRIMARY KEY AUTOINCREMENT, key VARCHAR(64), value TEXT)');



sub set_or_add {
my ($dbh, $key, $value) = @_;
if(scalar @{$dbh->selectall_arrayref('SELECT id FROM expanders WHERE key = ?', undef, $key)}) {
$dbh->do('UPDATE expanders SET value = ? WHERE key = ?', undef, $value, $key);
}
else {
$dbh->do('INSERT INTO expanders(key, value) VALUES(?, ?)', undef, $key, $value);
}
}
sub unset {
my ($dbh, $key) = @_;
my $sth = $dbh->prepare('DELETE FROM expanders WHERE key = ?');
$sth->execute($key);
return $sth->rows;
}
sub get {
my ($dbh, $key) = @_;
my $value = undef;
my $row = $dbh->selectrow_arrayref('SELECT * FROM expanders WHERE key = ?', undef, $key);
($value = ${$row}[2]) if($row);
return $value;
}

if($0 eq 'ctxp.pl') {
my $key = $action;
my $value = get($dbh, $key);
Clipboard->copy($value) if($value);
}
elsif($action eq 'set' and scalar @ARGV == 2) {
my ($key, $value) = @ARGV;
chomp($value);
set_or_add($dbh, $key, $value);
}
elsif($action eq 'setf' and scalar @ARGV == 1) {
my $key = shift @ARGV;
my @lines = <STDIN>;
my $value = join('', @lines);
chomp($value);
set_or_add($dbh, $key, $value);
}
elsif($action eq 'setc' and scalar @ARGV == 1) {
my $key = shift @ARGV;
my $value = Clipboard->paste();
chomp($value);
set_or_add($dbh, $key, $value);
}
elsif($action eq 'unset' and scalar @ARGV == 1) {
my $key = shift @ARGV;
my $count = unset($dbh, $key);
print "$count rows affected.\n";
}
elsif($action eq 'get' and scalar @ARGV == 1) {
my $key = shift @ARGV;
my $value = get($dbh, $key);
if($value) {
print "$value\n";
}
else {
print STDERR "No matches found for $key\n";
}
}
elsif($action eq 'getc' and scalar @ARGV == 1) {
my $key = shift @ARGV;
my $value = get($dbh, $key);
if($value) {
print "$value\n";
Clipboard->copy($value);
}
else {
print STDERR "No matches found for $key\n";
}
}
elsif($action eq 'list' and scalar @ARGV == 0) {
my $rows = $dbh->selectall_arrayref('SELECT * FROM expanders');
if(scalar @{$rows}) {
(print ${$_}[1] . ' => ' . ${$_}[2] . "\n") foreach(@{$rows});
}
else {
print STDERR "No mappings present.\n";
}
}
else {
print STDERR $usage;
}




$dbh->disconnect();
% perl txp.pl list
cows => How now brown cow.
nante => 何てね
% perl txp.pl unset cows
1 rows affected.
% echo 'Foos are bars.' | perl txp.pl setf foo
% perl txp.pl list
nante => 何てね
foo => Foos are bars.
% perl txp.pl set argv "Arrrgh."
% perl txp.pl list
nante => 何てね
foo => Foos are bars.
argv => Arrrgh.

No comments: