view release on metacpan or  search on metacpan

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

#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use File::Basename;
use File::Spec;
use File::Glob qw (bsd_glob);
use Fred::Fish::DBUG 2.09 qw ( on );
use Fred::Fish::DBUG::Test 2.09;

# How to find the helper module ...
BEGIN { push (@INC, File::Spec->catdir (".", "t", "test-helper")); }
use helper1234;

# ---------------------------------------------------------------------
# Automatically creates a config file with all Date::Manip::Lang::*.pm in use.
# It doesn't use the tools Advanced::Config has to give me more
# direct control on how the config file is created.  Also when originally
# created those tools hadn't been created yet.
# ---------------------------------------------------------------------
# After the config file has been created it attempts to use the
# Config object to validate everything works.
# ---------------------------------------------------------------------

my $fish;
my $config_file_normal;
my $config_file_wide;
my @global_modules;
my $run_as_developer = 0;

BEGIN {
   # The config file this program is to create!
   $config_file_normal = File::Spec->catfile (dirname ($0), "config", "76-all_languages_normal-2.cfg");
   $config_file_wide   = File::Spec->catfile (dirname ($0), "config", "76-all_languages_wide-2.cfg");
   unlink ( $config_file_normal, $config_file_wide );

   $fish = turn_fish_on_off_for_advanced_config ();

   unlink ( $fish );

   DBUG_ENTER_FUNC ();

   use_ok ("Advanced::Config");

   DBUG_VOID_RETURN ();

   # Turn fish on ...
   DBUG_PUSH ( $fish, allow_utf8 => 1 );

   $run_as_developer = $ENV{FULL_75_TEST} ? 1 : 0;
}


BEGIN
{
   DBUG_ENTER_FUNC ();

   my $ver;
   eval {
      require Date::Manip;
      Date::Manip->import ();
      $ver = $Date::Manip::VERSION;
      dbug_ok (1, "Loaded version ${ver} of Date::Manip");
   };
   if ($@) {
      dbug_ok (1, "Date::Manip is not installed.  Skipping this test!");
      done_testing ();
      DBUG_LEAVE (0);
   }

   my $index = "";
   eval {
      require Date::Manip::Lang::index;
      Date::Manip::Lang::index->import ();
      $index = "index";     # This must match this module name loaded ...
   };
   if ($@) {
      dbug_ok (1, "Date::Manip::Lang::index is not installed.  This version of Date::Manip (v${ver}) is not supported.  Skipping this test!");
      done_testing ();
      DBUG_LEAVE (0);
   }

   my %val;
   foreach my $v ( values %Date::Manip::Lang::index::Lang ) {
      $val{$v} = 1;
   }
   @global_modules = sort keys %val;

   if ( $#global_modules == -1 ) {
      dbug_ok (1, "No Date::Manip::Lang::<lang> modules are installed.  Skipping this test!");
      done_testing ();
      DBUG_LEAVE (0);
   }

   # Now load all those modules ...
   foreach my $l ( @global_modules ) {
      my $module = "Date::Manip::Lang::${l}";
      use_ok ($module);
   }

   DBUG_VOID_RETURN ();
}

END {
   DBUG_ENTER_FUNC ();
   # Don't do any tests in the END block ...
   DBUG_VOID_RETURN ();
}

sub my_warn
{
   my $msg = shift;
   chomp ($msg);
   unless ( $msg =~ m/^Wide character in print/ ) {
      dbug_ok (0, "Warning encountered - $msg");
   }
}

sub my_die
{
   my $msg = $_[0];
   chomp ($msg);
   dbug_ok (0, "Die encountered - $msg");
   done_testing ();
   die ( $_[0] );
}

# ====================================================================
# Start of the main program!
# ====================================================================
{
   DBUG_ENTER_FUNC (@ARGV);

   $SIG{__WARN__} = \&my_warn;
   $SIG{__DIE__}  = \&my_die;

   dbug_ok (1, "In the MAIN program ...");  # Test # 2 ...

   my $language_data = load_all_language_data ();
   my $cnt = keys %{$language_data};
   dbug_ok (1, "Loaded ${cnt} languages ...");

   dbug_ok (1, "----------------- Building the cfg files ------------------");

   unless ( dbug_ok ( build_config_file ( $language_data, 0 ),
                  "The normal config file was successfully built!" ) ) {
      done_testing ();
      DBUG_LEAVE (3);
   }

   unless ( dbug_ok ( build_config_file ( $language_data, 1 ),
                  "The UTF8 config file was successfully built!" ) ) {
      done_testing ();
      DBUG_LEAVE (3);
   }

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

   # The 2 digit years ... (be careful, don't use ambiguous dates!)
   } elsif ( $mode == 2 ) {
      $MoY = uc ($def->{MoY}->[$month - 1]);
      $DoM = $def->{Dsuf}->[$day] || "";
      $str = sprintf ("    %04d-%02d-%02d = %s %s, %02d      # ENCRYPT\n",
                      $year, $month, $day, $MoY, $DoM, $year % 100);

   } elsif ( $mode == 3 ) {
      $MoY = lc (uc ($def->{MoYs}->[$month - 1]));
      $str = sprintf ("    %04d-%02d-%02d = %02d-%s-%02d      # ENCRYPT\n",
                      $year, $month, $day, $day, $MoY, $year % 100);

   # The error case that should never happen ....
   } else {
      $str = sprintf ("    %04d-%02d-%02d = Programming errror!",
                      $year, $month, $day,);
   }

   return ( $str );
}
# ====================================================================
# So uc() & lc() works agaisnt each key value ...
sub fix_key
{
   my $value = shift;

   my $has_spaces = 0;
   my $wide = ( $value =~ m/[^\x00-\xff]/ ) ? 1 : 0;  # Before ...

   unless ( $wide ) {
      utf8::encode ($value);
      utf8::decode ($value);

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

   $value = lc ($value);
   $has_spaces = 1   if ( $value =~ m/\s/ );

   return ( $value, $wide, $utf8, $has_spaces );
}

# ====================================================================

sub load_all_language_data
{
   DBUG_ENTER_FUNC (@_);

   my %lang_data;

   foreach my $mod ( @global_modules ) {
      my $module = "Date::Manip::Lang::${mod}";

      my ( $lang_wide, $lang_utf8 ) = ( 0, 0 );

      my $Language = eval "\$${module}::LangName";    # The proper name of this language.

      my $langData = eval "\$${module}::Language";    # A hash reference with the data!

      my %months;
      my %days;
      my %wdays;

      # ------------------------------------------------------
      # Used to validate the config files ...
      # ------------------------------------------------------
      my ($mon_spaces, $day_spaces, $wday_spaces) = (0, 0, 0);
      foreach my $m (1..12) {
         foreach my $name ( @{$langData->{month_name}->[$m-1]} ) {
            my ($n, $before, $after, $spaces) = fix_key ($name);
            $months{$n} = $m;
            ++$mon_spaces  if ( $spaces );
            $lang_wide = $lang_wide || $before;
            $lang_utf8 = $lang_utf8 || $after;
         }

         foreach my $abb ( @{$langData->{month_abb}->[$m-1]} ) {
            my ($a, $before, $after, $spaces) = fix_key ($abb);
            $months{$a} = $m;
            ++$mon_spaces  if ( $spaces );
            $lang_wide = $lang_wide || $before;
            $lang_utf8 = $lang_utf8 || $after;
         }
      }

      foreach my $d (1..31) {
         $days{$d} = $d;     # Pure numbers are usually not in this hash list ...

         foreach my $day ( @{$langData->{nth}->[$d-1]} ) {
            my ($nth, $before, $after, $spaces) = fix_key ($day);
            $days{$nth} = $d;
            ++$day_spaces  if ( $spaces );
            $lang_wide = $lang_wide || $before;
            $lang_utf8 = $lang_utf8 || $after;
         }
      }

      # Need Sunday(1) ... Saturday(7) ... since order from localtime() [wday: 0..6]
      # But array is Monday(0) to Sunday(6).
      # So take advantage of -1 being last element in array!
      foreach my $d (1..7) {
         foreach my $w ( @{$langData->{day_name}->[$d - 2]} ) {
            my ($wd, $before, $after, $spaces) = fix_key ($w);
            $wdays{$wd} = $d;
            ++$wday_spaces  if ( $spaces );
            $lang_wide = $lang_wide || $before;
            $lang_utf8 = $lang_utf8 || $after;
         };
         foreach my $w ( @{$langData->{day_abb}->[$d - 2]} ) {
            my ($wd, $before, $after, $spaces) = fix_key ($w);
            $wdays{$wd} = $d;