Merge pull request #6803 from fluca1978/PWC184

Pwc184

12 files changed, 165 insertions, 0 deletions

diff --git a/challenge-184/luca-ferrari/blog-1.txt b/challenge-184/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..0a9344f951
--- /dev/null
+++ b/challenge-184/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/09/26/PerlWeeklyChallenge184.html#task1
diff --git a/challenge-184/luca-ferrari/blog-2.txt b/challenge-184/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..8c2e018702
--- /dev/null
+++ b/challenge-184/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/09/26/PerlWeeklyChallenge184.html#task2
diff --git a/challenge-184/luca-ferrari/blog-3.txt b/challenge-184/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..a411748849
--- /dev/null
+++ b/challenge-184/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/09/26/PerlWeeklyChallenge184.html#task1plperl
diff --git a/challenge-184/luca-ferrari/blog-4.txt b/challenge-184/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..b347fc3610
--- /dev/null
+++ b/challenge-184/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/09/26/PerlWeeklyChallenge184.html#task2plperl
diff --git a/challenge-184/luca-ferrari/blog-5.txt b/challenge-184/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..46969f673b
--- /dev/null
+++ b/challenge-184/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/09/26/PerlWeeklyChallenge184.html#task1plpgsql
diff --git a/challenge-184/luca-ferrari/blog-6.txt b/challenge-184/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..7852813c50
--- /dev/null
+++ b/challenge-184/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/09/26/PerlWeeklyChallenge184.html#task2plpgsql
diff --git a/challenge-184/luca-ferrari/postgresql/ch-1.plperl b/challenge-184/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..a47a35e5b9
--- /dev/null
+++ b/challenge-184/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,22 @@
+-- Perl Weekly Challenge 184
+-- Task 1
+
+CREATE SCHEMA IF NOT EXISTS pwc184;
+
+CREATE OR REPLACE FUNCTION
+pwc184.task1_plperl( text[] )
+RETURNS SETOF text
+AS $CODE$
+
+my $counter = 0;
+for my $current_string ( @{$_[0]} ) {
+    next if $current_string !~ / ^ [a-z]{2} \d{4} $ /ix;
+    $counter = sprintf "%02d", $counter;
+    $current_string =~ s/ ^ [a-z]{2} /$counter/xi;
+    $counter++;
+    return_next( $current_string );
+}
+
+return undef();
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-184/luca-ferrari/postgresql/ch-1.sql b/challenge-184/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..5252ac33cf
--- /dev/null
+++ b/challenge-184/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,32 @@
+-- Perl Weekly Challenge 184
+-- Task 1
+
+CREATE SCHEMA IF NOT EXISTS pwc184;
+
+
+CREATE OR REPLACE FUNCTION
+pwc184.task1_plpgsql( strings text[] )
+RETURNS SETOF text
+AS $CODE$
+DECLARE
+        current_string text;
+        c int := 0;
+        pref text;
+BEGIN
+     FOREACH current_string IN ARRAY strings LOOP
+       IF c < 10 THEN
+          pref := '0' || c;
+       ELSE
+         pref := c::text;
+      END IF;
+       RETURN NEXT regexp_replace( current_string,
+                                   '^[a-z]{2}',
+                                   pref );
+       c := c + 1;
+     END LOOP;
+     RETURN;
+END
+
+
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-184/luca-ferrari/postgresql/ch-2.plperl b/challenge-184/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..3273dda67d
--- /dev/null
+++ b/challenge-184/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,29 @@
+-- Perl Weekly Challenge 184
+-- Task 2
+
+CREATE SCHEMA IF NOT EXISTS pwc184;
+
+CREATE OR REPLACE FUNCTION
+pwc184.task2_plperl( text[] )
+RETURNS TABLE( n text, l text )
+AS $CODE$
+
+
+my @numbers;
+my @letters;
+
+for my $current_string ( @{ $_[0] } ) {
+    my @parts = split //, $current_string;
+    
+    for ( @parts ) {
+        push @numbers, $_ if ( $_ =~ /\d/ );
+        push @letters, $_ if ( $_ =~ /[a-z]/i );
+    }
+}
+
+return_next( { n => join( ',', @numbers ),
+          l => join(',', @letters ) } );
+return undef;          
+
+$CODE$
+LANGUAGE plperl;
diff --git a/challenge-184/luca-ferrari/postgresql/ch-2.sql b/challenge-184/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..c1fa0cc3ee
--- /dev/null
+++ b/challenge-184/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,41 @@
+-- Perl Weekly Challenge 184
+-- Task 2
+
+CREATE SCHEMA IF NOT EXISTS pwc184;
+
+CREATE OR REPLACE FUNCTION
+pwc184.task2_plpgsql( strings text[])
+RETURNS TABLE (n text, l text)
+AS $CODE$
+DECLARE
+        current_string text;
+        current_thing text;
+BEGIN
+        n := null;
+        l := null;
+        FOREACH current_string IN ARRAY strings LOOP
+                FOREACH current_thing IN ARRAY regexp_split_to_array( current_string, '' ) LOOP
+                        -- since '\w' gets also numbers
+                        -- the test is performed only if it is not
+                        -- a number
+                        IF current_thing ~ '\d' THEN
+                           IF n IS NULL THEN
+                              n := current_thing::text;
+                           ELSE
+                             n := n || ',' || current_thing;
+                           END IF;
+                        ELSEIF current_thing ~ '\w' THEN
+                           IF l IS NULL THEN
+                              l := current_thing::text;
+                           ELSE
+                             l := l || ',' || current_thing;
+                           END IF;
+                        END IF;
+                END LOOP;
+        END LOOP;
+
+        RETURN NEXT;
+        RETURN;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-184/luca-ferrari/raku/ch-1.p6 b/challenge-184/luca-ferrari/raku/ch-1.p6
new file mode 100755
index 0000000000..5d533f753b
--- /dev/null
+++ b/challenge-184/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,13 @@
+#!raku
+
+# Perl Weekly Challenge 184
+
+sub MAIN( *@strings where { @strings.grep( $_ ~~ / ^ <[a..z]> ** 2 \d ** 4 $/ ).elems == @strings.elems } ) {
+    my $counter = 0;
+    my @ordered-strings = @strings.map: {
+        my $s = $_;
+        $s ~~ s/ ^ ( <[a..z]> ** 2 ) /{ "%02d".sprintf( $counter++ ) }/;
+        $s; };
+    @ordered-strings.join( "\n" ).say;
+
+}
diff --git a/challenge-184/luca-ferrari/raku/ch-2.p6 b/challenge-184/luca-ferrari/raku/ch-2.p6
new file mode 100755
index 0000000000..2008b2b6bb
--- /dev/null
+++ b/challenge-184/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,22 @@
+#!raku
+
+# Perl Weekly Challenge 184
+
+sub MAIN( *@strings ) {
+    my @numbers;
+    my @letters;
+
+    for @strings -> $current-string {
+        my ( @n, @l );
+        for $current-string.comb {
+            @n.push: $_ if ( $_ ~~ / \d / );
+            @l.push: $_ if ( $_ ~~ / <[a..z]> / );
+        }
+
+    @numbers.push: [ @n ] if ( @n );
+    @letters.push: [ @l ] if ( @l );
+    }
+
+    @numbers.join( ", " ).say;
+    @letters.join( ", " ).say;
+}