Problem with error message
[koha.git] / C4 / Output.pm
index d9714a5..788d89d 100644 (file)
@@ -31,13 +31,19 @@ use C4::Context;
 use C4::Languages qw(getTranslatedLanguages get_bidi regex_lang_subtags language_get_description accept_language );
 
 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;
+    $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_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)]
+                               );
     push @EXPORT, qw(
         &themelanguage &gettemplate setlanguagecookie pagination_bar
     );
@@ -73,7 +79,6 @@ sub gettemplate {
         $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');
 
@@ -88,18 +93,17 @@ sub gettemplate {
         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"]
     );
-
+    my $themelang=( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' )
+          . "/$theme/$lang";
     $template->param(
-        themelang => ( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' )
-          . "/$theme/$lang",
+        themelang => $themelang,
+        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
@@ -108,9 +112,16 @@ sub gettemplate {
     $bidi = get_bidi($current_lang->{script}) if $current_lang->{script};
     # Languages
     my $languages_loop = getTranslatedLanguages($interface,$theme,$lang);
+    my $num_languages_enabled = 0;
+    foreach my $lang (@$languages_loop) {
+        foreach my $sublang (@{ $lang->{'sublanguages_loop'} }) {
+            $num_languages_enabled++ if $sublang->{enabled};
+         }
+    }
     $template->param(
-            languages_loop => $languages_loop,
-            bidi => $bidi
+            languages_loop       => $languages_loop,
+            bidi                 => $bidi,
+            one_language_enabled => ($num_languages_enabled <= 1) ? 1 : 0, # deal with zero enabled langs as well
     ) unless @$languages_loop<2;
 
     return $template;
@@ -125,52 +136,63 @@ sub themelanguage {
     # 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};
-    if ($http_accept_language) {
-        $lang = accept_language($http_accept_language,getTranslatedLanguages($interface,'prog'));
-    } 
+    my $http_accept_language = $ENV{ HTTP_ACCEPT_LANGUAGE };
     # But, if there's a cookie set, obey it
     $lang = $query->cookie('KohaOpacLanguage') if $query->cookie('KohaOpacLanguage');
+    
     # Fall back to English
-    my @languages = split " ", C4::Context->preference("opaclanguages");
-    if ($lang){  
+    my @languages;
+    if ($interface eq 'intranet') {
+        @languages = split ",", C4::Context->preference("language");
+    } else {
+        @languages = split ",", C4::Context->preference("opaclanguages");
+    }
+
+    # Ricardo Dias Marques
+    # 14-Nov-2009
+    # - If we have a language set in the Cookie, we'll accept it if it exists in the list of Translated Languages
+    # - If we don't have a language set in the Cookie, we'll try to use the one set in the browser (available
+    #      in $http_accept_language) if it also exists in the list of Translated Languages
+    if ($lang ne "")
+    {
+        $lang = accept_language( $lang,
+              getTranslatedLanguages($interface,'prog') );
+    }
+    else
+    {
+        $lang = accept_language( $http_accept_language,
+              getTranslatedLanguages($interface,'prog') )
+      if $http_accept_language;
+    }
+
+    if (grep(/^$lang$/, @languages)){
         @languages=($lang,@languages);
     } else {
         $lang = $languages[0];
-    }      
-    my $theme = 'prog';
+    }
 
+    my $theme = 'prog';        # in the event of theme failure default to 'prog' -fbcit
     my $dbh = C4::Context->dbh;
-    my @languages;
-    my @themes;
     if ( $interface eq "intranet" ) {
-        @themes    = split " ", C4::Context->preference("template");
+        $theme = C4::Context->preference("template");
     }
     else {
       # 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');
-        @themes = split " ", C4::Context->preference("opacthemes");
+        $theme = 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 ) {
-                # warn "$htdocs/$th/$la/modules/$interface-"."tmpl";
-                #$la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
-                               if ( -e "$htdocs/$th/$la/modules/$tmpl") {
-                #".($interface eq 'intranet'?"modules":"")."/$tmpl" ) {
-                    $theme = $th;
-                    $lang  = $la;
-                    last THEME;
-                }
-                last unless $la =~ /[-_]/;
-            #}
-        }
+    foreach my $la (@languages) {
+                       if ( -e "$htdocs/$theme/$la/modules/$tmpl") {
+                $lang  = $la;
+                last THEME;
+            }
+            last unless $la =~ /[-_]/;
     }
     return ( $theme, $lang );
 }
@@ -208,21 +230,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 ) {
 
@@ -329,18 +358,36 @@ sub pagination_bar {
 
 =item output_html_with_http_headers
 
-   &output_html_with_http_headers($query, $cookie, $html)
+   &output_html_with_http_headers($query, $cookie, $html[, $content_type][, status])
 
 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.
 
+If the optional C<$content_type> parameter is called, set the
+response's Content-Type to that value instead of "text/html".
+
 =cut
 
-sub output_html_with_http_headers ($$$) {
-    my($query, $cookie, $html) = @_;
+sub output_html_with_http_headers ($$$;$$) {
+    my $query = shift;
+    my $cookie = shift;
+    my $html = shift; 
+    $html =~ s/ \x{C2}
+       (?: \x{88} # NSB
+       |   \x{89} # NSE 
+       # SUDOC shares the cataloguing of french universities
+       |   \x{98} # SUDOC NSB 
+       |   \x{9c} # SUDOC NSE
+       )
+    //gx;
+
+    my $content_type = @_ ? shift : "text/html";
+    my $status = shift; 
+    $content_type = "text/html" unless $content_type =~ m!/!; # very basic sanity check
     print $query->header(
-        -type    => 'text/html',
+        -status  => $status,
+        -type    => $content_type,
         -charset => 'UTF-8',
         -cookie  => $cookie,
         -Pragma => 'no-cache',
@@ -348,6 +395,22 @@ sub output_html_with_http_headers ($$$) {
     ), $html;
 }
 
+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 () {
+       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)
 
 1;