From 87b0de4c742e6032bcb6bf8750b1d8144e1a9860 Mon Sep 17 00:00:00 2001
From: Moritz Bunkus <m.bunkus@linet-services.de>
Date: Thu, 6 Sep 2012 10:00:17 +0200
Subject: [PATCH] =?utf8?q?SL::Locale::String-Klasse=20f=C3=BCr=20verz?=
 =?utf8?q?=C3=B6gerte=20=C3=9Cbersetzung=20hinzugef=C3=BCgt?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

---
 SL/Controller/Helper/Sorted.pm |   2 +-
 SL/Locale.pm                   |   2 +
 SL/Locale/String.pm            | 120 +++++++++++++++++++++++++++++++++
 scripts/locales.pl             |   2 +-
 4 files changed, 124 insertions(+), 2 deletions(-)
 create mode 100644 SL/Locale/String.pm

diff --git a/SL/Controller/Helper/Sorted.pm b/SL/Controller/Helper/Sorted.pm
index 8699f00c7..c9e577911 100644
--- a/SL/Controller/Helper/Sorted.pm
+++ b/SL/Controller/Helper/Sorted.pm
@@ -22,7 +22,7 @@ sub make_sorted {
   while (my ($column, $spec) = each %specs) {
     next if $column =~ m/^[A-Z_]+$/;
 
-    $spec = $specs{$column} = { title => $spec } if !ref $spec;
+    $spec = $specs{$column} = { title => $spec } if (ref($spec) || '') ne 'HASH';
 
     $spec->{model}        ||= $specs{MODEL};
     $spec->{model_column} ||= $column;
diff --git a/SL/Locale.pm b/SL/Locale.pm
index 5016900fe..8fa37805d 100644
--- a/SL/Locale.pm
+++ b/SL/Locale.pm
@@ -214,6 +214,8 @@ sub text {
   my $self = shift;
   my $text = shift;
 
+  return $text->translated if (ref($text) || '') eq 'SL::Locale::String';
+
   if ($self->{texts}->{$text}) {
     $text = $self->{iconv}->convert($self->{texts}->{$text});
   } else {
diff --git a/SL/Locale/String.pm b/SL/Locale/String.pm
new file mode 100644
index 000000000..42ceb22a6
--- /dev/null
+++ b/SL/Locale/String.pm
@@ -0,0 +1,120 @@
+package SL::Locale::String;
+
+use strict;
+
+use parent qw(Rose::Object Exporter);
+
+use Rose::Object::MakeMethods::Generic (
+  scalar => [ qw(untranslated) ],
+);
+
+our @EXPORT = qw(t8);
+
+use overload '""' => \&translated;
+
+sub translated {
+  my ($self) = @_;
+  return $::locale ? $::locale->text($self->untranslated) : $self->untranslated;
+}
+
+sub t8 {
+  my $string = $_[ ref($_[0]) || ($_[0] eq 'SL::Locale::String') ? 1 : 0 ];
+  return SL::Locale::String->new(untranslated => $string);
+}
+
+1;
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::Locale::String - Helper class for translating strings at a later
+date (e.g. use at compile time, actual translation during execution
+time)
+
+=head1 SYNOPSIS
+
+  use SL::Locale::String;
+
+  use SL::Controller::Helper::Sorted;
+
+  __PACKAGE__->make_sorted(
+    ...
+    qty => { title => t8("Quantity") },
+ );
+
+=head1 OVERVIEW
+
+Every string that should be translated must be recognized by our
+translation helper script C<script/locales.pl> somehow. It recognizes
+certain function calls as translation instructions and extracts its
+arguments for translation by developers/translators.
+
+This works well for calls that occur during execution time: C<<
+$::locale->text("Untranslated") >>. However, for untranslated strings
+that need to be used at compile time this fails in subtle and not so
+subtle ways. If it happens in a module that is C<use>d directly from
+the dispatcher then C<$::locale> is not defined and such a call would
+end in an error. For modules like controllers that are C<require>d
+during execution time it seems to work, but in FastCGI situations this
+means that the first call determines the language and all subsequent
+calls end up using the same language no matter which language the user
+has chosen.
+
+This class solves the issue by providing a small function called L<t8>
+which can be used instead of C<< $::locale->text() >>. It is
+recognized by C<script/locales.pl>. The untranslated string given to
+L<t8> is stored in an instance of C<SL::Locale::String> and translated
+only when requested either by calling L<translated> or by
+stringification.
+
+Instances of this class can safely be handed over to C<<
+$::locale->text() >> which knows how to handle them (and not to
+re-translate them).
+
+The function L<t8> is exported by default.
+
+=head1 FUNCTIONS
+
+=head2 EXPORTED FUNCTIONS
+
+=over 4
+
+=item C<t8 $untranslated_string>
+
+Returns a new instance of C<SL::Locale::String> and sets its
+L<untranslated> member to C<$untranslated_string>. This function is
+exported and cannot be called as a class or instance method.
+
+=back
+
+=head2 INSTANCE FUNCTIONS
+
+=over 4
+
+=item C<untranslated [$new_untranslated]>
+
+Gets or sets the untranslated string.
+
+=item C<translated>
+
+Returns the translated version of the untranslated string. Translation
+occurs when this function is called and not when the object instance
+is created.
+
+This function is also called during stringification.
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
diff --git a/scripts/locales.pl b/scripts/locales.pl
index 0780a49f6..f6630144e 100755
--- a/scripts/locales.pl
+++ b/scripts/locales.pl
@@ -404,7 +404,7 @@ sub scanfile {
           }
         }
 
-        my ($found) = /locale->text.*?\(/;
+        my ($found) = / (?: locale->text | \b t8 ) \b .*? \(/x;
         $postmatch = "$'";
 
         if ($found) {
-- 
2.20.1