view release on metacpan or  search on metacpan

t/76-check_all_languages2.t  view on Meta::CPAN

      my $l = $all_languages->{$lang};

      next  unless ( defined $l );
      next  if ( $l->{wide} && ! $wide_flag );

      ++$cntr;
      print CONFIG "[ ZZ Extra ${cntr} ]\n";
      print CONFIG "    Language = \${$lang.Language}\n";
      print CONFIG "    Wide = \${$lang.Wide}\n";
      print CONFIG "    WeekDays = \${$lang.WeekDays}\n\n";

      foreach ( 0..6 ) {
         my $wd = $l->{DoW}->[$_];
         print CONFIG "    $wd = \${$lang.$wd}      # ENCRYPT\n";
      }
      print CONFIG "\n";

      foreach ( 1..12 ) {
         my $dt = sprintf ("%04d-%02d-%02d", 2018, $_, $_ + 1);
         print CONFIG "    ${dt} = \${$lang.$dt}      # ENCRYPT\n";
      }
      print CONFIG "\n";
      foreach ( 1..12 ) {
         my $dt = sprintf ("%04d-%02d-%02d", 2019, $_, $_ + 14);
         print CONFIG "    ${dt} = \${$lang.$dt}      # ENCRYPT\n";
      }
      print CONFIG "\n";
      foreach ( 1..12 ) {
         my $dt = sprintf ("%04d-%02d-%02d", 1998, $_, $_ + 2);
         print CONFIG "    ${dt} = \${$lang.$dt}      # ENCRYPT\n";
      }
      print CONFIG "\n";
      foreach ( 1..12 ) {
         my $dt = sprintf ("%04d-%02d-%02d", 1999, $_, $_ + 15);
         print CONFIG "    ${dt} = \${$lang.$dt}      # ENCRYPT\n";
      }
      print CONFIG "\n";
   }

   print CONFIG "----------------------------------------------------------\n\n";

   # So can validate we have no issues writing foreign languages to a
   # file and reading them back out again!
   foreach my $lang ( sort keys %{$all_languages} ) {
      my $l = $all_languages->{$lang};

      next  if ( $l->{wide} && ! $wide_flag );

      print CONFIG "[ $lang ]\n";
      foreach ( 0..11 ) {
         print CONFIG "MoY_${_} = $l->{MoY}->[$_]    # ENCRYPT\n";
      }
      print CONFIG "\n";
      foreach ( 0..11 ) {
         print CONFIG "MoYs_${_} = $l->{MoYs}->[$_]    # ENCRYPT\n";
      }
      print CONFIG "\n";

      # The status to use for the dbug_ok() tests in the following loop ...
      # Done this way so I can easily flip the switch to cause failed
      # tests during debugging this lc(uc(month)) issue!
      my $ok_tst = 1;
      my $ok_msg = $ok_tst ? "failed" : "worked";

      foreach ( 0..11 ) {
         my $uc1 = uc ($l->{MoY}->[$_]);
         my $uc2 = uc ($l->{MoYs}->[$_]);
         my $lc1 = lc ($l->{MoY}->[$_]);
         my $lc2 = lc ($l->{MoYs}->[$_]);

         # Search for upper case issues ...
         my ($p1, $p2, $p3, $p4) = ("", "", "", "");
         if ( uc($lc1) ne $uc1 ) {
            my $t = uc($lc1);
            my ($u1, $u2) = (utf8::is_utf8($uc1)||0, utf8::is_utf8($t)||0);
            dbug_ok ($ok_tst, "${lang}: Force uppercase on MoY[$_] ${ok_msg}.  ($uc1, $t) utf8($u1,$u2)");
            $p1 = " - Has problem? ($lang)";
            if ( $uc1 ne lc ($uc1) ) {
               dbug_ok ($ok_tst, "${lang}: Force uppercase on uc(uc(MoY[$_])) ${ok_msg}.\n");
            }
         }

         if ( uc($lc2) ne $uc2 ) {
            my $t = uc($lc2);
            my ($u1, $u2) = (utf8::is_utf8($uc2)||0, utf8::is_utf8($t)||0);
            dbug_ok ($ok_tst, "${lang}: Force uppercase on MoYs[$_] ${ok_msg}.  ($uc2, $t) utf8($u1,$u2)");
            $p2 = " - Has problem? ($lang)";
            if ( $uc2 ne lc ($uc2) ) {
               dbug_ok ($ok_tst, "${lang}: Force uppercase on uc(uc(MoYs[$_])) ${ok_msg}.\n");
            }
         }

         # Search for lower case issues ...
         if ( lc($uc1) ne $lc1 ) {
            my $t = lc($uc1);
            my ($u1, $u2) = (utf8::is_utf8($lc1)||0, utf8::is_utf8($t)||0);
            dbug_ok ($ok_tst, "${lang}: Force lowercase on MoY[$_] ${ok_msg}.  ($lc1, $t) utf8($u1,$u2)");
            $p3 = " - Has problem? ($lang)";
            if ( $lc1 ne lc ($lc1) ) {
               dbug_ok ($ok_tst, "${lang}: Force lowercase on lc(lc(MoY[$_])) ${ok_msg}.\n");
            }
         }

         if ( lc($uc2) ne $lc2 ) {
            my $t = lc($uc2);
            my ($u1, $u2) = (utf8::is_utf8($lc2)||0, utf8::is_utf8($t)||0);
            dbug_ok ($ok_tst, "${lang}: Force lowercase on MoYs[$_] ${ok_msg}.  ($lc2, $t) utf8($u1,$u2)");
            $p4 = " - Has problem? ($lang)";
            if ( $lc2 ne lc ($lc2) ) {
               dbug_ok ($ok_tst, "${lang}: Force lowercase on lc(lc(MoYs[$_])) ${ok_msg}.\n");
            }
         }

         # Write to the config file ...
         print CONFIG sprintf ("uMoY_%d  = %s     # utf8 (%d)%s  %s\n",
                               $_, $uc1, utf8::is_utf8($uc1) || 0, $p1, "ENCRYPT");
         print CONFIG sprintf ("uMoYs_%d = %s     # utf8 (%d)%s  %s\n",
                               $_, $uc2, utf8::is_utf8($uc2) || 0, $p2, "ENCRYPT");
         print CONFIG sprintf ("lMoY_%d  = %s     # utf8 (%d)%s  %s\n",
                               $_, $lc1, utf8::is_utf8($lc1) || 0, $p3, "ENCRYPT");
         print CONFIG sprintf ("lMoYs_%d = %s     # utf8 (%d)%s  %s\n",