X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FOutput.pm;h=80b0363133361d37d00ab733869a934c5a005e0a;hb=1aede39173841aa4f99e11266216894419bef388;hp=104aead777791bb9c85e141341258d068af04e19;hpb=e30b2ea9684d885cbb7b2aadf5448f9c334657d3;p=koha.git diff --git a/C4/Output.pm b/C4/Output.pm index 104aead777..80b0363133 100644 --- a/C4/Output.pm +++ b/C4/Output.pm @@ -4,540 +4,403 @@ package C4::Output; #You will need to edit parts of this pm #set the value of path to be where your html lives -use strict; -require Exporter; - -use C4::Database; - -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - -# set the version for version checking -$VERSION = 0.01; - -@ISA = qw(Exporter); -@EXPORT = qw(&startpage &endpage - &mktablehdr &mktableft &mktablerow &mklink - &startmenu &endmenu &mkheadr - ¢er &endcenter - &mkform &mkform2 &bold - &gotopage &mkformnotable &mkform3 - &getkeytableselectoptions - &picktemplate); -%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], - -# your exported package globals go here, -# as well as any optionally exported functions - -@EXPORT_OK = qw($Var1 %Hashit); - - -# non-exported package globals go here -use vars qw(@more $stuff); - -# initalize package globals, first exported ones +# 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 -my $Var1 = ''; -my %Hashit = (); +# NOTE: I'm pretty sure this module is deprecated in favor of +# templates. -# then the others (which are still accessible as $Some::Module::stuff) -my $stuff = ''; -my @more = (); +use strict; -# all file-scoped lexicals must be created before -# the functions below that use them. +use C4::Context; +use C4::Languages qw(getTranslatedLanguages get_bidi regex_lang_subtags language_get_description accept_language ); -# -# 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; - - $variable =~ s/^\s*//g; - $variable =~ s/\s*$//g; - $value =~ s/^\s*//g; - $value =~ s/\s*$//g; - $configfile{$variable}=$value; - } # if -} # while -close(KC); - -my $path=$configfile{'includes'}; -($path) || ($path="/usr/local/www/hdl/htdocs/includes"); - -# 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'; - } - -} - -sub startpage() { - return("\n"); -} +use HTML::Template::Pro; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); -sub gotopage($) { - my ($target) = shift; - #print "
goto target = $target
"; - my $string = ""; - return $string; +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 + ); } +=head1 NAME -sub startmenu($) { - # edit the paths in here - my ($type)=shift; - 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; -} +C4::Output - Functions for managing templates +=head1 FUNCTIONS -sub endmenu { - my ($type) = @_; - if ( ! defined $type ) { $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; -} - -sub mktablehdr() { - return("\n"); -} +=over 2 +=cut -sub mktablerow { - #the last item in data may be a backgroundimage - - # FIXME - # should this be a foreach (1..$cols) loop? - - my ($cols,$colour,@data)=@_; - my $i=0; - my $string=""; - while ($i <$cols){ - if (defined $data[$cols]) { # if there is a background image - $string.=""; - } else { - $string.="$data[$i]"; - } - $i++; - } - $string=$string."\n"; - return($string); -} +#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 ) = @_; + ($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; -sub mktableft() { - return("
"; - } else { # if there's no background image - $string.=""; - } - if ($data[$i] eq "") { - $string.="  
\n"); + return $template; } -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"; +#--------------------------------------------------------------------------------------------------------- +# 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 { - 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); + @languages = split ",", C4::Context->preference("opaclanguages"); } - $i2++; - } - #$string=$string.join("\n",@order); - $string=$string.mktablerow(2,'white','',''); - $string=$string.mktableft; - $string=$string."
"; -} - -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"; + if ($lang){ + @languages=($lang,@languages); } 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++; - } - my $temp=join("\n",@order); - $string=$string.$temp; - $string=$string.mktablerow(1,'white',''); - $string=$string.mktableft; - $string=$string."
"; -} - -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.=""; + $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"); } - if ($inputs[$i][0] eq 'textarea') { - $string.=""; + 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"); } - if ($inputs[$i][0] eq 'reset'){ - $string.=""; - } - if ($inputs[$i][0] eq 'submit'){ - $string.=""; - } - } - $string=$string."
"; -} -sub mkform2{ - # FIXME - # no POD and no tests yet. Once tests are written, - # this function can be cleaned up with the following steps: - # turn the while loop into a foreach loop - # pull the nested if,elsif structure back up to the main level - # pull the code for the different kinds of inputs into separate - # functions - 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; - } - $text=""; - } elsif ($data[0] eq 'textarea') { - my @size=split("x",$data[1]); - if ($data[1] eq "") { - $size[0] = 40; - $size[1] = 4; + # 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 =~ /[-_]/; + #} } - $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 ( $theme, $lang ); } -=pod - -=head2 &endpage - - &endpage does not expect any arguments, it returns the string: - \n - -=cut - -sub endpage() { - return("\n"); +sub setlanguagecookie { + my ( $query, $language, $uri ) = @_; + my $cookie = $query->cookie( + -name => 'KohaOpacLanguage', + -value => $language, + -expires => '' + ); + print $query->redirect( + -uri => $uri, + -cookie => $cookie + ); } -=pod +=item pagination_bar -=head2 &mklink + pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name) - &mklink expects two arguments, the url to link to and the text of the link. - It returns this string: - $text - where $url is the first argument and $text is the second. +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. -=cut +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 mklink($$) { - my ($url,$text)=@_; - my $string="$text"; - return ($string); -} +C<$nb_pages> is the total number of pages available. -=pod +C<$current_page> is the current page number. This page number won't become a +link. -=head2 &mkheadr +This function returns HTML, without any language dependency. - &mkeadr expects two strings, a type and the text to use in the header. - types are: +=cut -=over +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'; + + # how many pages to show before and after the current page? + my $pages_around = 2; + + 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/\?/) ? '&' : '?' ) . $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" . ' <<'; + } -=item 1 ends with
+ # link on previous page ? + if ( $current_page > 1 ) { + my $previous = $current_page - 1; -=item 2 no special ending tag + $pagination_bar .= + "\n" . ' ' + . ''; + } + else { + $pagination_bar .= + "\n" . ' <'; + } -=item 3 ends with

+ 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; + } + } -=back + # link on next page? + if ( $current_page < $nb_pages ) { + my $next = $current_page + 1; - Other than this, the return value is the same: - $text$string - Where $test is the text passed in and $string is the tag generated from - the type value. + $pagination_bar .= "\n" + . ' '; + } + else { + $pagination_bar .= + "\n" . ' >'; + } -=cut + # link to last page? + if ( $current_page != $nb_pages ) { + $pagination_bar .= "\n" + . ' ' + . '>>' . ''; + } + else { + $pagination_bar .= + "\n" . ' >>'; + } + } -sub mkheadr { - # FIXME - # would it be better to make this more generic by accepting an optional - # argument with a closing tag instead of a numeric type? - - 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); + return $pagination_bar; } -=pod +=item output_html_with_http_headers -=head2 ¢er and &endcenter + &output_html_with_http_headers($query, $cookie, $html[, $content_type]) - ¢er and &endcenter take no arguments and return html tags

and -
respectivley. +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. -=cut +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; +} -=pod +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; +} -=head2 &bold +sub is_ajax () { + my $x_req = $ENV{HTTP_X_REQUESTED_WITH}; + return ($x_req and $x_req =~ /XMLHttpRequest/i) ? 1 : 0; +} - &bold requires that a single string be passed in by the caller. &bold - will return "$text" where $text is the string passed in. +END { } # module clean-up code here (global destructor) -=cut +1; +__END__ -sub bold($) { - my ($text)=shift; - return("$text"); -} +=back -#--------------------------------------------- -# Create an HTML option list for a