Buying                             Selling
Sum     Size    Bid                Ask         Size    Sum
50.0    49.9827 128.52000          129.00000   5.7530  5.8
72.9    22.9517 128.51000          129.96974   9.9615  15.7
122.9   50.0000 128.22300          129.97074   0.2500  16.0
130.4   7.4877  128.00100          129.97075   0.2500  16.2
566.9   436.4643    128.00000      130.00000   10.8430 27.1
567.9   1.0097  127.99721          130.00120   0.2500  27.3
567.9   0.0200  127.98500          130.05470   1.0795  28.4
568.9   1.0000  127.98000          130.40294   1.7991  30.2
568.9   0.0279  127.97248          130.43000   64.5828 94.8
569.0   0.0200  127.94500          130.51400   43.8551 138.6
569.5   0.5050  127.92086          130.80000   2.0000  140.6
570.3   0.7817  127.92082          130.99000   41.3054 181.9
570.3   0.0200  127.90500          130.99999   1.0273  183.0
570.3   0.0200  127.86500          131.00000   24.9000 207.9
580.3   10.0000 127.84099          131.05362   0.5000  208.4

$ mktx.pl 
idx       amount                             address  btcdays grp                                                               vout
 0)  18.43147597  1A7y8jy7xxxxxxxxxxxxxxxxxxxxxxxxxx    29.44   8 9c26c17f780e9e9415a6b8a58fxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:0
 1)  13.30826540  19GgbRa5xxxxxxxxxxxxxxxxxxxxxxxxxx   144.73   0 9d7ffe1562756e216c92935a71xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:0
 2)   9.00000000  18NAfDsdxxxxxxxxxxxxxxxxxxxxxxxxxx  1192.31  10 0ba6400f87c554b7e41d0fe8b8xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:1
 3)   3.58293316  15HK4cyhxxxxxxxxxxxxxxxxxxxxxxxxxx    14.18  12 a2dad2d0289449b80850d77b2dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:2
 4)   2.57453211  1KXoabe8xxxxxxxxxxxxxxxxxxxxxxxxxx   349.31   0 5f94d690d75bca1becdc91cacdxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:0
 5)   2.29610578   1ydDG6nxxxxxxxxxxxxxxxxxxxxxxxxxx     9.09   2 a2dad2d0289449b80850d77b2dxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:0
 6)   1.83458911  1EmHjWp7xxxxxxxxxxxxxxxxxxxxxxxxxx     7.29  11 df64fb188d1965a6607032b502xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:1
 7)   0.80863146  1LMUtqtJxxxxxxxxxxxxxxxxxxxxxxxxxx     3.21   6 df64fb188d1965a6607032b502xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:0
 8)   0.59664818  1HyZb7Psxxxxxxxxxxxxxxxxxxxxxxxxxx     2.36   1 16703bc4ce9f35bd75a64e07e5xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx:1

Select inputs (separated by spaces): 0 1 4

Enter outputs: destination address and amount separated by a space (enter to finish)
Enter output (34.31427348 available): 12XCzX7ogxxxxxxxxxxxxxxxxxxxxxxxxx 26.34859225
Enter output (7.96568123 available): 

  Debug: inputs total amount is '34.31427348', assigned '26.34859225'

Enter address where to send 7.96568123 as change: new

  Change will go to '1BZoDTY3NGr65axxxxxxxxxxxxxxxxxxxx'

  Debug: estimated transaction size: 614 bytes (fee required at 10000 bytes or more)
  Debug: transaction priority: 122770.67M (fee required at 57.6M or less)

Enter desired fee (default 0): 
Enter wallet passphrase (needed for signing the transaction): 

#!/usr/bin/perl

## TODO: could add: if ($fee) { print "you're paying %d satoshis per kb", $fee*1e8 / ($tx_size/1000); }

use warnings;
use strict;
use File::Spec;
use Scalar::Util qw/looks_like_number/;
use List::Util qw/min sum shuffle/;
use Getopt::Long;
use JSON::RPC::Client;
use Data::Dumper;

my $MIN_FEE = 0.0005;
my $cfgfile = File::Spec->catfile ($ENV{'HOME'}, '.bitcoin', 'bitcoin.conf');
my ($rpcuser, $rpcpass);

sub get_rpc {
    -f $cfgfile or die "bitcoin configuration not found\n";

    open my $fd, '<', $cfgfile or die "open: '$cfgfile': $!";
    while (<$fd>) {
        if (/^rpcuser=(.*)/)     { $rpcuser = $1; }
        if (/^rpcpassword=(.*)/) { $rpcpass = $1; }
    }    
    close $fd;

    if (!$rpcuser or !$rpcpass) { die "can't find RPC credentials in bitcoin configuration\n"; }

    my $url = "http://$rpcuser:$rpcpass\@localhost:8332/";      
    my $rpc = JSON::RPC::Client->new;
    $rpc->prepare ($url, [ qw/
        createrawtransaction decoderawtransaction getnewaddress getrawtransaction listaddressgroupings
        listunspent signrawtransaction validateaddress walletpassphrase
    / ]); 

    return $rpc;
}

sub addr2grp {
    my ($rpc) = @_;

    my $groupings = $rpc->listaddressgroupings;
    my %addr2grp;
    foreach my $group_idx (0 .. $#$groupings) {
        foreach my $entry (@{ $groupings->[$group_idx] }) {
            $addr2grp{ $entry->[0] } = $group_idx;
        }
    }
    return %addr2grp;
}

sub vouts {
    my ($rpc) = @_;

    my $unspent = $rpc->listunspent;

    my $vouts;
    foreach my $u (@$unspent) {
        my $rawtx = $rpc->getrawtransaction ($u->{'txid'});
        $rawtx = $rpc->decoderawtransaction ($rawtx);
        my $vout = $rawtx->{'vout'}[$u->{'vout'}];

        next if 'pubkeyhash' ne $vout->{'scriptPubKey'}{'type'} and 'scripthash' ne $vout->{'scriptPubKey'}{'type'};

        $u->{'address'} = $vout->{'scriptPubKey'}{'addresses'}[0];
        $u->{'btcdays'} = $u->{'amount'} * $u->{'confirmations'} / 144;

        push @$vouts, $u;
    }

    return $vouts;
}

sub get_selected_outs {
    my ($largest_out) = @_;

    print "\n";
    OUTER: {
        print 'Select inputs (separated by spaces): ';
        my $selected_ins = <>; chomp $selected_ins; my @selected_ins = split /\s+/, $selected_ins;
        foreach my $in (@selected_ins) {
            if ($in !~ /^\d+$/)     { warn "Error: invalid input '$in'\n"; redo OUTER; }
            if ($in > $largest_out) { warn "Error: input '$in' too large\n"; redo OUTER; }
        }
        return @selected_ins;
    }
}

sub get_dests {
    my ($rpc, $avail) = @_;

    my %dests;
    print "\nEnter outputs: destination address and amount separated by a space (enter to finish)\n";
    while (1) {
        print "Enter output ($avail available): ";
        my $dest = <>; chomp $dest;
        if (!length $dest) {
            last if %dests;
            warn "enter at least one destination\n";
            redo;
        }

        my ($dest_addr, $dest_amnt) = split /\s+/, $dest;
        if (!defined $dest_amnt) {
            print "error: enter destination address and amount separated by a space\n";
            next;
        }
        if (!looks_like_number $dest_amnt)                    { warn "amount '$dest_amnt' isn't a number\n"; redo; }
        if ($dest_amnt <= 0)                                  { warn "amount '$dest_amnt' isn't positive\n"; redo; }
        if ('new' eq $dest_addr) {
            $dest_addr = $rpc->getnewaddress;
            print "Using address '$dest_addr'\n";
        }
        if (!$rpc->validateaddress ($dest_addr)->{'isvalid'}) { warn "address '$dest_addr' is invalid\n"; redo; }
        if (exists $dests{$dest_addr})                        { warn "there's already an output to that address\n"; redo; }
        if ($dest_amnt > $avail)                              { warn "Error: not enough funds in the selected inputs\n"; redo; }

        $dests{$dest_addr} = 0+$dest_amnt;
        $avail = 0+sprintf '%.8f', $avail - $dest_amnt;
        last unless $avail;
    }
    print "\n";
    return %dests;
}

sub fee {
    my ($selected, $dests, $change_addr) = @_;

    my $tx_size = 10 + 180*@$selected + 32*keys %$dests;
    print "  Debug: estimated transaction size: $tx_size bytes (fee required at 10000 bytes or more)\n";
    my $tx_size_ok = $tx_size < 10000;

    my $smallest_out = min values %$dests;
    my $out_amounts_ok = $smallest_out >= 0.01;

    my $tx_prio = sum map { $_->{'amount'}*10e8 * $_->{'confirmations'} } @$selected;
    $tx_prio /= $tx_size;
    my $tx_prio_ok = $tx_prio > 57_600_000;
    printf "  Debug: transaction priority: %.2fM (fee required at 57.6M or less)\n", $tx_prio/1e6;

    my $sugg_fee = 0;
    if (!$tx_size_ok || !$out_amounts_ok) {
        if (!$tx_size_ok)     { print "  Transaction too big ($tx_size bytes), fee recommended\n"; }
        if (!$out_amounts_ok) { print "  Some of the outputs is smaller than 0.01 BTC ($smallest_out), fee recommended\n"; }
        my $rounded_tx_size = int ($tx_size / 1000); $rounded_tx_size++;
        $sugg_fee = $MIN_FEE * $rounded_tx_size;
    }
    if (!$tx_prio_ok) {
        print "  Transaction priority too low ($tx_prio), fee recommended\n";
        $sugg_fee += $MIN_FEE;
    }

    print "  Warning: a fee is recommended but this transaction hasn't a change output from which substract the fee\n" if $sugg_fee && !$change_addr;
    print "  Warning: suggested fee is greater than the change output\n" if $change_addr and $sugg_fee > $dests->{$change_addr};
    print "\nEnter desired fee (default $sugg_fee): "; my $fee = <>; chomp $fee; $fee ||= $sugg_fee;
    if (!$fee) {
        print "  Warning: a fee is recommended\n" if $sugg_fee;
        return;
    }
    die "Error: no change output from which substract the fee\n" if $fee && !$change_addr;
    die "Error: fee is greater than the change output\n" if $change_addr and $fee > $dests->{$change_addr};
    if ($fee == $dests->{$change_addr}) {
        delete $dests->{$change_addr};   ## oops, this alters the tx size, therefore it potentially affects the fee itself
    } else {
        $dests->{$change_addr} -= $fee;
    }
}

###################################################

GetOptions \my %opts, '--list' or die "getopt failed\n";

my $rpc = get_rpc;
my %addr_to_group = addr2grp $rpc;
my $vouts = vouts $rpc or do { print "No funds\n"; exit; };

printf qq/%3s %12s %35s %8s %3s %66s\n/, qw/idx amount address btcdays grp vout/;
my $index = 0;
@$vouts = reverse sort { $a->{'amount'} <=> $b->{'amount'} } @$vouts;
foreach my $vout (@$vouts) {
    #my $amnt = $vout->{'amount'}; if ($amnt !~ /\./) { $amnt .= '.'; } $amnt .= '00000000'; $amnt =~ s/(\..{8}).*/$1/;
    my $amnt = sprintf '%.8f', $vout->{'amount'};
    printf qq/%2s) %12s %35s %8.2f %3s %s:%s\n/, $index, $amnt, @$vout{qw/address btcdays/}, $addr_to_group{ $vout->{'address'} }, @$vout{qw/txid vout/};
    $index++;
}

exit if $opts{'list'};

my @selected_ins = get_selected_outs $#$vouts;

my @selected = @$vouts[@selected_ins];
my $available_amnt = sum map { $_->{'amount'} } @selected;

my %dests = get_dests $rpc, $available_amnt;
my $txamnt = sum values %dests;

my $unassigned = sprintf '%.8f', $available_amnt - $txamnt;
my $change_addr;
if ($unassigned >= 1e-8) {
    ## $unassigned may have extra decimal places due to floating point issues, see if those decimals
    ## are already present in these variables or they appear in the substraction above
    print "  Debug: inputs total amount is '$available_amnt', assigned '$txamnt'\n\n";
    {
        print "Enter address where to send $unassigned as change: "; $change_addr = <>; chomp $change_addr;
        if ('new' eq $change_addr) {
            $change_addr = $rpc->getnewaddress;
            print "\n  Change will go to '$change_addr'\n";
        }
        if (!$rpc->validateaddress ($change_addr)->{'isvalid'}) { warn "address '$change_addr' is invalid\n"; redo; }
        if (exists $dests{$change_addr})                        { warn "there's already an output to that address\n"; redo; }
        $dests{$change_addr} = 0+$unassigned;
        last;
    }
    print "\n";
}

fee \@selected, \%dests, $change_addr;

my $ins  = [ shuffle map { { txid => $_->{'txid'}, vout => 0+$_->{'vout'} } } @selected ];
my $outs = \%dests;
my $tx = $rpc->createrawtransaction ([ $ins, $outs ]);

print 'Enter wallet passphrase (needed for signing the transaction): ';
system 'stty -echo' and die "fork/exec: $!";   ## this could be improved
my $wpp = <>; chomp $wpp; print "\n";
system 'stty echo' and die "fork/exec: $!";

$rpc->walletpassphrase ($wpp, 1);
my $signed_tx = $rpc->signrawtransaction ($tx)->{'hex'};
my $decoded = $rpc->decoderawtransaction ($signed_tx);
print Data::Dumper->Dump (sub{\@_}->(\$decoded), ['Transaction']);
print "Raw: $signed_tx\n";

END { system 'stty echo'; }

$ bitcoind getblock $(bitcoind getblockhash 59572)
{
    "hash" : "4d9862b15cdc472aa7c0837287b01cd58f230dc18360f81d36ba1e47cbf7300b",
    "confirmations" : 0,
    "size" : 215,
    "height" : 59572,
    "version" : 0,
[...]