view release on metacpan or  search on metacpan

t/75-check_all_languages.t  view on Meta::CPAN

   } else {
      $str = sprintf ("    %04d-%02d-%02d = Programming errror!",
                      $year, $month, $day,);
   }

   # Only happens with bad language definitions ...
   unless ( $MoY ) {
      DBUG_PRINT ("ERROR", "MoY is null for '%s'.  mode: %d\n%s", $lang, $mode, $str);
   }

   return ( $str );
}

# ====================================================================
sub load_all_language_data
{
   DBUG_ENTER_FUNC (@_);

   my %lang_data;

   my $lidx = 0;
   foreach my $lang ( @global_languages ) {
      my $uses_utf8_mod = $global_lang_use_utf8[$lidx++];

      my $module = "Date::Language::${lang}";
      my ( $lang_wide, $lang_utf8 ) = ( 0, 0 );

      # @Dsuf isn't always available for some modules.
      my @lMoY  = eval "\@${module}::MoY";     # The fully spelled out Months.
      my @lMoYs = eval "\@${module}::MoYs";    # The legal Abbreviations.
      my @lDsuf = eval "\@${module}::Dsuf";    # The suffix for the Day of Month. (buggy)
      my @lDoW  = eval "\@${module}::DoW";     # The Day of Week.
      my @lDoWs = eval "\@${module}::DoWs";    # The Day of Week Abbreviations.
      my $has_spaces = 0;

      # Fix so that uc() & lc() will always work on these 5 arrays ...
      foreach (@lMoY, @lMoYs, @lDsuf, @lDoW, @lDoWs ) {
         my $wide = utf8::is_utf8 ($_) || 0;   # Before ...
         unless ( $wide ) {
            utf8::encode ($_);
            utf8::decode ($_);

            # Now determine if a common variant makes it wide ...
            if ( $_ =~  m/[^\x00-\xff]/ ) {
               $wide -= 1;     # Now: -1
            }
            if ( lc ($_) =~  m/[^\x00-\xff]/ ) {
               $wide -= 2;     # Now: -2 or -3
            }
            if ( uc ($_) =~  m/[^\x00-\xff]/ ) {
               $wide -= 4;     # Now: -4, -5, -6 or -7 ...
            }
         }
         my $utf8 = utf8::is_utf8 ($_) || 0;   # After ...

         $lang_wide = $lang_wide || $wide;
         $lang_utf8 = $lang_utf8 || $utf8;
         ++$has_spaces   if ( $_ =~ m/\s/ );
      }

      # So I can log my results ...
      # And prove my assumptions are good!
      my $test_ok = ( scalar (@lMoY) == 12 && scalar (@lMoYs) == 12 );

      DBUG_PRINT ($test_ok ? "INFO" : "BAD",
                  "MoY: %d, MoYs: %d, Dsuf: %02d, DoW: %d, DoWs: %d, wide(%2d), utf8(%d), uses_utf8_mod(%s), spaces(%2d), Language: %s",
                  scalar (@lMoY), scalar (@lMoYs), scalar (@lDsuf), scalar (@lDoW), scalar (@lDoWs),
                  $lang_wide, $lang_utf8, $uses_utf8_mod ? "YES" : "no", $has_spaces, $lang);

      if ( $test_ok ) {
         my %data = ( MoY  => \@lMoY,      MoYs   => \@lMoYs,
                      Dsuf => \@lDsuf,
                      DoW  => \@lDoW,      DoWs   => \@lDoWs,
                      wide => $lang_wide,  utf8   => $lang_utf8,
                      lang => $lang,       spaces => $has_spaces,
                      used_utf8_mod => $uses_utf8_mod );

         $lang_data{$lang} = \%data;
      }
   }

   DBUG_RETURN (\%lang_data);
}