Bug 8255: allow local cover images to be cached
[koha_gimpoz] / C4 / Output.pm
index f0f5f5f..8d12552 100644 (file)
@@ -17,198 +17,92 @@ 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 vars qw($VERSION @ISA @EXPORT);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
 BEGIN {
-       # set the version for version checking
-       $VERSION = 3.01;
-       require Exporter;
-       @ISA    = qw(Exporter);
-       push @EXPORT, qw(
-               &themelanguage &gettemplate setlanguagecookie pagination_bar
-       );
-       push @EXPORT, qw(
-               &output_html_with_http_headers
-       );
+    # set the version for version checking
+    $VERSION = 3.03;
+    require Exporter;
+
+ @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
+                                &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
+    );
+    push @EXPORT, qw(
+        &output_html_with_http_headers &output_ajax_with_http_headers &output_with_http_headers FormatData FormatNumber
+    );
+
 }
 
 =head1 NAME
 
-C4::Output - Functions for managing templates
+C4::Output - Functions for managing output, is slowly being deprecated
 
 =head1 FUNCTIONS
 
 =over 2
-
 =cut
 
-#FIXME: this is a quick fix to stop rc1 installing broken
-#Still trying to figure out the correct fix.
-my $path = C4::Context->config('intrahtdocs') . "/prog/en/includes/";
-
-#---------------------------------------------------------------------------------------------------------
-# FIXME - POD
-sub gettemplate {
-    my ( $tmplbase, $interface, $query ) = @_;
-    if ( !$query ) {
-        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 ( $theme, $lang ) = themelanguage( $htdocs, $tmplbase, $interface, $query );
-    my $opacstylesheet = C4::Context->preference('opacstylesheet');
-
-       # if the template doesn't exist, load the English one as a last resort
-       my $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
-       unless (-f $filename) {
-               $lang = 'en';
-               $filename = "$htdocs/$theme/$lang/".($interface eq 'intranet'?"modules":"")."/$tmplbase";
-       }
-    my $template       = HTML::Template::Pro->new(
-               filename          => $filename,
-        die_on_bad_params => 1,
-        global_vars       => 1,
-        case_sensitive    => 1,
-        path              => ["$htdocs/$theme/$lang/$path"]
+=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' => ','
     );
-
-    $template->param(
-        themelang => ( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' )
-          . "/$theme/$lang",
-        interface => ( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' ),
-        theme => $theme,
-        opacstylesheet      => $opacstylesheet,
-        opaccolorstylesheet => C4::Context->preference('opaccolorstylesheet'),
-        opacsmallimage      => C4::Context->preference('opacsmallimage'),
-        lang                => $lang
+} else {  # US by default..
+    $num = new Number::Format(
+        'int_curr_symbol'   => '',
+        'mon_thousands_sep' => ',',
+        'mon_decimal_point' => '.'
     );
-
-       # Bidirectionality
-       my $current_lang = regex_lang_subtags($lang);
-       my $bidi;
-       $bidi = get_bidi($current_lang->{script}) if $current_lang->{script};
-
-       # Languages
-       my @template_languages;
-       my $languages_loop = getTranslatedLanguages($interface,$theme);
-
-       for my $language_hashref (@$languages_loop) {
-                       $language_hashref->{'current_lang'} = $current_lang->{'language'};
-                       $language_hashref->{'native_description'} = language_get_description($language_hashref->{'language_code'},$language_hashref->{'language_code'},'language');
-                       #warn "($language_hashref->{'language_code'},$language_hashref->{'current_lang'},$language_hashref->{'script_code'}";
-                       $language_hashref->{'locale_description'} = language_get_description($language_hashref->{'language_code'},$language_hashref->{'current_lang'},'language');
-                       $language_hashref->{'language_description'} = language_get_description($language_hashref->{'language_code'},$language_hashref->{'current_lang'},'language');
-                       $language_hashref->{'script_description'} = language_get_description($language_hashref->{'script_code'},$language_hashref->{'current_lang'},'script');
-                       $language_hashref->{'region_description'} = language_get_description($language_hashref->{'region_code'},$language_hashref->{'current_lang'},'region');
-                       $language_hashref->{'variant_description'} = language_get_description($language_hashref->{'variant_code'},$language_hashref->{'current_lang'},'variant');
-
-               if ($language_hashref->{'language_lang'} eq $lang) {
-                       $language_hashref->{current}++;
-               }
-               push @template_languages, $language_hashref;
-       }
-       # load the languages ( for switching from one template to another )
-       $template->param(       languages_loop => \@template_languages,
-                                               bidi => $bidi
-       );
-
-    return $template;
+}
+return $num;
 }
 
-#---------------------------------------------------------------------------------------------------------
-# FIXME - POD
-sub themelanguage {
-    my ( $htdocs, $tmpl, $interface, $query ) = @_;
-
-       # Set some defaults for language and theme
-       # First, check the user's preferences
-       my $lang;
-       my $http_accept_language = regex_lang_subtags($ENV{HTTP_ACCEPT_LANGUAGE})->{language};
-       $lang = accept_language($http_accept_language,getTranslatedLanguages($interface,'prog'));
-
-       # But, if there's a cookie set, obey it
-       $lang = $query->cookie('KohaOpacLanguage') if $query->cookie('KohaOpacLanguage');
-
-       # Fall back to English
-       $lang = 'en' unless $lang;
-       my $theme = 'prog';
-
-    my $dbh = C4::Context->dbh;
-    my @languages;
-    my @themes;
-    if ( $interface eq "intranet" ) {
-        @languages = split " ", C4::Context->preference("opaclanguages");
-        @themes    = split " ", C4::Context->preference("template");
-        pop @languages, $lang if $lang;
-    }
-    else {
+=item FormatData
 
-      # we are in the opac here, what im trying to do is let the individual user
-      # set the theme they want to use.
-      # and perhaps the them as well.
-        #my $lang = $query->cookie('KohaOpacLanguage');
-        if ($lang) {
+FormatData($data_hashref)
+C<$data_hashref> is a ref to data to format
 
-            push @languages, $lang;
-            @themes = split " ", C4::Context->preference("opacthemes");
-        }
-        else {
-            @languages = split " ", C4::Context->preference("opaclanguages");
-            @themes    = split " ", C4::Context->preference("opacthemes");
-        }
-    }
-
- # searches through the themes and languages. First template it find it returns.
- # Priority is for getting the theme right.
-  THEME:
-    foreach my $th (@themes) {
-        foreach my $la (@languages) {
-            for ( my $pass = 1 ; $pass <= 2 ; $pass += 1 ) {
-                $la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
-                if ( -e "$htdocs/$th/$la/".($interface eq 'intranet'?"modules":"")."/$tmpl" ) {
-                    $theme = $th;
-                    $lang  = $la;
-                    last THEME;
-                }
-                last unless $la =~ /[-_]/;
-            }
-        }
-    }
-    return ( $theme, $lang );
-}
+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 setlanguagecookie {
-    my ( $query, $language, $uri ) = @_;
-    my $cookie = $query->cookie(
-        -name    => 'KohaOpacLanguage',
-        -value   => $language,
-        -expires => ''
-    );
-    print $query->redirect(
-        -uri    => $uri,
-        -cookie => $cookie
-    );
+sub FormatData{
+               my $data_hashref=shift;
+        $$data_hashref{$_} = format_date( $$data_hashref{$_} ) for grep{/date/} keys (%$data_hashref);
 }
 
 =item pagination_bar
@@ -231,21 +125,28 @@ This function returns HTML, without any language dependency.
 =cut
 
 sub pagination_bar {
-    my ( $base_url, $nb_pages, $current_page, $startfrom_name ) = @_;
+       my $base_url = (@_ ? shift : $ENV{SCRIPT_NAME} . $ENV{QUERY_STRING}) or return undef;
+    my $nb_pages       = (@_) ? shift : 1;
+    my $current_page   = (@_) ? shift : undef; # delay default until later
+    my $startfrom_name = (@_) ? shift : 'page';
 
     # how many pages to show before and after the current page?
     my $pages_around = 2;
 
-    my $url =
-      $base_url . ( $base_url =~ m/&/ ? '&amp;' : '?' ) . $startfrom_name . '=';
+       my $delim = qr/\&(?:amp;)?|;/;          # "non memory" cluster: no backreference
+       $base_url =~ s/$delim*\b$startfrom_name=(\d+)//g; # remove previous pagination var
+    unless (defined $current_page and $current_page > 0 and $current_page <= $nb_pages) {
+        $current_page = ($1) ? $1 : 1; # pull current page from param in URL, else default to 1
+               # $debug and    # FIXME: use C4::Debug;
+               # warn "with QUERY_STRING:" .$ENV{QUERY_STRING}. "\ncurrent_page:$current_page\n1:$1  2:$2  3:$3";
+    }
+       $base_url =~ s/($delim)+/$1/g;  # compress duplicate delims
+       $base_url =~ s/$delim;//g;              # remove empties
+       $base_url =~ s/$delim$//;               # remove trailing delim
 
+    my $url = $base_url . (($base_url =~ m/$delim/ or $base_url =~ m/\?/) ? '&amp;' : '?' ) . $startfrom_name . '=';
     my $pagination_bar = '';
 
-    # current page detection
-    if ( not defined $current_page ) {
-        $current_page = 1;
-    }
-
     # navigation bar useful only if more than one page to display !
     if ( $nb_pages > 1 ) {
 
@@ -350,25 +251,80 @@ 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)
+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'.
+
+$status is an HTTP status message, like '403 Authentication Required'. It defaults to '200 OK'.
 
 =cut
 
-sub output_html_with_http_headers ($$$) {
-    my($query, $cookie, $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';
+    }
+
+# 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);
+
+    $data =~ s/\&amp\;amp\; /\&amp\; /g;
+    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_ajax_with_http_headers {
+    my ( $query, $js ) = @_;
     print $query->header(
-        -type    => 'text/html',
-        -charset => 'UTF-8',
-        -cookie  => $cookie,
-               -Pragma => 'no-cache',
-               -'Cache-Control' => 'no-cache',
-    ), $html;
+        -type            => 'text/javascript',
+        -charset         => 'UTF-8',
+        -Pragma          => 'no-cache',
+        -'Cache-Control' => 'no-cache',
+        -expires         => '-1d',
+    ), $js;
+}
+
+sub is_ajax {
+    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)
@@ -380,6 +336,6 @@ __END__
 
 =head1 AUTHOR
 
-Koha Developement team <info@koha.org>
+Koha Development Team <http://koha-community.org/>
 
 =cut