Changeset 43052 for branches/eam_branches/ipp-pstamp-20260421/pstamp/scripts/pstampparse.pl

Timestamp:

Jun 12, 2026, 2:47:49 PM (5 weeks ago)

Author:

eugene

Message:

convert the IPC::Cmd run calls to ps_run to handle inconsistent behavior between IPC:Cmd versions pre- and post-0.40

File:

• branches/eam_branches/ipp-pstamp-20260421/pstamp/scripts/pstampparse.pl (modified) (13 diffs)

branches/eam_branches/ipp-pstamp-20260421/pstamp/scripts/pstampparse.pl

@@ -15 +15 @@
 use File::Temp qw(tempfile);
 use File::Basename qw(basename);
-use Scalar::Util qw(looks_like_number);
 use Carp;
 use POSIX;
@@ -67 +66 @@
 }
 
-use IPC::Cmd 0.36 qw( can_run run );
+use IPC::Cmd 0.36 qw( can_run );
 
 use PS::IPP::Metadata::Config;
@@ -73 +72 @@
 use PS::IPP::Metadata::List qw( parse_md_list );
 
-use PS::IPP::Config qw( :standard );
+use PS::IPP::Config qw( :standard ps_run );
 my $ipprc = PS::IPP::Config->new(); # IPP Configuration
 
@@ -127 +126 @@
 {
     my $command = "echo $request_file_name | $fields -x 0 EXTNAME EXTVER REQ_NAME ACTION EMAIL";
-    my ( $success, $error_msg, $full_buf, $stdout_buf, $stderr_buf ) =
-        run(command => $command, verbose => $verbose);
-    my $error_code = &parse_error_message ($success, $error_msg, $command);
+    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
+        ps_run(command => $command, verbose => $verbose);
 
     # note fields doesn't return zero when it succeeds.
+    # XXX EAM 2026.06.10 : the above note has not been true since 2007!
     $fields_output = join "", @$stdout_buf;
 }
@@ -186 +185 @@
     my $command = "$pstamptool -listreq  -name $req_name -not_req_id $req_id";
     # no verbose so that error message about request not found doesn't appear in parse_error.txt
-    my ( $success, $error_msg, $full_buf, $stdout_buf, $stderr_buf ) =
-        run(command => $command, verbose => 0);
-    my $error_code = &parse_error_message ($success, $error_msg, $command);
-    my $exitStatus = $error_code;
+    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
+        ps_run(command => $command, verbose => 0);
+    my $exitStatus = $error_code >> 8;
     if ($success) {
         # -listreq succeeded there is already a request in the database with this name
@@ -285 +283 @@
     unless ($no_update) {
         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
-            run(command => $command, verbose => $verbose);
+            ps_run(command => $command, verbose => $verbose);
         unless ($success) {
             my_die("$command failed", $PS_EXIT_UNKNOWN_ERROR);
@@ -313 +311 @@
     my $command = "$pstampdump $request_file_name";
     my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
-        run(command => $command, verbose => $verbose);
+        ps_run(command => $command, verbose => $verbose);
     unless ($success) {
         print STDERR @$stderr_buf;
@@ -394 +392 @@
     my $command = "$pstamptool -updatereq -req_id $req_id  -set_label $label";
     my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
-        run(command => $command, verbose => $verbose);
+        ps_run(command => $command, verbose => $verbose);
     unless ($success) {
         my_die("$command failed", $PS_EXIT_UNKNOWN_ERROR);
@@ -822 +820 @@
         my $start_addjob = gettimeofday();
         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
-            run(command => $command, verbose => $verbose);
+            ps_run(command => $command, verbose => $verbose);
         unless ($success) {
             print STDERR @$stderr_buf;
@@ -977 +975 @@
             # mode eq "queue_job"
             my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
-                run(command => $command, verbose => $verbose);
+                ps_run(command => $command, verbose => $verbose);
             unless ($success) {
                 print STDERR @$stderr_buf;
@@ -1030 +1028 @@
         # mode eq "queue_job"
         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
-            run(command => $command, verbose => $verbose);
+            ps_run(command => $command, verbose => $verbose);
         unless ($success) {
             print STDERR @$stderr_buf;
@@ -1139 +1137 @@
 
     if (!$no_update) {
-        my ( $success, $error_msg, $full_buf, $stdout_buf, $stderr_buf ) =
-            run(command => $command, verbose => $verbose);
-        my $error_code = &parse_error_message ($success, $error_msg, $command);
+        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
+            ps_run(command => $command, verbose => $verbose);
         unless ($success) {
-            my $fault = $error_code;
+            my $fault = $error_code >> 8;
             print STDERR "$command failed with fault $fault\n";
             if ($fault < $PSTAMP_FIRST_ERROR_CODE) {
@@ -1425 +1422 @@
     exit $fault;
 }
-
-# if the program exited normally, the exit value is returned
-# if the program exited with a signal (abort, crash, etc), PS_EXIT_PROG_ERROR (4) is returned
-# if the program failed to run, -PS_EXIT_PROG_ERROR (-4) is returned
-sub parse_error_message {
-    my $success = shift;
-    my $error_msg = shift;
-    my $command = shift;
-
-    if ($success) { return 0; }
-
-    print "raw error_msg: $error_msg\n";
-    print "full command: $command\n";
-
-    if (&looks_like_number($error_msg)) { return (($error_msg >> 8) or ($PS_EXIT_PROG_ERROR)); }
-        
-    # which of these match?
-    my ($error_code) = $error_msg =~ m/exited with value (\d+)/;
-    if (defined $error_code) { return $error_code; }
-    
-    ($error_code) = $error_msg =~ m/died with signal (\d+)/;
-#   if (defined $error_code) { return (128 + $error_code); }
-    if (defined $error_code) { return ($PS_EXIT_PROG_ERROR); }
-    
-    # probably failed to execute:
-    return (-1*$PS_EXIT_PROG_ERROR);
-}
-