view release on metacpan or  search on metacpan

Tty.xs  view on Meta::CPAN

		}
		*ptyfd = open(buf, O_RDWR | O_NOCTTY);
		if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen))
		    break;

		/* Try BeOS style naming */
		snprintf(buf, sizeof(buf), "/dev/pt/%c%c",
			ptymajors[i / num_minors],
			ptyminors[i % num_minors]);
		snprintf(tbuf, sizeof(tbuf), "/dev/tt/%c%c",
			ptymajors[i / num_minors],
			ptyminors[i % num_minors]);
		if (strlcpy(namebuf, tbuf, namebuflen) >= namebuflen) {
		  warn("ERROR: pty_allocate: ttyname truncated");
		  return 0;
		}
		*ptyfd = open(buf, O_RDWR | O_NOCTTY);
		if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen))
		    break;

		/* Try z/OS style naming */
		snprintf(buf, sizeof(buf), "/dev/ptyp%04d", i);
		snprintf(tbuf, sizeof(tbuf), "/dev/ttyp%04d", i);
		if (strlcpy(namebuf, tbuf, namebuflen) >= namebuflen) {
		  warn("ERROR: pty_allocate: ttyname truncated");
		  return 0;
		}
		*ptyfd = open(buf, O_RDWR | O_NOCTTY);
		if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen))
		    break;

		namebuf[0] = 0;
	    }
	    if (*ptyfd >= 0)
		break;
	}

    } while (0);

    if (*ptyfd < 0 || namebuf[0] == 0)
	return 0;		/* we failed to allocate one */

    return 1;			/* whew, finally finished successfully */
} /* end allocate_pty */



MODULE = IO::Tty	PACKAGE = IO::Pty

PROTOTYPES: DISABLE

void
pty_allocate()
    INIT:
	int ptyfd, ttyfd, ret;
	char name[256];
#ifdef PTY_DEBUG
        SV *debug;
#endif

    PPCODE:
#ifdef PTY_DEBUG
        debug = get_sv("IO::Tty::DEBUG", FALSE);
  	if (SvTRUE(debug))
          print_debug = 1;
#endif
	ret = allocate_pty(&ptyfd, &ttyfd, name, sizeof(name));
	if (ret) {
	    name[sizeof(name)-1] = 0;
	    EXTEND(SP,3);
	    PUSHs(sv_2mortal(newSViv(ptyfd)));	
	    PUSHs(sv_2mortal(newSViv(ttyfd)));	
	    PUSHs(sv_2mortal(newSVpv(name, strlen(name))));	
        } else {
	    /* empty list */
	}


MODULE = IO::Tty	PACKAGE = IO::Tty

int
_open_tty(ttyname, noctty = 1)
	char *ttyname
	int noctty
    CODE:
	RETVAL = open(ttyname, noctty ? (O_RDWR | O_NOCTTY) : O_RDWR);
	if (RETVAL >= 0) {
#if defined(I_PUSH)
	    ioctl(RETVAL, I_PUSH, "ptem");
	    ioctl(RETVAL, I_PUSH, "ldterm");
	    ioctl(RETVAL, I_PUSH, "ttcompat");
#endif
	}
    OUTPUT:
	RETVAL

char *
ttyname(fh)
    SV * fh
    CODE:
#ifdef HAVE_TTYNAME
	{
	    IO *io = sv_2io(fh);
	    PerlIO *f = io ? IoIFP(io) : NULL;
	    if (!f && io)
		f = IoOFP(io);
	    if (f)
		RETVAL = ttyname(PerlIO_fileno(f));
	    else {
		RETVAL = NULL;
		errno = EINVAL;
	    }
	}
#else
	warn("IO::Tty::ttyname not implemented on this architecture");
	RETVAL = NULL;
#endif
    OUTPUT:
	RETVAL

SV *
pack_winsize(row, col, xpixel = 0, ypixel = 0)
	int row
	int col
	int xpixel
	int ypixel
    INIT:
	struct winsize ws;
    CODE:
	ws.ws_row = row;
	ws.ws_col = col;
	ws.ws_xpixel = xpixel;
	ws.ws_ypixel = ypixel;
	RETVAL = newSVpvn((char *)&ws, sizeof(ws));
    OUTPUT:
	RETVAL

void
unpack_winsize(winsize)
	SV *winsize;
    INIT:
	struct winsize ws;
    PPCODE:
	if(SvCUR(winsize) != sizeof(ws))
	    croak("IO::Tty::unpack_winsize(): Bad arg length - got %zd, expected %zd",
		SvCUR(winsize), sizeof(ws));
	Copy(SvPV_nolen(winsize), &ws, sizeof(ws), char);
	EXTEND(SP, 4);
	PUSHs(sv_2mortal(newSViv(ws.ws_row)));
	PUSHs(sv_2mortal(newSViv(ws.ws_col)));
	PUSHs(sv_2mortal(newSViv(ws.ws_xpixel)));
	PUSHs(sv_2mortal(newSViv(ws.ws_ypixel)));


BOOT:
{
  HV *stash;
  SV *config;

  stash = gv_stashpv("IO::Tty::Constant", TRUE);
  config = get_sv("IO::Tty::CONFIG", TRUE);    
#include "xssubs.c"
}