Fix for Bug 6458 - incorrect parsing result in translation processing
[koha.git] / C4 / Output.pm
index c8404dc..98f2d7a 100644 (file)
@@ -17,20 +17,24 @@ package C4::Output;
 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA  02111-1307 USA
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
 
 # NOTE: I'm pretty sure this module is deprecated in favor of
 # templates.
 
 use strict;
+#use warnings; FIXME - Bug 2505
 
 use C4::Context;
 use C4::Languages qw(getTranslatedLanguages get_bidi regex_lang_subtags language_get_description accept_language );
+use C4::Dates qw(format_date);
+use C4::Budgets qw(GetCurrency);
+use C4::Templates;
 
-use HTML::Template::Pro;
+#use HTML::Template::Pro;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
 BEGIN {
@@ -38,17 +42,17 @@ BEGIN {
     $VERSION = 3.03;
     require Exporter;
     @ISA    = qw(Exporter);
-       @EXPORT_OK = qw(&output_ajax_with_http_headers &is_ajax); # More stuff should go here instead
+       @EXPORT_OK = qw(&is_ajax ajax_fail); # More stuff should go here instead
        %EXPORT_TAGS = ( all =>[qw(&themelanguage &gettemplate setlanguagecookie pagination_bar
-                                                               &output_ajax_with_http_headers &output_html_with_http_headers)],
-                                       ajax =>[qw(&output_ajax_with_http_headers is_ajax)],
-                                       html =>[qw(&output_html_with_http_headers)]
+                                                               &output_with_http_headers &output_html_with_http_headers)],
+                                       ajax =>[qw(&output_with_http_headers is_ajax)],
+                                       html =>[qw(&output_with_http_headers &output_html_with_http_headers)]
                                );
     push @EXPORT, qw(
-        &themelanguage &gettemplate setlanguagecookie pagination_bar
+        &themelanguage &gettemplate setlanguagecookie getlanguagecookie pagination_bar
     );
     push @EXPORT, qw(
-        &output_html_with_http_headers
+        &output_html_with_http_headers &output_with_http_headers FormatData FormatNumber
     );
 }
 
@@ -68,17 +72,10 @@ my $path = C4::Context->config('intrahtdocs') . "/prog/en/includes/";
 
 #---------------------------------------------------------------------------------------------------------
 # FIXME - POD
-sub gettemplate {
+
+sub _get_template_file {
     my ( $tmplbase, $interface, $query ) = @_;
-    ($query) or warn "no query in gettemplate";
-    my $htdocs;
-    if ( $interface ne "intranet" ) {
-        $htdocs = C4::Context->config('opachtdocs');
-    }
-    else {
-        $htdocs = C4::Context->config('intrahtdocs');
-    }
-    my $path = C4::Context->preference('intranet_includes') || 'includes';
+    my $htdocs = C4::Context->config( $interface ne 'intranet' ? 'opachtdocs' : 'intrahtdocs' );
     my ( $theme, $lang ) = themelanguage( $htdocs, $tmplbase, $interface, $query );
     my $opacstylesheet = C4::Context->preference('opacstylesheet');
 
@@ -88,25 +85,26 @@ sub gettemplate {
         $lang = 'en';
         $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
     }
-    my $template       = HTML::Template::Pro->new(
-        filename          => $filename,
-        die_on_bad_params => 1,
-        global_vars       => 1,
-        case_sensitive    => 1,
-           loop_context_vars => 1,             # enable: __first__, __last__, __inner__, __odd__, __counter__ 
-        path              => ["$htdocs/$theme/$lang/$path"]
-    );
+
+    return ( $htdocs, $theme, $lang, $filename );
+}
+
+sub gettemplate {
+    my ( $tmplbase, $interface, $query ) = @_;
+    ($query) or warn "no query in gettemplate";
+    my $path = C4::Context->preference('intranet_includes') || 'includes';
+    my $opacstylesheet = C4::Context->preference('opacstylesheet');
+    $tmplbase =~ s/\.tmpl$/.tt/;
+    my ( $htdocs, $theme, $lang, $filename ) = _get_template_file( $tmplbase, $interface, $query );
+    my $template = C4::Templates->new( $interface, $filename, $tmplbase);
     my $themelang=( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' )
           . "/$theme/$lang";
     $template->param(
         themelang => $themelang,
-        yuipath => (C4::Context->preference("yuipath") eq "local"?"$themelang/lib/yui":C4::Context->preference("yuipath")),
+        yuipath   => (C4::Context->preference("yuipath") eq "local"?"$themelang/lib/yui":C4::Context->preference("yuipath")),
         interface => ( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' ),
-        theme => $theme,
-        opacstylesheet      => $opacstylesheet,
-        opaccolorstylesheet => C4::Context->preference('opaccolorstylesheet'),
-        opacsmallimage      => C4::Context->preference('opacsmallimage'),
-        lang                => $lang
+        theme     => $theme,
+        lang      => $lang
     );
 
     # Bidirectionality
@@ -130,6 +128,17 @@ sub gettemplate {
     return $template;
 }
 
+# FIXME - this is a horrible hack to cache
+# the current known-good language, temporarily
+# put in place to resolve bug 4403.  It is
+# used only by C4::XSLT::XSLTParse4Display;
+# the language is set via the usual call
+# to themelanguage.
+my $_current_language = 'en';
+sub _current_language {
+    return $_current_language;
+}
+
 #---------------------------------------------------------------------------------------------------------
 # FIXME - POD
 sub themelanguage {
@@ -139,15 +148,12 @@ sub themelanguage {
     # Set some defaults for language and theme
     # First, check the user's preferences
     my $lang;
-       my $http_env = $ENV{HTTP_ACCEPT_LANGUAGE};
-       $http_env =~ m/(\w+-*\w*),/;
-       my $language_preference = $1;
-    my $http_accept_language = regex_lang_subtags($language_preference)->{language};
-    if ($http_accept_language) {
-        $lang = accept_language($http_accept_language,getTranslatedLanguages($interface,'prog'));
-    } 
+    my $http_accept_language = $ENV{ HTTP_ACCEPT_LANGUAGE };
+    $lang = accept_language( $http_accept_language, 
+              getTranslatedLanguages($interface,'prog') )
+      if $http_accept_language;
     # But, if there's a cookie set, obey it
-    $lang = $query->cookie('KohaOpacLanguage') if $query->cookie('KohaOpacLanguage');
+    $lang = $query->cookie('KohaOpacLanguage') if (defined $query and $query->cookie('KohaOpacLanguage'));
     # Fall back to English
     my @languages;
     if ($interface eq 'intranet') {
@@ -192,6 +198,8 @@ sub themelanguage {
             #}
         }
     }
+
+    $_current_language = $lang; # FIXME part of bad hack to paper over bug 4403
     return ( $theme, $lang );
 }
 
@@ -208,6 +216,60 @@ sub setlanguagecookie {
     );
 }
 
+sub getlanguagecookie {
+    my ($query) = @_;
+    my $lang;
+    if ($query->cookie('KohaOpacLanguage')){
+        $lang = $query->cookie('KohaOpacLanguage') ;
+    }else{
+        $lang = $ENV{HTTP_ACCEPT_LANGUAGE};
+        
+    }
+    $lang = substr($lang, 0, 2);
+
+    return $lang;
+}
+
+=item FormatNumber
+=cut
+sub FormatNumber{
+my $cur  =  GetCurrency;
+my $cur_format = C4::Context->preference("CurrencyFormat");
+my $num;
+
+if ( $cur_format eq 'FR' ) {
+    $num = new Number::Format(
+        'decimal_fill'      => '2',
+        'decimal_point'     => ',',
+        'int_curr_symbol'   => $cur->{symbol},
+        'mon_thousands_sep' => ' ',
+        'thousands_sep'     => ' ',
+        'mon_decimal_point' => ','
+    );
+} else {  # US by default..
+    $num = new Number::Format(
+        'int_curr_symbol'   => '',
+        'mon_thousands_sep' => ',',
+        'mon_decimal_point' => '.'
+    );
+}
+return $num;
+}
+
+=item FormatData
+
+FormatData($data_hashref)
+C<$data_hashref> is a ref to data to format
+
+Format dates of data those dates are assumed to contain date in their noun
+Could be used in order to centralize all the formatting for HTML output
+=cut
+
+sub FormatData{
+               my $data_hashref=shift;
+        $$data_hashref{$_} = format_date( $$data_hashref{$_} ) for grep{/date/} keys (%$data_hashref);
+}
+
 =item pagination_bar
 
    pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name)
@@ -354,48 +416,71 @@ sub pagination_bar {
     return $pagination_bar;
 }
 
-=item output_html_with_http_headers
+=item output_with_http_headers
+
+   &output_with_http_headers($query, $cookie, $data, $content_type[, $status])
+
+Outputs $data with the appropriate HTTP headers,
+the authentication cookie $cookie and a Content-Type specified in
+$content_type.
 
-   &output_html_with_http_headers($query, $cookie, $html[, $content_type])
+If applicable, $cookie can be undef, and it will not be sent.
 
-Outputs the HTML page $html with the appropriate HTTP headers,
-with the authentication cookie $cookie and a Content-Type that
-corresponds to the HTML page $html.
+$content_type is one of the following: 'html', 'js', 'json', 'xml', 'rss', or 'atom'.
 
-If the optional C<$content_type> parameter is called, set the
-response's Content-Type to that value instead of "text/html".
+$status is an HTTP status message, like '403 Authentication Required'. It defaults to '200 OK'.
 
 =cut
 
-sub output_html_with_http_headers ($$$;$) {
-    my $query = shift;
-    my $cookie = shift;
-    my $html = shift;
-    my $content_type = @_ ? shift : "text/html";
-    $content_type = "text/html" unless $content_type =~ m!/!; # very basic sanity check
-    print $query->header(
-        -type    => $content_type,
-        -charset => 'UTF-8',
-        -cookie  => $cookie,
-        -Pragma => 'no-cache',
-        -'Cache-Control' => 'no-cache',
-    ), $html;
+sub output_with_http_headers($$$$;$) {
+    my ( $query, $cookie, $data, $content_type, $status ) = @_;
+    $status ||= '200 OK';
+
+    my %content_type_map = (
+        'html' => 'text/html',
+        'js'   => 'text/javascript',
+        'json' => 'application/json',
+        'xml'  => 'text/xml',
+        # NOTE: not using application/atom+xml or application/rss+xml because of
+        # Internet Explorer 6; see bug 2078.
+        'rss'  => 'text/xml',
+        'atom' => 'text/xml'
+    );
+
+    die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
+    my $options = {
+        type    => $content_type_map{$content_type},
+        status  => $status,
+        charset => 'UTF-8',
+        Pragma          => 'no-cache',
+        'Cache-Control' => 'no-cache',
+    };
+    $options->{cookie} = $cookie if $cookie;
+    if ($content_type eq 'html') {  # guaranteed to be one of the content_type_map keys, else we'd have died
+        $options->{'Content-Style-Type' } = 'text/css';
+        $options->{'Content-Script-Type'} = 'text/javascript';
+    }
+    # remove SUDOC specific NSB NSE
+    $data =~ s/\x{C2}\x{98}|\x{C2}\x{9C}/ /g;
+    $data =~ s/\x{C2}\x{88}|\x{C2}\x{89}/ /g;
+      
+# We can't encode here, that will double encode our templates, and xslt
+# We need to fix the encoding as it comes out of the database, or when we pass the variables to templates
+#    utf8::encode($data) if utf8::is_utf8($data);
+
+    print $query->header($options), $data;
 }
 
-sub output_ajax_with_http_headers ($$) {
-    my ($query, $js) = @_;
-    print $query->header(
-        -type    => 'text/javascript',
-        -charset => 'UTF-8',
-        -Pragma  => 'no-cache',
-        -'Cache-Control' => 'no-cache',
-               -expires =>'-1d',
-    ), $js;
+sub output_html_with_http_headers ($$$;$) {
+    my ( $query, $cookie, $data, $status ) = @_;
+    $data =~ s/\&amp\;amp\; /\&amp\; /g;
+    output_with_http_headers( $query, $cookie, $data, 'html', $status );
 }
 
 sub is_ajax () {
-       my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
-       return ($x_req and $x_req =~ /XMLHttpRequest/i) ? 1 : 0;
+    my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
+    return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ? 1 : 0;
 }
 
 END { }    # module clean-up code here (global destructor)
@@ -407,6 +492,6 @@ __END__
 
 =head1 AUTHOR
 
-Koha Developement team <info@koha.org>
+Koha Development Team <http://koha-community.org/>
 
 =cut