Explorar el Código

Print the scripts' messages to STDERR, not warn

Review on #366: in bin/, print to STDERR is the right call.  What a
script tells whoever ran it is a message, not a diagnostic of the line
that said it, and warn is a diagnostic.  Each of those prints says so
with a no critic, as ProhibitPrintSTDERR asks, and is braced, as
RequireBracedFileHandleWithPrint asks.  Everywhere outside bin/, the
policy stands, and lib/ has no print to STDERR.

The runs of prints stay one print each.  The comments say again that
these scripts print and exit rather than die, so that they exit 2.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
troglodyne-bot hace 1 semana
padre
commit
035f357753
Se han modificado 4 ficheros con 18 adiciones y 18 borrados
  1. 7 7
      bin/migrate.pl
  2. 6 6
      bin/tcms-useradd
  3. 2 2
      bin/tcms-vault-key
  4. 3 3
      bin/tcmslogin

+ 7 - 7
bin/migrate.pl

@@ -63,9 +63,9 @@ STDERR->autoflush(1);
 
 my $usage = "Usage: bin/migrate.pl [--dry-run] [--batch N] [--quiet]\n";
 
-# Warned and exited rather than died, so that a usage error exits 2.
+# Printed and exited rather than died, so that a usage error exits 2.
 sub usage_error (@complaint) {
-    warn @complaint, $usage;
+    print {*STDERR} @complaint, $usage;    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
     exit 2;
 }
 
@@ -94,7 +94,7 @@ my $to     = Trog::Data::SQLite->new($config);
 my $started = [ Time::HiRes::gettimeofday() ];
 my @posts   = $from->get( raw => 1, limit => 0 );
 if ( !@posts ) {
-    warn "No posts found in data/files -- is this a tCMS root, and is it on the FlatFile model?\n";
+    print {*STDERR} "No posts found in data/files -- is this a tCMS root, and is it on the FlatFile model?\n";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
     exit 2;
 }
 
@@ -131,7 +131,7 @@ sub flush_batch () {
         # the batch down with it.  Go back over them one at a time: a migration
         # wants everything that can land to land, and a list naming exactly what
         # could not -- not five hundred posts rejected on account of one.
-        warn "A batch of " . scalar(@batch) . " failed ($error); retrying it one post at a time.\n";
+        print {*STDERR} "A batch of " . scalar(@batch) . " failed ($error); retrying it one post at a time.\n";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
 
         foreach my $post (@batch) {
             local $@;
@@ -143,7 +143,7 @@ sub flush_batch () {
                 my $why = $@;
                 $why =~ s/\n.*//s;
                 $failed++;
-                warn "  could not write $post->{id} version " . ( $post->{version} // 0 ) . ": $why\n";
+                print {*STDERR} "  could not write $post->{id} version " . ( $post->{version} // 0 ) . ": $why\n";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
             };
         }
     };
@@ -154,7 +154,7 @@ sub flush_batch () {
 
 foreach my $post (@posts) {
     if ( !$post->{id} ) {
-        warn "Skipping a post with no id, which is not something this can carry over\n";
+        print {*STDERR} "Skipping a post with no id, which is not something this can carry over\n";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
         $failed++;
         next;
     }
@@ -187,7 +187,7 @@ say_unless_quiet( sprintf( "Carried over %d post version(s), skipped %d already
 say_unless_quiet( sprintf( "data/files holds %d post version(s); data/posts.sqlite now holds %d.", $expected, $have ) );
 
 if ( $failed || $have < $expected ) {
-    warn sprintf( "%d post version(s) did not make it across.  Fix what the errors above name and re-run; what landed will be skipped.\n", $failed || ( $expected - $have ) );
+    print {*STDERR} sprintf( "%d post version(s) did not make it across.  Fix what the errors above name and re-run; what landed will be skipped.\n", $failed || ( $expected - $have ) );    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
     exit 1;
 }
 

+ 6 - 6
bin/tcms-useradd

@@ -129,7 +129,7 @@ sub main {
     pod2usage( -exitval => 0, -verbose => 1 ) if $options{help};
 
     unless ( $options{user} ) {
-        warn "--user is required.\n";
+        print {*STDERR} "--user is required.\n";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
         return 2;
     }
 
@@ -139,7 +139,7 @@ sub main {
         $options{password} = read_password("New password for '$options{user}': ");
 
         unless ( $options{password} ) {
-            warn "No password provided.\n";
+            print {*STDERR} "No password provided.\n";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
             return 2;
         }
 
@@ -148,7 +148,7 @@ sub main {
         # and there is nothing to confirm against.
         my $again = read_password("Confirm: ");
         if ( defined $again && $options{password} ne $again ) {
-            warn "Passwords did not match.\n";
+            print {*STDERR} "Passwords did not match.\n";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
             return 2;
         }
     }
@@ -173,7 +173,7 @@ sub main {
 
     if ($is_new) {
         unless ( $options{password} && $options{display_name} && $options{contact_email} ) {
-            warn "User '$options{user}' does not exist yet.\nCreating one needs --password, --display_name and --contact_email.\n";
+            print {*STDERR} "User '$options{user}' does not exist yet.\nCreating one needs --password, --display_name and --contact_email.\n";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
             return 2;
         }
     }
@@ -196,13 +196,13 @@ sub main {
 
     local $@;
     eval { Trog::Auth::useradd( $options{user}, $merged{display_name}, $options{password}, $options{acl}, $merged{contact_email} ); 1 } or do {
-        warn "Could not add user '$options{user}': $@";
+        print {*STDERR} "Could not add user '$options{user}': $@";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
         return 1;
     };
 
     eval { $data->add( \%merged ); 1 } or do {
         my @errors = ref $@ eq 'ARRAY' ? @{$@} : ($@);
-        warn "Saved the credentials for '$options{user}', but their profile post was rejected:\n" . join( "\n", @errors ) . "\n";
+        print {*STDERR} "Saved the credentials for '$options{user}', but their profile post was rejected:\n" . join( "\n", @errors ) . "\n";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
         return 1;
     };
 

+ 2 - 2
bin/tcms-vault-key

@@ -82,10 +82,10 @@ USAGE
     exit( $help ? 0 : 2 );
 }
 
-# Warned and exited rather than died, so that it exits 2: refusing to clobber a
+# Printed and exited rather than died, so that it exits 2: refusing to clobber a
 # key is not a crash.
 if ( -e $Trog::Vault::key_file ) {    # Refusing to overwrite the one thing that cannot be regenerated
-    warn "There is already a key at $Trog::Vault::key_file.  Move it out of the way if you really mean to replace it, and read what that costs first: perldoc bin/tcms-vault-key\n";
+    print {*STDERR} "There is already a key at $Trog::Vault::key_file.  Move it out of the way if you really mean to replace it, and read what that costs first: perldoc bin/tcms-vault-key\n";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
     exit 2;
 }
 

+ 3 - 3
bin/tcmslogin

@@ -96,7 +96,7 @@ sub main {
     pod2usage( -exitval => 0, -verbose => 1 ) if $options{help};
 
     unless ( $options{user} ) {
-        warn "--user is required.\n";
+        print {*STDERR} "--user is required.\n";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
         return 2;
     }
 
@@ -106,7 +106,7 @@ sub main {
     $options{password} = read_password("Password for '$options{user}': ")
       unless $options{password};
     unless ( $options{password} ) {
-        warn "No password provided.\n";
+        print {*STDERR} "No password provided.\n";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
         return 2;
     }
 
@@ -114,7 +114,7 @@ sub main {
     # the same '' for an unknown user, a bad password and a bad TOTP code.
     my $session = Trog::Auth::mksession( $options{user}, $options{password}, $options{token}, 'tcmslogin' );
     unless ($session) {
-        warn <<"SAID";
+        print {*STDERR} <<"SAID";    ## no critic (ProhibitPrintSTDERR) -- for whoever ran this
 Login failed for '$options{user}'.
 Check the password, and pass --token if this user has 2FA enabled.
 Use bin/tcms-useradd --user $options{user} --password ... to reset it.