#! /usr/bin/perl

use strict;
use warnings;

use Socket;
use POSIX;

sub named_socket_spawn {
    my $code = shift;
    ref $code eq 'CODE' or return;

    my ($serv, $conn);
    socket($serv, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
                                        || die "socket: $!";

    my $sname = tmpnam();
    bind($serv, sockaddr_un($sname))    || die "bind: $!";
    listen($serv, 1)                    || die "listen: $!";

    my $pid = fork()                    // die "fork: $!";

    if ($pid) {
        close $serv;
        return $sname;
    }
    accept($conn, $serv)                || warn "accept: $!";
    unlink($sname)                      || warn "unlink: $!";
    open STDIN, "<&", $conn;
    open STDOUT, ">&", $conn;
    close $serv;
    close $conn;
    exit $code->();
}

use DBD::mysql;

#my $sqlsock = named_socket_spawn(sub{exec "ssh host -W host:3306"});
my $sqlsock = named_socket_spawn(sub{ exec "nc localhost 3306" });

my $dsn = "DBI:mysql:database=test;mysql_socket=$sqlsock";

my $dbh = DBI->connect($dsn, "test", "hunter5");