view release on metacpan or  search on metacpan

lib/Lingua/Any/Numbers.pm  view on Meta::CPAN

   foreach my $thing ( @args ) {
      if ( lc $thing eq '+locale' ) { $USE_LOCALE = 1; next; }
      if ( lc $thing eq '-locale' ) { $USE_LOCALE = 0; next; }
      push @exports, $thing;
   }

   return $class->export_to_level( 1, $class, @exports );
}

sub to_string  {
   my @args = @_;
   return _to( string  => @args )
}

sub to_ordinal {
   my @args = @_;
   return _to( ordinal => @args )
}

sub available {
   my @ids = sort keys %LMAP;
   return @ids;
}

sub language_handler {
   my $lang = shift             || return;
   my $h    = $LMAP{ uc $lang } || return;
   return $h->{class};
}

# -- PRIVATE -- #

sub _to {
   my $type   = shift || croak 'No type specified';
   my $n      = shift;
   my $lang   = shift || _get_lang();
      $lang   = uc $lang;
      $lang   = _get_lang($lang) if $lang eq 'LOCALE';
   if ( ($lang eq 'LOCALE' || $USE_LOCALE) && ! exists $LMAP{ $lang } ) {
      _w("Locale language ($lang) is not available. "
        ."Falling back to default language ($DEFAULT)");
      $lang = $DEFAULT; # prevent die()ing from an absent driver
   }
   my $struct = $LMAP{ $lang } || croak "Language ($lang) is not available";
   return $struct->{ $type }->( $n );
}

sub _get_lang {
   my $lang;
   my $locale = shift;
   $lang = _get_lang_from_locale() if $locale || $USE_LOCALE;
   $lang = $DEFAULT if ! $lang;
   return uc $lang;
}

sub _get_lang_from_locale {
   require I18N::LangTags::Detect;
   my @user_wants = I18N::LangTags::Detect::detect();
   my $lang = $user_wants[0] || return;
   ($lang,undef) = split m{\-}xms, $lang; # tr-tr
   return $lang;
}

sub _is_silent { return defined &SILENT && SILENT() }

sub _dummy_ordinal { return shift }
sub _dummy_string  { return shift }
sub _dummy_oo      {
   my $class = shift;
   my $type  = shift;
   return $type && ! $class->can('parse')
         ? sub { $class->new->$type( shift ) }
         : sub { $class->new->parse( shift ) }
         ;
}

sub _probe {
   my @compile;
   foreach my $module ( _probe_inc() ) {
      my $class = $module->[LCLASS];

      (my $inc = $class) =~ s{::}{/}xmsg;
      $inc .= q{.pm};

      if ( ! $INC{ $inc } ) {
         my $file = File::Spec->catfile( split m{::}xms, $class ) . '.pm';
         eval {
            require $file;
            $class->import;
            1;
         } or do {
            # some modules need attention
            _probe_error($@, $class);
            next;
         };
         $INC{ $inc } = $INC{ $file };
      }

      push @compile, $module;
   }
   _compile( \@compile );
   return 1;
}

sub _probe_error {
   my($e, $class) = @_;
   if ( $e =~ RE_LEGACY_PERL ) { # JA -> 5.6.2
      return _w( _eprobe( $class, $1, $2 ) );
   }
   croak("An error occurred while including sub modules: $e");
}

sub _probe_inc {
   require Symbol;
   my @classes;
   foreach my $inc ( @INC ) {
      my $path = File::Spec->catfile( $inc, 'Lingua' );
      next if ! -d $path;
      my $DIRH = Symbol::gensym();
      opendir $DIRH, $path or croak "opendir($path): $!";
      while ( my $dir = readdir $DIRH ) {
         next if $dir =~ m{ \A [.] }xms || $NOT_LANG{ $dir };
         ($dir) = $dir =~ m{([a-z0-9_]+)}xmsi or next; # untaint
         my @rs = _probe_exists($path, $dir);
         next if ! @rs; # bogus
         foreach my $e ( @rs ) {
            my($file, $type) = @{ $e };
            push @classes, [ join(q{::}, 'Lingua', $dir, $type), $file, $dir ];
         }
      }
      closedir $DIRH;
   }

   return @classes;
}

sub _probe_exists {
   my($path, $dir) = @_;
   my @results;
   foreach my $possibility ( qw[ Numbers Num2Word Nums2Words Numeros Nums2Ords ] ) {
      my $file = File::Spec->catfile( $path, $dir, $possibility . '.pm' );
      next if ! -e $file || -d _;
      push @results, [ $file, $possibility ];
   }
   return @results;
}