Okay. How do you like this solution?

#!/usr/bin/perl use strict; use warnings; $^O =~ m/MSWIN/i or die "\nTHIS DEMO REQUIRES WINDOWS.\n"; my $PERL_EXEC = "TINYPERL.EXE"; my $PERL_DIR = "C:\\BIN\\PERL\\"; # If you put anything here, it must + end with a backslash. my $USE_PERL_SWITCHES = "-I C:\\BIN\\PERL\\LIB"; my $SELF_ID = 'PROC' . int(rand() * 9999999); my $AM_I_CHILD = (join('', @ARGV) =~ m/CHILD/i); my $CHILDREN = 0; my @PID_NO; my @PID_ID; my @PID_T; ENUM('ALREADY EXISTING'); for (;;) { print("\n\tI AM " . ($AM_I_CHILD ? "A CHILD" : "THE PARENT"), " PROC +ESS.\n"); print "\n\tMY IDENTITY : $SELF_ID"; print "\n\tTHE CURRENT TIME : " . localtime(); print "\n\tTHE VALUE OF \$0 : $0"; print "\n\tMY ARGUMENTS : @ARGV"; print "\n\tCHILD PROCS : $CHILDREN"; print "\n\tCURRENT DIR : ", `CD`; print "\n\tHERE IS A LIST OF PERL PROCESSES CURRENTLY RUNNING:\n"; for (my $i = 0; $i < @PID_NO; $i++) { print "\n\t\t PID: ", $PID_NO[$i], "\t", $PID_ID[$i], "\tstarted: +", (time - $PID_T[$i]), ' sec. ago'; } print "\n\n"; print "\n\tTYPE \"S <PID>\" TO STOP A CHILD PROCESS."; print "\n\tTYPE \"N\" TO START A NEW PROCESS."; print "\n\tTYPE \"L\" TO STOP ALL MY CHILD PROCESSES."; print "\n\tTYPE \"X\" TO EXIT THIS PROCESS ONLY."; print "\n\tTYPE \"E\" TO END THIS PROCESS (AND ALL CHILD PROCESSES). +"; print "\n\tTYPE \"A\" TO KILL ALL PERL PROCESS IN MEMORY (OTHERS AS +WELL)."; print "\n\n\t> "; $a = <STDIN>; if ($a =~ m/X/i) { exit(); } if ($a =~ m/N/i) { FORK(); } if ($a =~ m/S/i) { STOP_ONE_CHILD($a); } if ($a =~ m/L/i) { KILLALL_CHILD(); } if ($a =~ m/E/i) { KILLALL_CHILD(); exit; } if ($a =~ m/A/i) { KILLALL_PERL(); exit; } system('CLS'); ENUM('OTHER NEW'); # All perl processes started by child processes # will be labeled as "OTHER" and will not be # considered a "direct relative" of this process +. } sub ENUM { my $ADD = shift; my $LIST = uc(`tasklist`); for (my $i = 0; $i < length($LIST); $i++) { my $P = index($LIST, uc($PERL_EXEC), $i); if ($P < 0) { last; } my $PID = substr($LIST, $P + 28, 5); $i = $P + 30; $PID =~ tr|0-9||cd; # Keep digits only # Look up PID in our database my $FOUND = 0; foreach (@PID_NO) { if ($PID eq $_) { $FOUND = 1; last; }} if ($FOUND == 0) { push(@PID_NO, $PID); push(@PID_ID, $ADD); push(@PID_T, time); } } # If there is only one process running, then that's myself. if (@PID_ID == 1) { @PID_ID = ('SELF'); } } sub STOP_ONE_CHILD { my $USER_INPUT = shift; $USER_INPUT =~ tr|0-9||cd; # Keep digits only. my $MYCHILD = 0; for (my $i = 0; $i < @PID_NO; $i++) { if ($USER_INPUT eq $PID_NO[$i] && $PID_ID[$i] eq 'CHILD') { $MYCHILD = 1; last; } } if ($MYCHILD) { system("TASKKILL /F /PID $USER_INPUT"); } } sub KILLALL_CHILD { my $CMD = ''; for (my $i = 0; $i < @PID_NO; $i++) { if ($PID_ID[$i] eq 'CHILD') { $CMD .= ' /PID ' . $PID_NO[$i]; $PID_ID[$i] = 'STOPPED BY PARENT'; } } if (length($CMD)) { system("TASKKILL /F $CMD"); } } sub KILLALL_PERL { for (my $i = 0; $i < @PID_NO; $i++) { system("TASKKILL /F /IM $PERL_EXEC"); } } sub FORK { system("START $PERL_DIR$PERL_EXEC $USE_PERL_SWITCHES $0 CHILD $SELF_ +ID"); $CHILDREN++; ENUM('CHILD'); }

2023-04-04 Reparented by Athanasius.


In reply to Re: How to portably stop processes? by harangzsolt33
in thread How to portably stop processes? by haj

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.