Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

Nice, so far the only other solution that beats the original :-)

Rate BillKSmith2 choroba2 LanX2 choroba1 LanX1 haukex1 + BillKSmith1 orig tybalt89 haukex2 BillKSmith2 38227/s -- -55% -60% -72% -72% -83% + -85% -85% -87% -88% choroba2 85658/s 124% -- -10% -38% -38% -62% + -66% -67% -70% -74% LanX2 95639/s 150% 12% -- -31% -31% -57% + -62% -63% -67% -71% choroba1 138099/s 261% 61% 44% -- -1% -38% + -44% -47% -52% -58% LanX1 138866/s 263% 62% 45% 1% -- -38% + -44% -47% -52% -58% haukex1 223763/s 485% 161% 134% 62% 61% -- + -10% -14% -22% -33% BillKSmith1 248507/s 550% 190% 160% 80% 79% 11% + -- -5% -13% -25% orig 260650/s 582% 204% 173% 89% 88% 16% + 5% -- -9% -21% tybalt89 287084/s 651% 235% 200% 108% 107% 28% + 16% 10% -- -13% haukex2 331543/s 767% 287% 247% 140% 139% 48% + 33% 27% 15% --
#!/usr/bin/env perl use warnings; use strict; use Benchmark qw/cmpthese/; # x_stream3m, https://www.perlmonks.org/?node_id=11118334 sub orig { use feature 'switch'; no if $] >= 5.018, warnings => "experimental::smartmatch"; my $password = shift; my $lengthOfPassword = length $password; given ($lengthOfPassword) { when ($_ >= 8 && $_ <= 11) { if ($password =~ /[a-z]/ && $password =~ /[A-Z]/ && $password =~ /[0-9]/ && ($password =~ /[\x21-\x2F]/ || $password =~ /[\x3A-\x40]/ || $password =~ /[\x5B-\x60]/ || $password =~ /[\x7B-\x7E]/)) { return 1; } else { return 0; } } when ($_ >= 12 && $_ <= 15) { if ($password =~ /[a-z]/ && $password =~ /[A-Z]/ && $password =~ /[0-9]/) { return 1; } else { return 0; } } when ($_ >= 16 && $_ <= 19) { if ($password =~ /[a-z]/ && $password =~ /[A-Z]/) { return 1; } else { return 0; } } when ($_ >= 20) { return 1; } default { return 0; } } } # haukex, https://www.perlmonks.org/?node_id=11118347 sub regex1 { $_[0] =~ m{ \A (?: .{20,} | (?=.*[a-z]) (?=.*[A-Z]) .{16,19} | (?=.*[a-z]) (?=.*[A-Z]) (?=.*[0-9]) .{12,15} | (?=.*[a-z]) (?=.*[A-Z]) (?=.*[0-9]) (?=.*[\x21-\x2F\x3A-\x40\x5B-\x60\x7B-\x7E]) .{8,11} ) \z }msx } sub regex2 { $_[0] =~ m{ \A (?: .{20,} | (?=.*[a-z]) (?=.*[A-Z]) (?: .{16,19} | (?=.*[0-9]) (?: .{12,15} | (?=.*[\x21-\x2F\x3A-\x40\x5B-\x60\x7B-\x7E]) .{8,11} ) ) ) \z }msx } # choroba, https://www.perlmonks.org/?node_id=11118354 my @RE1 = (qr/[[:lower:]]/, qr/[[:upper:]]/, qr/[0-9]/, qr/[^[:alnum:] +]/); sub check1 { local ($_) = @_; my $length = length; return if $length < 8; return if $length < 12 && (! /$RE1[0]/ || ! /$RE1[1]/ || ! /$RE1[2 +]/ || ! /$RE1[3]/); return if $length < 16 && (! /$RE1[0]/ || ! /$RE1[1]/ || ! /$RE1[2 +]/); return if $length < 20 && (! /$RE1[0]/ || ! /$RE1[1]/); return 1 } use List::Util qw{ any }; my @RE2 = (qr/[[:lower:]]/, qr/[[:upper:]]/, qr/[0-9]/, qr/[^[:alnum:] +]/); sub check2 { my ($password) = @_; my $length = length $password; return if $length < 8; return if $length < 12 && any { $password !~ $RE2[$_] } 0 .. 3; return if $length < 16 && any { $password !~ $RE2[$_] } 0 .. 2; return if $length < 20 && any { $password !~ $RE2[$_] } 0 .. 1; return 1 } # LanX, https://www.perlmonks.org/?node_id=11118358 use List::Util qw/min/; { # for lexicals my $short = sub { "is too short" }; my $lowercase = sub { /[a-z]/ ? "" : "has no lowercase character" +}; my $uppercase = sub { /[A-Z]/ ? "" : "has no uppercase character" +}; my $number = sub { /[0-9]/ ? "" : "has no number" }; my $special = sub { if (/[\x21-\x2F]/ || /[\x3A-\x40]/ || /[\x5B-\x60]/ || /[\x7B-\x7E]/ ) { return ""; } else { return "has no special characters"; } }; my $pass = sub {""}; my @rules_for_class = ( [ $short ], [ $short ], [ $lowercase, $uppercase, $number ,$special ], [ $lowercase, $uppercase, $number ], [ $lowercase, $uppercase ], [ $pass ] ); sub pw_not_ok1 { my $pw = shift; my $len = length $pw; my $idx = min(int($len/4),5); for my $rule ( @{ $rules_for_class[$idx] } ) { $_ = $pw; if ( my $err = $rule->() ) { return $err; } } return; } # LanX, https://www.perlmonks.org/?node_id=11118360 my %rules_by_max_length = ( 7 => [ $short ], 11 => [ $lowercase, $uppercase, $number ,$special ], 15 => [ $lowercase, $uppercase, $number ], 19 => [ $lowercase, $uppercase ], 50 => [ $pass ] ); my @boundaries = sort { $a <=> $b } keys %rules_by_max_length; sub pw_not_ok2 { my $pw = shift; my $len = length $pw; return "too long" if $len >= 50; for my $boundary ( @boundaries ) { next if $len > $boundary; my $rules = $rules_by_max_length{$boundary}; for my $rule ( @$rules ) { $_ = $pw; if ( my $err = $rule->() ) { return $err; } } } return; } } # BillKSmith, https://www.perlmonks.org/?node_id=11118369 sub is_pw_valid { local $_ = $_[0]; return !(/[a-z]/ && /[A-Z]/) ? length >= 20 : !/\d/ ? length >= 16 : !/[\x21-\x2F\x3A-\x40\x5B-\x60\x7B-\x7E]/ ? length >= 12 : length >= 8 ; } sub is_pw_valid2 { my $password = $_[0]; my $MixedCase = qr/(:? [a-z].*[A-Z]) | (:? [A-Z].*[a-z] )/x; my $Digit = qr/\d/; my $special = qr/[\x21-\x2F\x3A-\x40\x5B-\x60\x7B-\x7E]/; my $min_length; if ($password !~ $MixedCase) {$min_length = 20} elsif ($password !~ $Digit) {$min_length = 16} elsif ($password !~ $special) {$min_length = 12} else {$min_length = 8} + my $is_OK = ( length($password) >= $min_length ); return $is_OK; } # tybalt89, https://www.perlmonks.org/?node_id=11118395 sub validate { local $_ = shift; length >= 20 ? 1 : !/[a-z]/ || !/[A-Z]/ ? 0 : length >= 16 ? 1 : !/\d/ ? 0 : length >= 12 ? 1 : !/[^_\w]/ ? 0 : length >= 8 ? 1 : 0; } cmpthese(-2, { orig => sub { orig('aaaaA0-') and die; orig('aaaaaA0-') or die; orig('aaaaaaaaa0-') and die; orig('aaaaaaaaaaA0') or die; orig('aaaaaaaaaaaaaaA') and die; orig('aaaaaaaaaaaaaaaA') or die; orig('aaaaaaaaaaaaaaaaaaa') and die; orig('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa') or die; }, haukex1 => sub { regex1('aaaaA0-') and die; regex1('aaaaaA0-') or die; regex1('aaaaaaaaa0-') and die; regex1('aaaaaaaaaaA0') or die; regex1('aaaaaaaaaaaaaaA') and die; regex1('aaaaaaaaaaaaaaaA') or die; regex1('aaaaaaaaaaaaaaaaaaa') and die; regex1('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa') or die; }, haukex2 => sub { regex2('aaaaA0-') and die; regex2('aaaaaA0-') or die; regex2('aaaaaaaaa0-') and die; regex2('aaaaaaaaaaA0') or die; regex2('aaaaaaaaaaaaaaA') and die; regex2('aaaaaaaaaaaaaaaA') or die; regex2('aaaaaaaaaaaaaaaaaaa') and die; regex2('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa') or die; }, choroba1 => sub { check1('aaaaA0-') and die; check1('aaaaaA0-') or die; check1('aaaaaaaaa0-') and die; check1('aaaaaaaaaaA0') or die; check1('aaaaaaaaaaaaaaA') and die; check1('aaaaaaaaaaaaaaaA') or die; check1('aaaaaaaaaaaaaaaaaaa') and die; check1('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa') or die; }, choroba2 => sub { check2('aaaaA0-') and die; check2('aaaaaA0-') or die; check2('aaaaaaaaa0-') and die; check2('aaaaaaaaaaA0') or die; check2('aaaaaaaaaaaaaaA') and die; check2('aaaaaaaaaaaaaaaA') or die; check2('aaaaaaaaaaaaaaaaaaa') and die; check2('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa') or die; }, LanX1 => sub { pw_not_ok1('aaaaA0-') or die; pw_not_ok1('aaaaaA0-') and die; pw_not_ok1('aaaaaaaaa0-') or die; pw_not_ok1('aaaaaaaaaaA0') and die; pw_not_ok1('aaaaaaaaaaaaaaA') or die; pw_not_ok1('aaaaaaaaaaaaaaaA') and die; pw_not_ok1('aaaaaaaaaaaaaaaaaaa') or die; pw_not_ok1('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa') and die; }, LanX2 => sub { pw_not_ok2('aaaaA0-') or die; pw_not_ok2('aaaaaA0-') and die; pw_not_ok2('aaaaaaaaa0-') or die; pw_not_ok2('aaaaaaaaaaA0') and die; pw_not_ok2('aaaaaaaaaaaaaaA') or die; pw_not_ok2('aaaaaaaaaaaaaaaA') and die; pw_not_ok2('aaaaaaaaaaaaaaaaaaa') or die; pw_not_ok2('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa') and die; }, BillKSmith1 => sub { is_pw_valid('aaaaA0-') and die; is_pw_valid('aaaaaA0-') or die; is_pw_valid('aaaaaaaaa0-') and die; is_pw_valid('aaaaaaaaaaA0') or die; is_pw_valid('aaaaaaaaaaaaaaA') and die; is_pw_valid('aaaaaaaaaaaaaaaA') or die; is_pw_valid('aaaaaaaaaaaaaaaaaaa') and die; is_pw_valid('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa') or die; }, BillKSmith2 => sub { is_pw_valid2('aaaaA0-') and die; is_pw_valid2('aaaaaA0-') or die; is_pw_valid2('aaaaaaaaa0-') and die; is_pw_valid2('aaaaaaaaaaA0') or die; is_pw_valid2('aaaaaaaaaaaaaaA') and die; is_pw_valid2('aaaaaaaaaaaaaaaA') or die; is_pw_valid2('aaaaaaaaaaaaaaaaaaa') and die; is_pw_valid2('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa') or die; }, tybalt89 => sub { validate('aaaaA0-') and die; validate('aaaaaA0-') or die; validate('aaaaaaaaa0-') and die; validate('aaaaaaaaaaA0') or die; validate('aaaaaaaaaaaaaaA') and die; validate('aaaaaaaaaaaaaaaA') or die; validate('aaaaaaaaaaaaaaaaaaa') and die; validate('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa') or die; }, });

In reply to Re^2: Efficient way to verify scalar contents by haukex
in thread Efficient way to verify scalar contents by x_stream3m

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



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (7)
As of 2024-03-28 11:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found