Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

force.pl

by ixo111 (Acolyte)
on Oct 26, 2002 at 21:48 UTC ( [id://208276]=sourcecode: print w/replies, xml ) Need Help??
Category: utility scripts
Author/Contact Info original c version author uknown to me. this is just a perl translation and refinement of that work.
Description: perl translation of the old classic 'force.c', allowing you to force input to a terminal device. even though it saw a lot of illegitimate use in the past, i've found quite a few legitimate uses for it over the years - the ioctl/fcntl defs are hard-coded at the top and may need to be changed for other systems (consult your ioctl.ph, ioctls.ph and fcntl.ph for the proper values - consult h2ph if you do not have these files in your perl tree)
#!/usr/bin/perl -w

use POSIX;

eval 'sub O_NDELAY () { &O_NONBLOCK;}' unless defined(&O_NDELAY);
eval 'sub TCFLSH () {0x540b;}' unless defined(&TCFLSH);
eval 'sub TIOCSTI () {0x5412;}' unless defined(&TIOCSTI);

if(@ARGV < 2) {
   print "usage : force <device> <command string>\n";
   exit;
}
 
$Device = shift(@ARGV);
$Command = join(' ',@ARGV);

sysopen($DEVICE,$Device,&O_NDELAY|O_RDWR)||die "cannot open device '$D
+evice' : $!\n";

if(ioctl($DEVICE,&TCFLSH,0) < 0) {
   print "ioctl TCFLSH error on '$Device' : $!\n";
}
 
foreach $Char (split(//,"$Command\n")) {
   if(!(ioctl($DEVICE,&TIOCSTI,$Char))) {
      print "ioctl TIOCSTI error on '$Device': $!\n";
   }
}
close($DEVICE)||die "cannot close device '$Device' : $!\n";
Replies are listed 'Best First'.
Re: force.pl
by nothingmuch (Priest) on Oct 27, 2002 at 18:56 UTC
    the Fcntl module has obsoleted fcntl.ph, and is built using the corresponding C libraries as an XS module - probably more reliable. You should import whatever constants you can from there, instead of hard coding. As for ioctl, you're still stuck with translating header files and such.

    -nuffin
    zz zZ Z Z #!perl

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://208276]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others perusing the Monastery: (3)
As of 2024-06-20 00:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.