Bug 10403: (follow-up) fix test to use vendor created earlier during test

[koha.git] / C4 / Output.pm

diff --git a/C4/Output.pm b/C4/Output.pm
index 21002c0..324cf69 100644 (file)
--- a/C4/Output.pm
+++ b/C4/Output.pm
@@ -28,6 +28,8 @@ package C4::Output;
 use strict;
 #use warnings; FIXME - Bug 2505
 
+use URI::Escape;
+
 use C4::Context;
 use C4::Dates qw(format_date);
 use C4::Budgets qw(GetCurrency);
@@ -42,13 +44,13 @@ BEGIN {
 
  @ISA    = qw(Exporter);
     @EXPORT_OK = qw(&is_ajax ajax_fail); # More stuff should go here instead
-    %EXPORT_TAGS = ( all =>[qw(&themelanguage &gettemplate setlanguagecookie pagination_bar
+    %EXPORT_TAGS = ( all =>[qw(setlanguagecookie pagination_bar parametrized_url
                                 &output_with_http_headers &output_ajax_with_http_headers &output_html_with_http_headers)],
                     ajax =>[qw(&output_with_http_headers &output_ajax_with_http_headers is_ajax)],
                     html =>[qw(&output_with_http_headers &output_html_with_http_headers)]
                 );
     push @EXPORT, qw(
-        &themelanguage &gettemplate setlanguagecookie getlanguagecookie pagination_bar
+        setlanguagecookie getlanguagecookie pagination_bar parametrized_url
     );
     push @EXPORT, qw(
         &output_html_with_http_headers &output_ajax_with_http_headers &output_with_http_headers FormatData FormatNumber
@@ -125,7 +127,7 @@ This function returns HTML, without any language dependency.
 =cut
 
 sub pagination_bar {
-       my $base_url = (@_ ? shift : $ENV{SCRIPT_NAME} . $ENV{QUERY_STRING}) or return undef;
+       my $base_url = (@_ ? shift : $ENV{SCRIPT_NAME} . $ENV{QUERY_STRING}) or return;
     my $nb_pages       = (@_) ? shift : 1;
     my $current_page   = (@_) ? shift : undef; # delay default until later
     my $startfrom_name = (@_) ? shift : 'page';
@@ -253,7 +255,7 @@ sub pagination_bar {
 
 =item output_with_http_headers
 
-   &output_with_http_headers($query, $cookie, $data, $content_type[, $status])
+   &output_with_http_headers($query, $cookie, $data, $content_type[, $status[, $extra_options]])
 
 Outputs $data with the appropriate HTTP headers,
 the authentication cookie $cookie and a Content-Type specified in
@@ -265,12 +267,18 @@ $content_type is one of the following: 'html', 'js', 'json', 'xml', 'rss', or 'a
 
 $status is an HTTP status message, like '403 Authentication Required'. It defaults to '200 OK'.
 
+$extra_options is hashref.  If the key 'force_no_caching' is present and has
+a true value, the HTTP headers include directives to force there to be no
+caching whatsoever.
+
 =cut
 
-sub output_with_http_headers($$$$;$) {
-    my ( $query, $cookie, $data, $content_type, $status ) = @_;
+sub output_with_http_headers {
+    my ( $query, $cookie, $data, $content_type, $status, $extra_options ) = @_;
     $status ||= '200 OK';
 
+    $extra_options //= {};
+
     my %content_type_map = (
         'html' => 'text/html',
         'js'   => 'text/javascript',
@@ -283,13 +291,17 @@ sub output_with_http_headers($$$$;$) {
     );
 
     die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
+    my $cache_policy = 'no-cache';
+    $cache_policy .= ', no-store, max-age=0' if $extra_options->{force_no_caching};
     my $options = {
         type    => $content_type_map{$content_type},
         status  => $status,
         charset => 'UTF-8',
         Pragma          => 'no-cache',
-        'Cache-Control' => 'no-cache',
+        'Cache-Control' => $cache_policy,
     };
+    $options->{expires} = 'now' if $extra_options->{force_no_caching};
+
     $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';
@@ -305,9 +317,9 @@ sub output_with_http_headers($$$$;$) {
     print $query->header($options), $data;
 }
 
-sub output_html_with_http_headers ($$$;$) {
-    my ( $query, $cookie, $data, $status ) = @_;
-    output_with_http_headers( $query, $cookie, $data, 'html', $status );
+sub output_html_with_http_headers {
+    my ( $query, $cookie, $data, $status, $extra_options ) = @_;
+    output_with_http_headers( $query, $cookie, $data, 'html', $status, $extra_options );
 }
 
 
@@ -327,6 +339,18 @@ sub is_ajax {
     return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ? 1 : 0;
 }
 
+sub parametrized_url {
+    my $url = shift || ''; # ie page.pl?ln={LANG}
+    my $vars = shift || {}; # ie { LANG => en }
+    my $ret = $url;
+    while ( my ($key,$val) = each %$vars) {
+        my $val_url = URI::Escape::uri_escape_utf8($val);
+        $ret =~ s/\{$key\}/$val_url/g;
+    }
+    $ret =~ s/\{[^\{]*\}//g; # remove not defined vars
+    return $ret;
+}
+
 END { }    # module clean-up code here (global destructor)
 
 1;