Procházet zdrojové kódy

Test the value itself, not ( $x // q{} ) ne q{}

Review on #361: where ProhibitDefinedBeforeLength asked for a change,
the value alone is the simpler test, and !$x is the simpler negation.
Every ( $x // q{} ) ne q{} and $x eq q{} that the last commit added is
now $x or !$x.  _safe_domain and _safe_name no longer default their
argument to q{} first, because !$x is false for undef before length
reads it.

So "0" now counts as absent in these places, as an empty string does:
a password, a passphrase, a sudo password, a TOTP code, a secret, a
like query, a tag or alias, the older and newer filters, a page number,
a select option's label, a placeholder, a directory, and a relative
path under a DirIndex root.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
troglodyne-bot před 1 týdnem
rodič
revize
735555d3b7

+ 2 - 2
bin/tcms-useradd

@@ -146,11 +146,11 @@ sub main {
 
     # --password with no value means "ask me", as opposed to leaving the option
     # out entirely, which means "leave the password alone".
-    if ( defined $options{password} && $options{password} eq q{} ) {
+    if ( defined $options{password} && !$options{password} ) {
         my $interactive = -t STDIN;
         $options{password} = _read_password("New password for '$options{user}': ");
 
-        unless ( ( $options{password} // q{} ) ne q{} ) {
+        unless ( $options{password} ) {
             print STDERR "No password provided.\n";
             return 2;
         }

+ 2 - 2
bin/tcmslogin

@@ -116,8 +116,8 @@ sub main {
 
     # Omitted entirely or passed with no value both mean "ask me".
     $options{password} = _read_password("Password for '$options{user}': ")
-      unless ( $options{password} // q{} ) ne q{};
-    unless ( ( $options{password} // q{} ) ne q{} ) {
+      unless $options{password};
+    unless ( $options{password} ) {
         print STDERR "No password provided.\n";
         return 2;
     }

+ 1 - 1
lib/Trog/Auth.pm

@@ -378,7 +378,7 @@ our $argon2_tag     = 32;
 our $argon2_saltlen = 16;
 
 sub check_password ( $user, $pass ) {
-    return 0 unless ( $pass // q{} ) ne q{};
+    return 0 unless $pass;
 
     my $dbh  = _dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT hash, salt FROM user WHERE name = ?", { Slice => {} }, $user );

+ 1 - 1
lib/Trog/Data/SQLite.pm

@@ -242,7 +242,7 @@ sub _where ($query) {
         push( @bind,  $query->{author} );
     }
 
-    if ( ( $query->{like} // q{} ) ne q{} ) {
+    if ( $query->{like} ) {
         my ( $clause, @like_bind ) = _like_clause( $query->{like} );
         push( @where, $clause );
         push( @bind,  @like_bind );

+ 2 - 2
lib/Trog/DataModule.pm

@@ -941,8 +941,8 @@ sub _process ($post) {
     #Filter adding the same acl twice, and anything that isn't a tag at all --
     # an undef here is what every query below compares against, and it warns
     # its way through the lot before matching nothing.
-    @{ $post->{tags} }    = List::Util::uniq( grep { ( $_ // q{} ) ne q{} } @{ $post->{tags} } );
-    @{ $post->{aliases} } = List::Util::uniq( grep { ( $_ // q{} ) ne q{} } @{ $post->{aliases} } );
+    @{ $post->{tags} }    = List::Util::uniq( grep { $_ } @{ $post->{tags} } );
+    @{ $post->{aliases} } = List::Util::uniq( grep { $_ } @{ $post->{aliases} } );
 
     # Handle multimedia content types
     $post->{content_type}       = Trog::Utils::mime_type("www/$post->{href}")       if $post->{href};

+ 4 - 4
lib/Trog/DataSource.pm

@@ -102,7 +102,7 @@ rather than by hoping this one covers it.
 sub filter ( $query, @posts ) {
     $query //= {};
 
-    if ( ( $query->{like} // q{} ) ne q{} ) {
+    if ( $query->{like} ) {
         my $like = $query->{like};
         @posts = grep { searchable_match( $like, $_->{title}, $_->{data} ) } @posts;
     }
@@ -113,11 +113,11 @@ sub filter ( $query, @posts ) {
     # this arrives straight off a query string.
     if ( $query->{older} ) {
         ( my $older = $query->{older} ) =~ s/[^0-9]//g;
-        @posts = grep { ( $_->{created} // 0 ) < $older } @posts if $older ne q{};
+        @posts = grep { ( $_->{created} // 0 ) < $older } @posts if $older;
     }
     if ( $query->{newer} ) {
         ( my $newer = $query->{newer} ) =~ s/[^0-9]//g;
-        @posts = grep { ( $_->{created} // 0 ) > $newer } @posts if $newer ne q{};
+        @posts = grep { ( $_->{created} // 0 ) > $newer } @posts if $newer;
     }
 
     return @posts;
@@ -138,7 +138,7 @@ or a nested structure is passed over rather than matched against its address.
 =cut
 
 sub searchable_match ( $like, @values ) {
-    return 0 unless ( $like // q{} ) ne q{};
+    return 0 unless $like;
 
     foreach my $value (@values) {
         next     if !defined $value || ref $value;

+ 3 - 3
lib/Trog/DataSource/DirIndex.pm

@@ -146,7 +146,7 @@ sub posts ( $series, $query ) {
 # and the path relative to the tCMS root, since the first is what we read and
 # the second is what we log and watch.
 sub _resolve ($directory) {
-    return undef unless ( $directory // q{} ) ne q{};
+    return undef unless $directory;
 
     # Before abs_path, which would happily resolve one for us.
     if ( $directory =~ m{(?:^|/)\.\.(?:/|$)} ) {
@@ -189,7 +189,7 @@ sub _resolve ($directory) {
     my $relative = $absolute;
     $relative =~ s{^\Q$base\E/?}{};
 
-    return { absolute => $absolute, relative => $relative ne q{} ? "$root/$relative" : $root };
+    return { absolute => $absolute, relative => $relative ? "$root/$relative" : $root };
 }
 
 # Path containment, done on the resolved paths rather than on the strings the
@@ -303,7 +303,7 @@ under it.
 sub filter ( $query, @posts ) {
     $query //= {};
 
-    if ( ( $query->{like} // q{} ) ne q{} ) {
+    if ( $query->{like} ) {
         my $like = $query->{like};
         @posts = grep { Trog::DataSource::searchable_match( $like, $_->{name}, $_->{path}, $_->{extension} ) } @posts;
     }

+ 6 - 7
lib/Trog/DataSource/ProvisionedVirt.pm

@@ -283,8 +283,7 @@ sub _config {
 
 # A guest name reaches the filesystem here, so it is a hostname or it is nothing.
 sub _safe_domain ($domain) {
-    $domain //= q{};
-    return undef if $domain eq q{} || length $domain >= 254;
+    return undef if !$domain || length $domain >= 254;
     return undef if $domain =~ m/(?:^|\.)\.\.?(?:\.|$)/;
 
     my ($safe) = $domain =~ m/^([A-Za-z0-9][A-Za-z0-9._-]*)$/;
@@ -474,9 +473,9 @@ sub _credentials (%args) {
     # typed ones are worth filing away, and only they can be: a value fetched
     # from the vault is already in it.
     my %typed;
-    $typed{sudo} = $args{sudo} if ( $args{sudo} // q{} ) ne q{};
+    $typed{sudo} = $args{sudo} if $args{sudo};
 
-    if ( ( $args{totp} // q{} ) ne q{} ) {
+    if ( $args{totp} ) {
         return ( undef, 'a code identifies somebody, and nobody is logged in' ) unless $user;
 
         # Asked before the code is spent, and the reason is that a code is
@@ -493,11 +492,11 @@ sub _credentials (%args) {
         return ( undef, $why ) unless $ok;
 
         my $stored = Trog::Vault::get( $user, $secret_name );
-        return ( undef, "the stored provisioning passphrase for $user could not be read" ) unless ( $stored // q{} ) ne q{};
+        return ( undef, "the stored provisioning passphrase for $user could not be read" ) unless $stored;
         $credentials{keepass} = $stored;
     }
     else {
-        return ( undef, 'a passphrase is required, as the provisioner asks for one' ) unless ( $args{passphrase} // q{} ) ne q{};
+        return ( undef, 'a passphrase is required, as the provisioner asks for one' ) unless $args{passphrase};
         $credentials{keepass} = $args{passphrase};
         $typed{keepass}       = $args{passphrase};
     }
@@ -506,7 +505,7 @@ sub _credentials (%args) {
     # reason to -- and no sudo password at all is the ordinary answer, for a
     # hypervisor whose login has passwordless sudo.
     my $sudo = $typed{sudo} // ( $user ? Trog::Vault::get( $user, $sudo_name ) : undef );
-    $credentials{sudo} = $sudo if ( $sudo // q{} ) ne q{};
+    $credentials{sudo} = $sudo if $sudo;
 
     _remember( $user, \%typed ) if $args{remember} && $user && %typed;
 

+ 1 - 1
lib/Trog/DataSource/Virt.pm

@@ -210,7 +210,7 @@ Trog::DataSource::filter.
 sub filter ( $query, @posts ) {
     $query //= {};
 
-    if ( ( $query->{like} // q{} ) ne q{} ) {
+    if ( $query->{like} ) {
         my $like = $query->{like};
         @posts = grep {
             Trog::DataSource::searchable_match(

+ 3 - 3
lib/Trog/Routes/HTML.pm

@@ -883,7 +883,7 @@ sub _config_sections {
                     map {
                         {
                             value    => $_,
-                            label    => $_ ne q{}    ? $_ : 'default',
+                            label    => $_           ? $_ : 'default',
                             selected => $_ eq $value ? 1  : 0,
                         }
                     } @{ $choices->() }
@@ -1980,7 +1980,7 @@ sub _paginate_offset ( $query, $limit, @posts ) {
     # shows the last page rather than an empty one, which is what a stale
     # bookmark deserves.
     ( my $wanted = $query->{page} // '' ) =~ s/[^0-9]//g;
-    my $page = $wanted ne q{} ? int($wanted) : 1;
+    my $page = $wanted ? int($wanted) : 1;
     $page = 1            if $page < 1;
     $page = $pages_total if $page > $pages_total;
 
@@ -3250,7 +3250,7 @@ sub _wizard_sidecar ( $name, $fields, $includes, $body_form, $datasource = '', $
         my $property = { %{ $wizard_field_types{ $field->{type} } } };
         $property->{'x-tcms-input'}       = $field->{type};
         $property->{'x-tcms-label'}       = $field->{label};
-        $property->{'x-tcms-placeholder'} = $field->{placeholder} if ( $field->{placeholder} // q{} ) ne q{};
+        $property->{'x-tcms-placeholder'} = $field->{placeholder} if $field->{placeholder};
 
         # Only written when it is true: a field is public unless it says so,
         # and a sidecar full of x-tcms-private:false reads like the opposite.

+ 3 - 4
lib/Trog/Vault.pm

@@ -116,7 +116,7 @@ our $looked_further = 0;
 
 sub _from_env {
     my $raw = delete $ENV{TPSGI_VAULT_KEY};
-    return undef unless ( $raw // q{} ) ne q{};
+    return undef unless $raw;
     return _decode( $raw, 'TPSGI_VAULT_KEY' );
 }
 
@@ -204,7 +204,7 @@ Remember one thing for one user, replacing whatever was there under that name.
 sub set ( $user, $name, $secret ) {
     return ( 0, 'this installation has no vault key, so there is nowhere to keep it' ) unless has_key();
     return ( 0, 'a secret needs a name' )                                              unless _safe_name($name);
-    return ( 0, 'nothing to store' )                                                   unless ( $secret // q{} ) ne q{};
+    return ( 0, 'nothing to store' )                                                   unless $secret;
 
     my $salt = Crypt::PRNG::random_bytes(32);
     my ( $key, $iv ) = _derive($salt);
@@ -356,8 +356,7 @@ sub forget ( $user, $name ) {
 # A name is a label in a form and a key in a table, and it is half of what binds
 # a row to its owner, so it is a short plain thing or it is nothing.
 sub _safe_name ($name) {
-    $name //= q{};
-    return 0 if $name eq q{} || length $name > 64;
+    return 0 if !$name || length $name > 64;
     return $name =~ m/^[A-Za-z0-9][A-Za-z0-9._-]*$/ ? 1 : 0;
 }