use strict;
#use warnings; FIXME - Bug 2505
+use URI::Escape;
+
use C4::Context;
use C4::Dates qw(format_date);
use C4::Budgets qw(GetCurrency);
BEGIN {
# set the version for version checking
- $VERSION = 3.03;
+ $VERSION = 3.07.00.049;
require Exporter;
- @ISA = qw(Exporter);
- @EXPORT_OK = qw(&is_ajax ajax_fail); # More stuff should go here instead
- %EXPORT_TAGS = ( all =>[qw(&pagination_bar
- &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)]
- );
+
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(&is_ajax ajax_fail); # More stuff should go here instead
+ %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(
- &output_html_with_http_headers &output_with_http_headers FormatData FormatNumber 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
);
-}
+}
=head1 NAME
=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';
=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
$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',
);
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';
# utf8::encode($data) if utf8::is_utf8($data);
+ $data =~ s/\&\;amp\; /\&\; /g;
print $query->header($options), $data;
}
-sub output_html_with_http_headers ($$$;$) {
- my ( $query, $cookie, $data, $status ) = @_;
- $data =~ s/\&\;amp\; /\&\; /g;
- 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 );
+}
+
+
+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 is_ajax () {
+sub is_ajax {
my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
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;