view release on metacpan or  search on metacpan

Locale-Maketext-insu.patch  view on Meta::CPAN

+
+sub currency {
+  my($hdl, $amount,$curr) = @_;
+
+  $curr  ||= $hdl->{currency} || '$';
+  my $sep  = $hdl->{thousand_sep} || ",";
+  my $dot  = $hdl->{numf_comma} ? "," : ".";
+
+  # Kludge
+  my ($int,$cents) = split /[.,]/, CORE::sprintf "%.2f", $amount;
+  for ( my $i =  length($int) - 3 ; $i > 0; $i -= 3 ) {
+      substr( $int, $i, 1) = $sep . substr $int, $i, 1;
+  }
+
+  return "$curr$int$dot$cents";
+}
+
+#--------------------------------------------------------------------------
+
 =item the method CLASS->new
 
 This is used by CLASS->get_handle to actually perform the
@@ -209,7 +237,7 @@
     if(ref($handle) && defined($handle->{'fail'})
        && length($handle->{'fail'})) {
       my $fail = $handle->{'fail'};
-      print "WARNING0: maketext fails looking for <$phrase>\n" if $Debug;
+      print STDERR "WARNING0: maketext fails looking for <$phrase>\n" if $Debug;
       if(ref($fail) eq 'CODE') { # it's a sub reference
 	$value = &{$fail}($handle, $phrase, @params);
         # if it ever returns, it should return a good value
@@ -218,7 +246,7 @@
         # if it ever returns, it should return a good value
       }
     } else {
-      print "WARNING1: maketext fails looking for <$phrase>\n" if $Debug;
+      print STDERR "WARNING1: maketext fails looking for <$phrase>\n" if $Debug;
     }
     return $value;
   }
@@ -259,15 +287,16 @@
       @languages = &I18N::LangTags::extract_language_tags($in);
     } else { # Not running as a CGI: try to puzzle out from the environment
       if(length($ENV{'LANG'})) {
-	@languages = split /,:/, $ENV{'LANG'};
-         # LANG can be one lg as far as I know, but what the hey.
-	print "Noting ENV languages ", join(',', @languages),"\n" if $Debug;
+	@languages = split /,:/, $ENV{LANGUAGE} || $ENV{LANG};
+	# LANGUAGE is a GNU extension which specifies the preferred language
+	# as a path.
+	print STDERR "Noting ENV languages ", join(',', @languages),"\n" if $Debug;
       }
     }
   }
 
   #------------------------------------------------------------------------
-  print "Lgs1: ", map("<$_>", @languages), "\n" if $Debug > 0;
+  print STDERR "Lgs1: ", map("<$_>", @languages), "\n" if $Debug > 0;
 
   if($USING_LANGUAGE_TAGS) {
     @languages = map &I18N::LangTags::locale2language_tag($_), @languages;
@@ -289,7 +318,7 @@
 	$it;
       } @languages;
   }
-  print "Lgs2: ", map("<$_>", @languages), "\n" if $Debug > 0;
+  print STDERR "Lgs2: ", map("<$_>", @languages), "\n" if $Debug > 0;
 
   push @languages, $base_class->fallback_languages;
    # You are free to override fallback_languages to return empty-list
@@ -385,21 +414,21 @@
    unless defined $key;
 
   my @lex_refs = $handle->lex_refs;
-  print " Lex refs for $class : ", map("<$_>", @lex_refs), "\n" if $Debug;
+  print STDERR " Lex refs for $class : ", map("<$_>", @lex_refs), "\n" if $Debug;
   foreach my $h_r (@lex_refs) {
-    print "* Looking up \"$key\" in $h_r\n" if $Debug;
+    print STDERR "* Looking up \"$key\" in $h_r\n" if $Debug;
     if(exists $h_r->{$key}) {
-      print "  Found \"$key\" in $h_r\n" if $Debug;
+      print STDERR "  Found \"$key\" in $h_r\n" if $Debug;
       return $h_r->{$key} if ref $h_r->{$key};
       return( $h_r->{$key} = $handle->compile($h_r->{$key}) );
     } elsif(exists($h_r->{'_AUTO'}) && $h_r->{'_AUTO'}) { # it's an auto lex
-      print "  Automaking \"$key\" into $h_r\n" if $Debug;
+      print STDERR "  Automaking \"$key\" into $h_r\n" if $Debug;
       return( $h_r->{$key} = $handle->compile($key) );
     }
-    print "  Not found in $h_r, nor automakable\n" if $Debug > 1;
+    print STDERR "  Not found in $h_r, nor automakable\n" if $Debug > 1;
     # else keep looking
   }
-  print "! Lookup of \"$key\" in/under $class fails.\n" if $Debug;
+  print STDERR "! Lookup of \"$key\" in/under $class fails.\n" if $Debug;
   return undef;  # Fallthru
 }
 
@@ -423,7 +452,7 @@
 
   # Cobbles together a sub that's a closure around @bits and maybe @methods
 
-  print "About to compile $text\n" if $Debug;
+  print STDERR "About to compile $text\n" if $Debug;
 
   return sub { $text } unless $text =~ /\[/;
    # if there's no brackety things to compile, just be a closure
@@ -435,9 +464,9 @@
   my @pre_out = ("sub {\n use strict;\n my \$handle = \$_[0];\n");
   if($Debug > 1) {
     push @pre_out,
-     "  print \"\\\@_: \", join(',', \@_), \"\\n\";\n",
-     "  print \"\\\@methods: \", join(',', \@methods), \"\\n\";\n",
-     "  print \"\\\@bits: \", join(',', \@bits), \"\\n\";\n",
+     "  print STDERR \"\\\@_: \", join(',', \@_), \"\\n\";\n",
+     "  print STDERR \"\\\@methods: \", join(',', \@methods), \"\\n\";\n",
+     "  print STDERR \"\\\@bits: \", join(',', \@bits), \"\\n\";\n",
     ;
   }
   my @out = (" return join '',\n");
@@ -451,7 +480,7 @@