diff options
| author | Mohammad Sajid Anwar <Mohammad.Anwar@yahoo.com> | 2024-09-20 21:43:29 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2024-09-20 21:43:29 +0100 |
| commit | 2ce90b27e61f68bc7ac622f09aa496686bc65428 (patch) | |
| tree | 96c3c34e9f93a97bede90c417982e062272904a7 | |
| parent | f61718cb98344348e8fdc9ac0c88a9197f716581 (diff) | |
| parent | fc3ed5c2f1361136e32ddc2dc3b9583955e408bb (diff) | |
| download | perlweeklychallenge-club-2ce90b27e61f68bc7ac622f09aa496686bc65428.tar.gz perlweeklychallenge-club-2ce90b27e61f68bc7ac622f09aa496686bc65428.tar.bz2 perlweeklychallenge-club-2ce90b27e61f68bc7ac622f09aa496686bc65428.zip | |
Merge pull request #10879 from PerlBoy1967/branch-for-challenge-287
w287 - Task 1 & 2
| -rwxr-xr-x | challenge-287/perlboy1967/perl/ch1.pl | 98 | ||||
| -rwxr-xr-x | challenge-287/perlboy1967/perl/ch2.pl | 57 |
2 files changed, 155 insertions, 0 deletions
diff --git a/challenge-287/perlboy1967/perl/ch1.pl b/challenge-287/perlboy1967/perl/ch1.pl new file mode 100755 index 0000000000..980c9411e0 --- /dev/null +++ b/challenge-287/perlboy1967/perl/ch1.pl @@ -0,0 +1,98 @@ +#!/bin/perl + +=pod + +L<https://theweeklychallenge.org/blog/perl-weekly-challenge-287> + +Author: Niels 'PerlBoy' van Dijke + +Task 1: Strong Password +Submitted by: Mohammad Sajid Anwar + +You are given a string, $str. + +Write a program to return the minimum number of steps required to make the given string very strong password. +If it is already strong then return 0. + +Criteria: + +- It must have at least 6 characters. +- It must contains at least one lowercase letter, at least one upper case letter and at least one digit. +- It shouldn't contain 3 repeating characters in a row. + +Following can be considered as one step: + +- Insert one character +- Delete one character +- Replace one character with another + +=cut + +use v5.32; +use feature qw(signatures); +no warnings qw(experimental::signatures); +use common::sense; + +use Test2::V0 qw(-no_srand); + +use List::Util qw(max); +use List::MoreUtils qw(all none arrayify indexes); + +sub isStrongPassword :prototype($$\@\@) ($password,$minLength,$arAll,$arNone) { + (length($password) >= $minLength) && + (all { $password =~ /$_/ } @$arAll) && + (none { $password =~ /$_/ } @$arNone) +} + +sub stepsToMakeStrongPassword ($password) { + my $minLength = 6; + my @all = (['a'..'z'],['A'..'Z'],['0'..'9']); + my @allRe = map { sprintf('[%s-%s]',$$_[0],$$_[-1]) } @all; + my @noneRe = (qr/(.)\1\1/); + + return 0 if isStrongPassword($password,$minLength,@allRe,@noneRe); + + my $steps = 0; + do { + # Get usable character class indexes for next iteration + my @availC = indexes { $password !~ /$_/ } @allRe; + @availC = (0 .. $#allRe) unless @availC; + + # Get preferred characters to use first (to comply to 'all') + my @p = arrayify map { $all[$_] } @availC; + + # Get avaiable characters for next iteration + my %f = map { $_ => 0 } @p; + $f{$_}++ for (split //,$password); + my @a = grep { $f{$_} == 0 } sort keys %f; + + # Get random character to be used + my $rChr = $a[rand @a]; + + # Replace last character in 3 identical character sequence? + if ($password !~ s/(.)\1\1/$1$1$rChr/) { + # No, do other checks + if (length($password) >= $minLength) { + # Replace max occuring character + my $m = max(values %f); + my $r = (grep { $f{$_} == $m } keys %f)[0]; + $password =~ s/$r/$a[rand @a]/e; + } else { + # Extend the password with one character + $password .= $rChr; + } + } + + $steps++; + } while not(isStrongPassword($password,$minLength,@allRe,@noneRe)); + + return $steps; +} + +for (['a',5],['aB2',3],['PaasWS0rd',0],['PaaasWS0rd',1],['aaaaa',2]) { + is(stepsToMakeStrongPassword($$_[0]),$$_[1],$$_[0]); +} + +done_testing; + + diff --git a/challenge-287/perlboy1967/perl/ch2.pl b/challenge-287/perlboy1967/perl/ch2.pl new file mode 100755 index 0000000000..78d9b0a2ba --- /dev/null +++ b/challenge-287/perlboy1967/perl/ch2.pl @@ -0,0 +1,57 @@ +#!/bin/perl + +=pod + +L<https://theweeklychallenge.org/blog/perl-weekly-challenge-287> + +Author: Niels 'PerlBoy' van Dijke + +Task 2: Valid Number +Submitted by: Mohammad Sajid Anwar + +You are given a string, $str. + +Write a script to find if it is a valid number. + +Conditions for a valid number: + +- An integer number followed by an optional exponent. +- A decimal number followed by an optional exponent. +- An integer number is defined with an optional sign '-' or '+' followed by digits. + +Decimal Number: + +A decimal number is defined with an optional sign '-' or '+' followed by one of the following definitions: +- Digits followed by a dot '.'. +- Digits followed by a dot '.' followed by digits. +- A dot '.' followed by digits. + +Exponent: + +An exponent is defined with an exponent notation 'e' or 'E' followed by an integer number. + +=cut + +use v5.32; +use feature qw(signatures); +no warnings qw(experimental::signatures); +use common::sense; + +use Test2::V0 qw(-no_srand); + +use boolean; +use Scalar::Util qw(looks_like_number); + +sub validNumber ($str) { + boolean looks_like_number($str); +} + +is(validNumber('1'),true); +is(validNumber('a'),false); +is(validNumber('1.2e4.2'),false); +is(validNumber('-1.'),true); +is(validNumber('+1E-8'),true); +is(validNumber('.44'),true); + + +done_testing; |
