X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FOutput.pm;h=80b0363133361d37d00ab733869a934c5a005e0a;hb=057fa1ac240e75e23e4f3cfc6486adb8272eb213;hp=a5393de007d78191a5edd3f04564683bfa24437e;hpb=1e647ae7163a0c8e85ebb1ff3e3ebb1afc3b024f;p=koha.git diff --git a/C4/Output.pm b/C4/Output.pm index a5393de007..80b0363133 100644 --- a/C4/Output.pm +++ b/C4/Output.pm @@ -1,428 +1,406 @@ -package C4::Output; #asummes C4/Output +package C4::Output; #package to deal with marking up output #You will need to edit parts of this pm #set the value of path to be where your html lives -use strict; -use warnings; -use C4::Database; -require Exporter; +# Copyright 2000-2002 Katipo Communications +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# 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 -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); -# set the version for version checking -$VERSION = 0.01; +# NOTE: I'm pretty sure this module is deprecated in favor of +# templates. -@ISA = qw(Exporter); -@EXPORT = qw(&startpage &endpage &mktablehdr &mktableft &mktablerow &mklink -&startmenu &endmenu &mkheadr ¢er &endcenter &mkform &mkform2 &bold -&gotopage &mkformnotable &mkform3 picktemplate); -%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], +use strict; -# your exported package globals go here, -# as well as any optionally exported functions +use C4::Context; +use C4::Languages qw(getTranslatedLanguages get_bidi regex_lang_subtags language_get_description accept_language ); -@EXPORT_OK = qw($Var1 %Hashit); +use HTML::Template::Pro; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +BEGIN { + # set the version for version checking + $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 + ); + push @EXPORT, qw( + &output_html_with_http_headers + ); +} -# non-exported package globals go here -use vars qw(@more $stuff); +=head1 NAME -# initalize package globals, first exported ones +C4::Output - Functions for managing templates -my $Var1 = ''; -my %Hashit = (); +=head1 FUNCTIONS +=over 2 -# then the others (which are still accessible as $Some::Module::stuff) -my $stuff = ''; -my @more = (); +=cut -# all file-scoped lexicals must be created before -# the functions below that use them. +#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/"; -# -# Change this value to reflect where you will store your includes -# -my %configfile; -open (KC, "/etc/koha.conf"); -while () { - chomp; - (next) if (/^\s*#/); - if (/(.*)\s*=\s*(.*)/) { - my $variable=$1; - my $value=$2; - # Clean up white space at beginning and end - $variable=~s/^\s*//g; - $variable=~s/\s*$//g; - $value=~s/^\s*//g; - $value=~s/\s*$//g; - $configfile{$variable}=$value; - } -} -my $path=$configfile{'includes'}; -($path) || ($path="/usr/local/www/hdl/htdocs/includes"); - - -# here's a file-private function as a closure, -# callable as &$priv_func; it cannot be prototyped. -my $priv_func = sub { -# stuff goes here. - }; - -# make all your functions, whether exported or not; - -sub picktemplate { - my ($includes, $base) = @_; - my $dbh=C4Connect; - my $templates; - opendir (D, "$includes/templates"); - my @dirlist=readdir D; - foreach (@dirlist) { - (next) if (/^\./); - #(next) unless (/\.tmpl$/); - (next) unless (-e "$includes/templates/$_/$base"); - $templates->{$_}=1; - } - my $sth=$dbh->prepare("select value from systempreferences where - variable='template'"); - $sth->execute; - my ($preftemplate) = $sth->fetchrow; - $sth->finish; - $dbh->disconnect; - if ($templates->{$preftemplate}) { - return $preftemplate; - } else { - return 'default'; - } - +#--------------------------------------------------------------------------------------------------------- +# FIXME - POD +sub gettemplate { + 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 ( $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/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"] + ); + 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")), + interface => ( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' ), + theme => $theme, + lang => $lang + ); + + # Bidirectionality + my $current_lang = regex_lang_subtags($lang); + my $bidi; + $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, + one_language_enabled => ($num_languages_enabled <= 1) ? 1 : 0, # deal with zero enabled langs as well + ) unless @$languages_loop<2; + + return $template; } - +#--------------------------------------------------------------------------------------------------------- +# FIXME - POD +sub themelanguage { + my ( $htdocs, $tmpl, $interface, $query ) = @_; + ($query) or warn "no query in themelanguage"; + + # Set some defaults for language and theme + # First, check the user's preferences + my $lang; + 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'); + # Fall back to English + my @languages; + if ($interface eq 'intranet') { + @languages = split ",", C4::Context->preference("language"); + } else { + @languages = split ",", C4::Context->preference("opaclanguages"); + } + if ($lang){ + @languages=($lang,@languages); + } else { + $lang = $languages[0]; + } + my $theme = 'prog'; # in the event of theme failure default to 'prog' -fbcit + my $dbh = C4::Context->dbh; + my @themes; + if ( $interface eq "intranet" ) { + @themes = split " ", 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"); + } -sub startpage{ - return("\n"); + # 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 =~ /[-_]/; + #} + } + } + return ( $theme, $lang ); } -sub gotopage{ - my ($target) = @_; - print "
goto target = $target
"; - my $string = ""; - return $string; +sub setlanguagecookie { + my ( $query, $language, $uri ) = @_; + my $cookie = $query->cookie( + -name => 'KohaOpacLanguage', + -value => $language, + -expires => '' + ); + print $query->redirect( + -uri => $uri, + -cookie => $cookie + ); } +=item pagination_bar -sub startmenu{ - # edit the paths in here - my ($type)=@_; - if ($type eq 'issue') { - open (FILE,"$path/issues-top.inc") || die; - } elsif ($type eq 'opac') { - open (FILE,"$path/opac-top.inc") || die; - } elsif ($type eq 'member') { - open (FILE,"$path/members-top.inc") || die; - } elsif ($type eq 'acquisitions'){ - open (FILE,"$path/acquisitions-top.inc")|| die; - } elsif ($type eq 'report'){ - open (FILE,"$path/reports-top.inc") || die; - } elsif ($type eq 'circulation') { - open (FILE,"$path/circulation-top.inc") || die; - } else { - open (FILE,"$path/cat-top.inc") || die; - } - my @string=; - close FILE; - my $count=@string; - # $string[$count]="
"; - return @string; -} + pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name) +Build an HTML pagination bar based on the number of page to display, the +current page and the url to give to each page link. -sub endmenu{ - my ($type)=@_; - if ($type eq 'issue'){ - open (FILE,"$path/issues-bottom.inc") || die; - } elsif ($type eq 'opac') { - open (FILE,"$path/opac-bottom.inc") || die; - } elsif ($type eq 'member') { - open (FILE,"$path/members-bottom.inc") || die; - } elsif ($type eq 'acquisitions') { - open (FILE,"$path/acquisitions-bottom.inc") || die; - } elsif ($type eq 'report') { - open (FILE,"$path/reports-bottom.inc") || die; - } elsif ($type eq 'circulation') { - open (FILE,"$path/circulation-bottom.inc") || die; - } else { - open (FILE,"$path/cat-bottom.inc") || die; - } - my @string=; - close FILE; - return @string; -} +C<$base_url> is the URL for each page link. The +C<$startfrom_name>=page_number is added at the end of the each URL. -sub mktablehdr { - return("\n"); -} +C<$nb_pages> is the total number of pages available. +C<$current_page> is the current page number. This page number won't become a +link. -sub mktablerow { - #the last item in data may be a backgroundimage - - # FIXME - # should this be a foreach (1..$cols) loop? +This function returns HTML, without any language dependency. - my ($cols,$colour,@data)=@_; - my $i=0; - my $string=""; - while ($i <$cols){ - if ($data[$cols] ne ''){ - #check for backgroundimage - $string.=""; - } else { - $string.="$data[$i]"; - } - $i++; - } - $string=$string."\n"; - return($string); -} +=cut -sub mktableft { - return("
"; - } else { - $string.=""; - } - if ($data[$i] eq "") { - $string.="  
\n"); -} +sub pagination_bar { + 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'; -sub mkform{ - my ($action,%inputs)=@_; - my $string="
\n"; - $string=$string.mktablehdr(); - my $key; - my @keys=sort keys %inputs; - - my $count=@keys; - my $i2=0; - while ( $i2<$count) { - my $value=$inputs{$keys[$i2]}; - my @data=split('\t',$value); - #my $posn = shift(@data); - if ($data[0] eq 'hidden'){ - $string=$string."\n"; - } else { - my $text; - if ($data[0] eq 'radio') { - $text="$data[1] - $data[2]"; - } - if ($data[0] eq 'text') { - $text=""; - } - if ($data[0] eq 'textarea') { - $text=""; - } - if ($data[0] eq 'select') { - $text=""; - } - $string=$string.mktablerow(2,'white',$keys[$i2],$text); - #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text); - } - $i2++; - } - #$string=$string.join("\n",@order); - $string=$string.mktablerow(2,'white','',''); - $string=$string.mktableft; - $string=$string."
"; -} + # how many pages to show before and after the current page? + my $pages_around = 2; -sub mkform3 { - my ($action, %inputs) = @_; - my $string = "
\n"; - $string .= mktablehdr(); - my $key; - my @keys = sort(keys(%inputs)); - my @order; - my $count = @keys; - my $i2 = 0; - while ($i2 < $count) { - my $value=$inputs{$keys[$i2]}; - my @data=split('\t',$value); - my $posn = $data[2]; - if ($data[0] eq 'hidden'){ - $order[$posn]="\n"; - } else { - my $text; - if ($data[0] eq 'radio') { - $text="$data[1] - $data[2]"; - } - if ($data[0] eq 'text') { - $text=""; - } - if ($data[0] eq 'textarea') { - $text=""; - } - if ($data[0] eq 'select') { - $text=""; - } -# $string=$string.mktablerow(2,'white',$keys[$i2],$text); - $order[$posn]=mktablerow(2,'white',$keys[$i2],$text); + 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"; } - $i2++; - } - my $temp=join("\n",@order); - $string=$string.$temp; - $string=$string.mktablerow(1,'white',''); - $string=$string.mktableft; - $string=$string."
"; -} + $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/\?/) ? '&' : '?' ) . $startfrom_name . '='; + my $pagination_bar = ''; + + # navigation bar useful only if more than one page to display ! + if ( $nb_pages > 1 ) { + + # link to first page? + if ( $current_page > 1 ) { + $pagination_bar .= + "\n" . ' ' + . '' + . '<<' . ''; + } + else { + $pagination_bar .= + "\n" . ' <<'; + } -sub mkformnotable{ - my ($action,@inputs)=@_; - my $string="
\n"; - my $count=@inputs; - for (my $i=0; $i<$count; $i++){ - if ($inputs[$i][0] eq 'hidden'){ - $string=$string."\n"; - } - if ($inputs[$i][0] eq 'radio') { - $string.="$inputs[$i][2]"; - } - if ($inputs[$i][0] eq 'text') { - $string.=""; - } - if ($inputs[$i][0] eq 'textarea') { - $string.=""; - } - if ($inputs[$i][0] eq 'reset'){ - $string.=""; - } - if ($inputs[$i][0] eq 'submit'){ - $string.=""; - } - } - $string=$string."
"; -} + # link on previous page ? + if ( $current_page > 1 ) { + my $previous = $current_page - 1; -sub mkform2{ - my ($action,%inputs)=@_; - my $string="
\n"; - $string=$string.mktablehdr(); - my $key; - my @order; - while ( my ($key, $value) = each %inputs) { - my @data=split('\t',$value); - my $posn = shift(@data); - my $reqd = shift(@data); - my $ltext = shift(@data); - if ($data[0] eq 'hidden'){ - $string=$string."\n"; - } else { - my $text; - if ($data[0] eq 'radio') { - $text="$data[1] - $data[2]"; - } elsif ($data[0] eq 'text') { - my $size = $data[1]; - if ($size eq "") { - $size=40; + $pagination_bar .= + "\n" . ' ' + . ''; + } + else { + $pagination_bar .= + "\n" . ' <'; } - $text=""; - } elsif ($data[0] eq 'textarea') { - my @size=split("x",$data[1]); - if ($data[1] eq "") { - $size[0] = 40; - $size[1] = 4; + + my $min_to_display = $current_page - $pages_around; + my $max_to_display = $current_page + $pages_around; + my $last_displayed_page = undef; + + for my $page_number ( 1 .. $nb_pages ) { + if ( + $page_number == 1 + or $page_number == $nb_pages + or ( $page_number >= $min_to_display + and $page_number <= $max_to_display ) + ) + { + if ( defined $last_displayed_page + and $last_displayed_page != $page_number - 1 ) + { + $pagination_bar .= + "\n" . ' ...'; + } + + if ( $page_number == $current_page ) { + $pagination_bar .= + "\n" . ' ' + . '' + . $page_number + . ''; + } + else { + $pagination_bar .= + "\n" . ' ' + . '' + . $page_number . ''; + } + $last_displayed_page = $page_number; + } + } + + # link on next page? + if ( $current_page < $nb_pages ) { + my $next = $current_page + 1; + + $pagination_bar .= "\n" + . ' '; + } + else { + $pagination_bar .= + "\n" . ' >'; + } + + # link to last page? + if ( $current_page != $nb_pages ) { + $pagination_bar .= "\n" + . ' ' + . '>>' . ''; + } + else { + $pagination_bar .= + "\n" . ' >>'; } - $text=""; - } elsif ($data[0] eq 'select') { - $text=""; - } - if ($reqd eq "R") { - $ltext = $ltext." (Req)"; - } - @order[$posn] =mktablerow(2,'white',$ltext,$text); } - } - $string=$string.join("\n",@order); - $string=$string.mktablerow(2,'white','',''); - $string=$string.mktableft; - $string=$string."
"; + + return $pagination_bar; } +=item output_html_with_http_headers -sub endpage{ - return("\n"); -} + &output_html_with_http_headers($query, $cookie, $html[, $content_type]) -sub mklink { - my ($url,$text)=@_; - my $string="$text"; - return ($string); -} +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. -sub mkheadr { - my ($type,$text)=@_; - my $string; - if ($type eq '1'){ - $string="$text
"; - } - if ($type eq '2'){ - $string="$text"; - } - if ($type eq '3'){ - $string="$text

"; - } - return ($string); -} +If the optional C<$content_type> parameter is called, set the +response's Content-Type to that value instead of "text/html". -sub center { - return ("

\n"); -} +=cut -sub endcenter { - return ("
\n"); -} +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_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 bold { - my ($text)=@_; - my $string="$text"; - return($string); +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; +__END__ +=back -END { } # module clean-up code here (global destructor) - +=head1 AUTHOR +Koha Developement team +=cut