view release on metacpan or  search on metacpan

Locale/Maketext.pm  view on Meta::CPAN

  }

  unless(defined($value)) {
    print "! Lookup of \"$phrase\" in/under ", ref($handle) || $handle,
      " fails.\n" if DEBUG;
    if(ref($handle) and $handle->{'fail'}) {
      print "WARNING0: maketext fails looking for <$phrase>\n" if DEBUG;
      my $fail;
      if(ref($fail = $handle->{'fail'}) eq 'CODE') { # it's a sub reference
        return &{$fail}($handle, $phrase, @_);
         # If it ever returns, it should return a good value.
      } else { # It's a method name
        return $handle->$fail($phrase, @_);
         # If it ever returns, it should return a good value.
      }
    } else {
      # All we know how to do is this;
      Carp::croak("maketext doesn't know how to say:\n$phrase\nas needed");
    }
  }

  return $$value if ref($value) eq 'SCALAR';
  return $value unless ref($value) eq 'CODE';
  
  {
    local $SIG{'__DIE__'};
    eval { $value = &$value($handle, @_) };
  }
  # If we make it here, there was an exception thrown in the
  #  call to $value, and so scream:
  if($@) {
    my $err = $@;
    # pretty up the error message
    $err =~ s<\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?>
             <\n in bracket code [compiled line $1],>s;
    #$err =~ s/\n?$/\n/s;
    Carp::croak "Error in maketexting \"$phrase\":\n$err as used";
    # Rather unexpected, but suppose that the sub tried calling
    # a method that didn't exist.
  } else {
    return $value;
  }
}

###########################################################################

sub get_handle {  # This is a constructor and, yes, it CAN FAIL.
  # Its class argument has to be the base class for the current
  # application's l10n files.
  my($base_class, @languages) = @_;
  $base_class = ref($base_class) || $base_class;
   # Complain if they use __PACKAGE__ as a project base class?

  unless(@languages) {  # Calling with no args is magical!  wooo, magic!
    if(length( $ENV{'REQUEST_METHOD'} || '' )) { # I'm a CGI
      @languages = $base_class->_http_accept_langs;
         # it's off in its own routine because it's complicated
      
    } else { # Not running as a CGI: try to puzzle out from the environment
      if(length( $ENV{'LANG'} || '' )) {
	push @languages, split m/[,:]/, $ENV{'LANG'};
         # LANG can be only /one/ locale as far as I know, but what the hey.
      }
      if(length( $ENV{'LANGUAGE'} || '' )) {
	push @languages, split m/[,:]/, $ENV{'LANGUAGE'};
      }
      print "Noting ENV LANG ", join(',', @languages),"\n" if DEBUG;
      # Those are really locale IDs, but they get xlated a few lines down.
      
      if(&_try_use('Win32::Locale')) {
        # If we have that module installed...
        push @languages, Win32::Locale::get_language()
         if defined &Win32::Locale::get_language;
      }
    }
  }

  #------------------------------------------------------------------------
  print "Lgs1: ", map("<$_>", @languages), "\n" if DEBUG;

  if($USING_LANGUAGE_TAGS) {
    @languages = map &I18N::LangTags::locale2language_tag($_), @languages;
     # if it's a lg tag, fine, pass thru (untainted)
     # if it's a locale ID, try converting to a lg tag (untainted),
     # otherwise nix it.

    push @languages, map I18N::LangTags::super_languages($_), @languages
     if $MATCH_SUPERS;

    @languages =  map { $_, I18N::LangTags::alternate_language_tags($_) }
                      @languages;    # catch alternation

    push @languages, I18N::LangTags::panic_languages(@languages)
      if defined &I18N::LangTags::panic_languages;
    
    push @languages, $base_class->fallback_languages;
     # You are free to override fallback_languages to return empty-list!

    @languages =  # final bit of processing:
      map {
        my $it = $_;  # copy
        $it =~ tr<-A-Z><_a-z>; # lc, and turn - to _
        $it =~ tr<_a-z0-9><>cd;  # remove all but a-z0-9_
        $it;
      } @languages
    ;
  }
  print "Lgs2: ", map("<$_>", @languages), "\n" if DEBUG > 1;

  push @languages, $base_class->fallback_language_classes;
   # You are free to override that to return whatever.


  my %seen = ();
  foreach my $module_name ( map { $base_class . "::" . $_ }  @languages )
  {
    next unless length $module_name; # sanity
    next if $seen{$module_name}++        # Already been here, and it was no-go
            || !&_try_use($module_name); # Try to use() it, but can't it.
    return($module_name->new); # Make it!
  }

  return undef; # Fail!
}