home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / comp / lang / perl / 7561 / mrm-execute.pl < prev    next >
Encoding:
Perl Script  |  1992-12-21  |  13.3 KB  |  550 lines
  1. #! /usr/local/bin/perl
  2.  
  3. # Wrappers around execute, providing control on whether to die or not,
  4. # and to handle redirection.
  5.  
  6. {
  7.     package main;
  8.     require 'mrm-export.pl';
  9.  
  10.     &export ('execute', $EXPORT_FUNCTION,
  11.          'execute_status',
  12.          'execute',
  13.          'execute_or_die',
  14.          'execute_pipe',
  15.          'execute_pipe_or_die',
  16.          'execute_redirect',
  17.          'execute_redirect_or_die',
  18.          'execute_output',
  19.          'execute_output_or_die',
  20.          'spawn',
  21.          'spawn_redirect',
  22.          'spawn_wait',
  23.          'execute_trace',
  24.          'execute_run',
  25.          'change_directory');
  26.  
  27.     &import ('execute', $IMPORT_FUNCTION, 'trace', 'trace_enable', 'fix_file', 'unfix_file');
  28.     &import ('execute', $IMPORT_VARIABLE, 'trace_p');
  29.  
  30.     $EXPORT_FUNCTION || $IMPORT_FUNCTION || $IMPORT_VARIABLE;    # silence perl -w
  31. }
  32.  
  33. package execute;
  34.  
  35. {
  36.     $prog        = substr ($0, rindex ($0, '/') + 1);
  37.     $exec        = !defined ($ENV{'EXECUTE_NOEXEC'});
  38.     $no_stdin    = undef;
  39.     $no_stdout    = undef;
  40.     $no_stderr    = undef;
  41.     $no_func    = undef;
  42.     $no_parent_func    = undef;
  43.     $no_child_func    = undef;
  44.     $do_wait    = 1;
  45.     $no_wait    = 0;
  46.     @sig_names    = ('SIG<none>',
  47.                'SIGHUP',
  48.                'SIGINT',
  49.                'SIGQUIT',
  50.                'SIGILL',
  51.                'SIGTRAP',
  52.                'SIGABRT',
  53.                'SIGEMT',
  54.                'SIGFPE',
  55.                'SIGKILL',
  56.                'SIGBUS',
  57.                'SIGSEGV',
  58.                'SIGSYS',
  59.                'SIGPIPE',
  60.                'SIGALRM',
  61.                'SIGTERM',
  62.                'SIGURG',
  63.                'SIGSTOP',
  64.                'SIGTSTP',
  65.                'SIGCONT',
  66.                'SIGCHLD',
  67.                'SIGTTIN',
  68.                'SIGTTOU',
  69.                'SIGIO',
  70.                'SIGXCPU',
  71.                'SIGXFSZ',
  72.                'SIGVTALRM',
  73.                'SIGPROF',
  74.                'SIGWINCH',
  75.                'SIGINFO',
  76.                'SIGUSR1',
  77.                'SIGUSR2');
  78. }
  79.  
  80.  
  81. # Function to decode the exit status into a normal readable string.
  82.  
  83. sub execute_status {
  84.     local ($status)        = undef;
  85.     local ($raw_status)    = (scalar (@_) > 0) ? shift (@_) : $?;
  86.  
  87.     if ($raw_status == 0) {
  88.         $status = 'no errors';
  89.  
  90.     } elsif ($raw_status >= 256) {                # non-zero exit
  91.         local ($ret_code) = $raw_status >> 8;
  92.         $status = "exit status = $ret_code";
  93.             
  94.     } elsif ($raw_status > 0) {                # killed by signal
  95.         local ($sig)  = $raw_status & 127;
  96.         local ($name) = $sig_names[ $sig - $[ ];
  97.         local ($core) = ($raw_status & 128) ? ', core dumped' : '';
  98.         $status = "Killed by signal $sig ($name)$core";
  99.     }
  100.  
  101.     if (wantarray) {
  102.         ($status, $raw_status);
  103.     } else {
  104.         $status;
  105.     }
  106. }
  107.  
  108.  
  109. # Internal function to execute a program.
  110. # Arg 1 is the file to open as stdin,  or undef
  111. # Arg 2 is the file to open as stdout, or undef
  112. # Arg 3 is the file to open as stderr, or undef
  113. # Arg 4 is the function to call with each line of input when spawning the program on a pipe
  114. # Arg 5 is the function to call in the parent context after starting child.
  115. # Arg 6 is the function to call in the child context before doing the exec.
  116. # Arg 7 is true if we want to wait for the process to finish.
  117. # Arg 8 is the program to execute.
  118. # Arg 9.. are the program arguments.
  119.  
  120. # If we are waiting for the process to finish, the return value is the exit status
  121. # If we are not waiting, the return value is the child pid
  122.  
  123. sub execute_internal {
  124.     local ($in)            = shift (@_);
  125.     local ($out)            = shift (@_);
  126.     local ($err)            = shift (@_);
  127.     local ($pipe_func)        = shift (@_);
  128.     local ($parent_func)        = shift (@_);
  129.     local ($child_func)        = shift (@_);
  130.     local ($wait)            = shift (@_);
  131.     local ($child_program)        = shift (@_);
  132.     local ($pid)            = undef;
  133.     local ($status)            = undef;
  134.     local ($")            = ' ';
  135.     local (@trace_args)        = @_;
  136.  
  137.     $? = 0;
  138.     push (@trace_args, $in)                        if (defined ($in));
  139.     push (@trace_args, $out)                    if (defined ($out));
  140.     push (@trace_args, "2$err")                    if (defined ($err));
  141.     &trace ('exec', $child_program, @trace_args)            if ($trace_p);
  142.  
  143.     if (!$exec) {
  144.         $status = 'no exec';
  145.         &trace ('stop', "$child_program:", $status)        if ($trace_p);
  146.         return ($status, 0);
  147.     }
  148.  
  149.     (! defined ($pipe_func)) || pipe (PIPE_READ, PIPE_WRITE)    || return ("error in pipe: $!", -1);
  150.     
  151.     $pid = fork ();           
  152.     (defined ($pid) && $pid != -1)                    || return ("fork problems: $!", -1);
  153.     
  154.     if ($pid == 0) {        # child context           
  155.     
  156.         if (defined ($pipe_func)) {          
  157.             open (STDOUT, ">&PIPE_WRITE")            || die "$prog: dup stdout: $!\n";
  158.             open (STDERR, '>&STDOUT')            || die "$prog: dup stderr: $!\n";
  159.             close (PIPE_READ)                || die "$prog: close pipe reader: $!\n";
  160.             close (PIPE_WRITE)                || die "$prog: close pipe writer: $!\n";
  161.         }     
  162.     
  163.         (!defined ($in))  || open (STDIN,  $in)            || die "$prog: open $in: $!\n";
  164.         (!defined ($out)) || open (STDOUT, $out)        || die "$prog: open $out: $!\n";
  165.         (!defined ($err)) || open (STDERR, $err)        || die "$prog: open $err: $!\n";
  166.  
  167.         &$child_func ($child_program, @_)            if (defined ($child_func));
  168.  
  169.         exec ($child_program, @_);
  170.         die "$prog: $child_program: $!\n";
  171.  
  172.     } else {            # parent context
  173.         if (!$wait) {
  174.             &$parent_func ($pid, $child_program, @_)    if (defined ($parent_func));
  175.             return $pid;
  176.         }
  177.  
  178.         local ($int, $quit) = ($SIG{'INT'}, $SIG{'QUIT'});
  179.         $int  = 'DEFAULT'                    if (!defined ($int));
  180.         $quit = 'DEFAULT'                    if (!defined ($quit));
  181.         $SIG{'INT'}  = 'IGNORE'                    if ($int  eq 'DEFAULT');
  182.         $SIG{'QUIT'} = 'IGNORE'                    if ($quit eq 'DEFAULT');
  183.  
  184.         &$parent_func ($pid, $child_program, @_)        if (defined ($parent_func));
  185.  
  186.         if (defined ($pipe_func)) {
  187.             close (PIPE_WRITE)                || return ("close pipe writer: $!", -1);
  188.             while (<PIPE_READ>) {
  189.                 chop;
  190.                 &trace ('pipe', $_)            if ($trace_p);
  191.                 &$pipe_func ($_);
  192.             }
  193.             close (PIPE_READ)                || return ("close pipe reader: $!", -1);
  194.         }
  195.  
  196.         waitpid ($pid, 0);
  197.  
  198.         $SIG{'INT'}  = $int;
  199.         $SIG{'QUIT'} = $quit;
  200.     }
  201.  
  202.     $status = &execute_status ($?);
  203.     &trace ('stop', "$child_program:", $status)            if ($trace_p);
  204.     ($status, $?);
  205. }
  206.  
  207.  
  208. # Function to execute a program, die on signals SIGINT, SIGHUP
  209.  
  210. sub execute {
  211.     local ($") = ' ';
  212.     local ($status, $raw_status) = &execute_internal ($no_stdin,
  213.                               $no_stdout,
  214.                               $no_stderr,
  215.                               $no_func,
  216.                               $no_parent_func,
  217.                               $no_child_func,
  218.                               $do_wait,
  219.                               @_);
  220.  
  221.     die "$prog: @_: $status\n"                if ($raw_status == -1
  222.                                     || ($raw_status & 127) == 2
  223.                                     || ($raw_status & 127) == 3);
  224.  
  225.     if (wantarray) {
  226.         ($status, $raw_status);
  227.     } else {
  228.         $status;
  229.     }
  230. }
  231.  
  232.  
  233. # Function to execute a program, and die if there were errors
  234.  
  235. sub execute_or_die {
  236.     local ($") = ' ';
  237.     local ($status, $raw_status) = &execute_internal ($no_stdin,
  238.                               $no_stdout,
  239.                               $no_stderr,
  240.                               $no_func,
  241.                               $no_parent_func,
  242.                               $no_child_func,
  243.                               $do_wait,
  244.                               @_);
  245.  
  246.     die "$prog: @_: $status\n"                if ($raw_status != 0);
  247.  
  248.     if (wantarray) {
  249.         ($status, $raw_status);
  250.     } else {
  251.         $status;
  252.     }
  253. }
  254.  
  255.  
  256. # Function to execute a program, and direct it's stdout/stderr to a pipe, and call a function
  257. # with each line of the pipe.  The first argument is the name of the function
  258.  
  259. sub execute_pipe {
  260.     local ($func)            = shift (@_);
  261.     local ($")            = ' ';
  262.     local ($package, $src, $line)    = caller;
  263.  
  264.     $func =~ s/^/$package'/                    if ($func !~ /'/);
  265.     local ($status, $raw_status) = &execute_internal ($no_stdin,
  266.                               $no_stdout,
  267.                               $no_stderr,
  268.                               $func,
  269.                               $no_parent_func,
  270.                               $no_child_func,
  271.                               $do_wait,
  272.                               @_);
  273.  
  274.     die "$prog: @_: $status\n"                if ($raw_status == -1
  275.                                     || ($raw_status & 127) == 2
  276.                                     || ($raw_status & 127) == 3);
  277.  
  278.     if (wantarray) {
  279.         ($status, $raw_status);
  280.     } else {
  281.         $status;
  282.     }
  283. }
  284.  
  285.  
  286. # Function to execute a program, and direct it's stdout/stderr to a pipe, and call a function
  287. # with each line of the pipe.  The first argument is the name of the function.  Die if the
  288. # program returns a non-zero status.
  289.  
  290. sub execute_pipe_or_die {
  291.     local ($func)            = shift (@_);
  292.     local ($")            = ' ';
  293.     local ($package, $src, $line)    = caller;
  294.  
  295.     $func =~ s/^/$package'/                    if ($func !~ /'/);
  296.     local ($status, $raw_status) = &execute_internal ($no_stdin,
  297.                               $no_stdout,
  298.                               $no_stderr,
  299.                               $func,
  300.                               $no_parent_func,
  301.                               $no_child_func,
  302.                               $do_wait,
  303.                               @_);
  304.  
  305.     die "$prog: @_: $status\n"                if ($raw_status != 0);
  306.  
  307.     if (wantarray) {
  308.         ($status, $raw_status);
  309.     } else {
  310.         $status;
  311.     }
  312. }
  313.  
  314.  
  315. # Function to execute a program, and redirect its standard files.  The first
  316. # three arguments are the file names for stdin, stdout, or stderr.
  317.  
  318. sub execute_redirect {
  319.     local ($package,$src,$line)    = caller;
  320.     local ($stdin)            = &fix_file (shift (@_), '<', $package);
  321.     local ($stdout)            = &fix_file (shift (@_), '>', $package);
  322.     local ($stderr)            = &fix_file (shift (@_), '>', $package);
  323.     local ($")            = ' ';
  324.  
  325.     local ($status, $raw_status) = &execute_internal ($stdin,
  326.                               $stdout,
  327.                               $stderr,
  328.                               $no_func,
  329.                               $no_parent_func,
  330.                               $no_child_func,
  331.                               $do_wait,
  332.                               @_);
  333.  
  334.     die "$prog: @_: $status\n"                if ($raw_status == -1
  335.                                     || ($raw_status & 127) == 2
  336.                                     || ($raw_status & 127) == 3);
  337.  
  338.     if (wantarray) {
  339.         ($status, $raw_status);
  340.     } else {
  341.         $status;
  342.     }
  343. }
  344.  
  345.  
  346. # Function to execute a program, and redirect its standard files.  The first
  347. # three arguments are the file names for stdin, stdout, or stderr.  If the program
  348. # returns non-zero, die.
  349.  
  350. sub execute_redirect_or_die {
  351.     local ($package,$src,$line)    = caller;
  352.     local ($stdin)            = &fix_file (shift (@_), '<', $package);
  353.     local ($stdout)            = &fix_file (shift (@_), '>', $package);
  354.     local ($stderr)            = &fix_file (shift (@_), '>', $package);
  355.     local ($")            = ' ';
  356.  
  357.     local ($status, $raw_status) = &execute_internal ($stdin,
  358.                               $stdout,
  359.                               $stderr,
  360.                               $no_func,
  361.                               $no_parent_func,
  362.                               $no_child_func,
  363.                               $do_wait,
  364.                               @_);
  365.  
  366.     die "$prog: @_: $status\n"                if ($raw_status != 0);
  367.  
  368.     if (wantarray) {
  369.         ($status, $raw_status);
  370.     } else {
  371.         $status;
  372.     }
  373. }
  374.  
  375.  
  376. # Function to execute a program, and return the output (the same as `` with tracing).
  377. # The first argument is non-null if we want to chop off newlines.
  378.  
  379. sub execute_output {
  380.     local ($do_chop)    = shift (@_);
  381.     local ($child_program)    = $_[$[];
  382.     local ($status)        = undef;
  383.     local ($")        = ' ';
  384.     local ($return_string)    = undef;
  385.     local (@return_array)    = ();
  386.     local (@temp_array)    = ();
  387.     local ($i)        = undef;
  388.  
  389.     $? = 0;
  390.     &trace ('exec output',
  391.         (($do_chop) ? '[chop]' : '[no chop]'),
  392.         ((wantarray) ? '[wantarray]' : '[scalar]'), @_)        if ($trace_p);
  393.  
  394.     if (!$exec) {
  395.         $status = 'no exec';
  396.         &trace ('stop', "$child_program:", $status)        if ($trace_p);
  397.         return "";
  398.     }
  399.  
  400.     if (wantarray) {
  401.         @return_array = `@_`;
  402.         foreach $temp_string (@return_array) {
  403.             chop ($temp_string)                if (substr ($temp_string, -1) eq "\n");
  404.             &trace ('output', $temp_string)            if ($trace_p);
  405.         }
  406.  
  407.         $status = &execute_status ($?);
  408.         &trace ('stop', "$child_program:", $status)        if ($trace_p);
  409.  
  410.         if ($do_chop) {
  411.             for ($i = $[; $i <= $#return_array; $i++) {
  412.                 chop ($return_array[$i])        if (substr ($return_array[$i], -1) eq "\n");
  413.             }
  414.         }
  415.  
  416.         @return_array;
  417.  
  418.     } else {
  419.         local ($temp_string) = undef;
  420.  
  421.         $return_string = `@_`;
  422.         $temp_string = $return_string;
  423.         chop ($temp_string)                    if (substr ($temp_string, -1) eq "\n");
  424.  
  425.         &trace ('output', $temp_string)                if ($trace_p);
  426.  
  427.         $status = &execute_status ($?);
  428.         &trace ('stop', "$child_program:", $status)        if ($trace_p);
  429.  
  430.         chop ($return_string)                    if ($do_chop
  431.                                         && substr ($return_string, -1) eq "\n");
  432.  
  433.         $return_string;
  434.     }
  435. }
  436.  
  437.  
  438. # Function to execute a program, and return the output (the same as `` with tracing).
  439. # The first argument is non-null if we want to chop off newlines.  If the program
  440. # dies, abort.
  441.  
  442. sub execute_output_or_die {
  443.     local ($pid)        = undef;
  444.     local ($return_string)    = undef;
  445.     local (@return_array)    = ();
  446.  
  447.     if (wantarray) {
  448.         @return_array = &execute_output;    # pass ARGV straight through
  449.  
  450.         if ($? != 0) {
  451.             shift (@_);            # remove do_chop
  452.             local ($status) = &execute_status ($?);
  453.             local ($") = ' ';
  454.             die "$prog: @_: $status\n";
  455.         }
  456.  
  457.         @return_array;
  458.  
  459.     } else {
  460.         $return_string = &execute_output;    # pass ARGV straight through
  461.  
  462.         if ($? != 0) {
  463.             shift (@_);            # remove do_chop
  464.             local ($status) = &execute_status ($?);
  465.             local ($") = ' ';
  466.             die "$prog: @_: $status\n";
  467.         }
  468.  
  469.         $return_string;
  470.     }
  471. }
  472.  
  473.  
  474. # Function to execute a program and not wait for it to finish
  475.  
  476. sub spawn {
  477.     local ($") = ' ';
  478.     return &execute_internal ($no_stdin,
  479.                   $no_stdout,
  480.                   $no_stderr,
  481.                   $no_func,
  482.                   $no_parent_func,
  483.                   $no_child_func,
  484.                   $no_wait,
  485.                   @_);
  486. }
  487.  
  488.  
  489. # Function to execute a program, redirect its standard files, and not
  490. # wait for it to finish.  The first three arguments are the file names
  491. # for stdin, stdout, or stderr.
  492.  
  493. sub spawn_redirect {
  494.     local ($package,$src,$line)    = caller;
  495.     local ($stdin)            = &fix_file (shift (@_), '<', $package);
  496.     local ($stdout)            = &fix_file (shift (@_), '>', $package);
  497.     local ($stderr)            = &fix_file (shift (@_), '>', $package);
  498.     local ($")            = ' ';
  499.  
  500.     return &execute_internal ($stdin,
  501.                   $stdout,
  502.                   $stderr,
  503.                   $no_func,
  504.                   $no_parent_func,
  505.                   $no_child_func,
  506.                   $no_wait,
  507.                   @_);
  508. }
  509.  
  510.  
  511. # Wait for a spawn'ed process to die, and return it's status
  512.  
  513. sub spawn_wait {
  514.     local ($pid)    = (scalar (@_) > 0) ? shift (@_) : -1;
  515.  
  516.     waitpid ($pid, 0);
  517.     return &execute_status ($?);
  518. }
  519.  
  520.  
  521. # Function to enable or disable execute tracing
  522.  
  523. sub execute_trace {
  524.     &trace_enable;            # pass args along to trace_enable
  525. }
  526.  
  527.  
  528. # Function to enable or disable executing the program
  529.  
  530. sub execute_run {
  531.     $exec = (scalar (@_) > 0) ? shift (@_) : 1;
  532. }
  533.  
  534.  
  535. # Function to change directory, and trace if needed.
  536.  
  537. sub change_directory {
  538.     local ($dir) = shift (@_);
  539.  
  540.     return                        if (defined ($cur_dir) && ($dir =~ m!^/!) && $dir eq $cur_dir);
  541.  
  542.     &trace ('cd', $dir)                if ($trace_p);
  543.     chdir ($dir)                    || die "$prog: chdir $dir: $!\n";
  544.     $cur_dir = ($dir =~ m!^/!) ? $dir : undef;
  545. }
  546.  
  547.  
  548. # Make sure require doesn't abort.
  549. 1;
  550.