in reply to Is the signal handler supposed to work like this?
#!perl use strict; use Win32::API; use Win32::API::Callback; use constant CTRL_C_EVENT => 0; use constant CTRL_BREAK_EVENT => 1; use constant CTRL_CLOSE_EVENT => 2; use constant CTRL_LOGOFF_EVENT => 5; use constant CTRL_SHUTDOWN_EVENT => 6; ###################################################################### +# # BOOL WINAPI HandlerRoutine( __in DWORD dwCtrlType ); my $cbfn = Win32::API::Callback->new( sub { my $type = shift; return 0 +; }, 'L', 'L' ); ###################################################################### +# # BOOL WINAPI SetConsoleCtrlHandler( __in_opt PHANDLER_ROUTINE Handle +rRoutine, __in BOOL Add); my $fn1 = new Win32::API('kernel32', 'SetConsoleCtrlHandler', 'KL', 'L +'); die "Can't get function handle" unless ($fn1); # The following line of code complains that PHANDLER_ROUTINE is an unk +nown type. Boo. Hiss. #my $fn = new Win32::API('kernel32', 'BOOL SetConsoleCtrlHandler(PHAND +LER_ROUTINE HandlerRoutine, BOOL Add)'); #die "Can't get function handle" unless ($fn); my $fn2 = new Win32::API('kernel32', 'SetConsoleCtrlHandler', 'LL', 'L +'); die "Can't get function handle" unless ($fn2); ###################################################################### +# # BOOL WINAPI GenerateConsoleCtrlEvent(DWORD dwCtrlEvent, DWORD dwProc +essGroupId); my $fn3 = new Win32::API('kernel32', 'BOOL GenerateConsoleCtrlEvent(DW +ORD dwCtrlEvent, DWORD dwProcessGroupId)'); die "Can't get function handle" unless ($fn3); print "Registering the callback function...\n"; die "Bad function call return value" unless $fn1->Call($cbfn, 1); # Generate a CTRL-C event that can be captured print "Generating a CTRL-C event...\n"; $fn3->Call(CTRL_C_EVENT, 0); print "Resetting the callback handler...\n"; my $return = $fn2->Call(0, 0); print "Done!\n";
Now, I have a three-line routine that will let me pipe data into it (like 'type file.txt | perl myscript.pl'), or get input from the command line (like 'perl myscript.pl'), and in the latter case the sensible ctrl-C works like the average UNIX person expects. (Yeah, it could be a two-line script if I move the 'use threads' line to the top of the file...)#!perl -w use strict; print "Enter CTRL-C to end input\n"; my $lines = get_lines(); print "Enter CTRL-C to exit\n"; while ( 1 ) { local($") = ', '; print "You entered: @$lines\n"; sleep(1); } sub get_lines { use threads; local($SIG{INT}) = 'IGNORE'; $lines = threads->create( sub{ my @rv = <STDIN>; chomp @rv; return +\@rv } )->join(); }
|
|---|