#You will need to edit parts of this pm
#set the value of path to be where your html lives
-
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+
+# NOTE: I'm pretty sure this module is deprecated in favor of
+# templates.
+
use strict;
-require Exporter;
-use C4::Database;
-use C4::Search; #for getting the systempreferences
+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 HTML::Template::Pro;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-# set the version for version checking
-$VERSION = 0.01;
+BEGIN {
+ # 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_html_with_http_headers)],
+ ajax =>[qw(&output_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_with_http_headers FormatData FormatNumber
+ );
+}
=head1 NAME
-C4::Output - Functions for generating HTML for the Koha web interface
-
-=head1 SYNOPSIS
-
- use C4::Output;
-
- $str = &mklink("http://www.koha.org/", "Koha web page");
- print $str;
-
-=head1 DESCRIPTION
-
-The functions in this module generate HTML, and return the result as a
-printable string.
+C4::Output - Functions for managing templates
=head1 FUNCTIONS
=cut
-@ISA = qw(Exporter);
-@EXPORT = qw(&startpage &endpage
- &mktablehdr &mktableft &mktablerow &mklink
- &startmenu &endmenu &mkheadr
- ¢er &endcenter
- &mkform &mkform2 &bold
- &gotopage &mkformnotable &mkform3
- &getkeytableselectoptions
- &pathtotemplate
- &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); # FIXME - These are never used
-
-
-# non-exported package globals go here
-use vars qw(@more $stuff); # FIXME - These are never used
-
-# initalize package globals, first exported ones
-
-# FIXME - These are never used
-my $Var1 = '';
-my %Hashit = ();
-
-
-# then the others (which are still accessible as $Some::Module::stuff)
-# FIXME - These are never used
-my $stuff = '';
-my @more = ();
-
-# all file-scoped lexicals must be created before
-# the functions below that use them.
-
-#
-# Change this value to reflect where you will store your includes
-#
-# FIXME - Since this is used in several places, it ought to be put
-# into a separate file. Better yet, put "use C4::Config;" inside the
-# &import method of any package that requires the config file.
-my %configfile;
-open (KC, "/etc/koha.conf");
-while (<KC>) {
- 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;
-
-=item picktemplate
-
- $template = &picktemplate($includes, $base);
-
-Returns the preferred template for a given page. C<$base> is the
-basename of the script that will generate the page (with the C<.pl>
-extension stripped off), and C<$includes> is the directory in which
-HTML include files are located.
-
-The preferred template is given by the C<template> entry in the
-C<systempreferences> table in the Koha database. If
-C<$includes>F</templates/preferred-template/>C<$base.tmpl> exists,
-C<&picktemplate> returns the preferred template; otherwise, it returns
-the string C<default>.
-
-=cut
-#'
-sub picktemplate {
- my ($includes, $base) = @_;
- my $dbh=C4Connect;
- my $templates;
- # FIXME - Instead of generating the list of possible templates, and
- # then querying the database to see if, by chance, one of them has
- # been selected, wouldn't it be better to query the database first,
- # and then see whether the selected template file exists?
- 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 pathtotemplate {
- my %params = @_;
- my $template = $params{'template'};
- my $themeor = $params{'theme'};
- my $languageor = lc($params{'language'});
- my $ptype = lc($params{'type'} or 'intranet');
-
- my $type;
- if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
- elsif ($ptype eq 'none') {$type = ''; }
- elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
- else {$type = $ptype . '/'; }
-
- my %returns;
- my %prefs= systemprefs();
- my $theme= $prefs{'theme'} || 'default';
- if ($themeor and ($prefs{'allowthemeoverride'} =~ qr/$themeor/i )) {$theme = $themeor;}
- my @languageorder = getlanguageorder();
- my $language = $languageor || shift(@languageorder);
-
- #where to search for templates
- my @tmpldirs = ("$path/templates", $path);
- unshift (@tmpldirs, $configfile{'templatedirectory'}) if $configfile{'templatedirectory'};
- unshift (@tmpldirs, $params{'path'}) if $params{'path'};
-
- my ($edir, $etheme, $elanguage, $epath);
-
- CHECK: foreach (@tmpldirs) {
- $edir= $_;
- foreach ($theme, 'all', 'default') {
- $etheme=$_;
- foreach ($language, @languageorder, 'all','en') { # 'en' is the fallback-language
- $elanguage = $_;
- if (-e "$edir/$type$etheme/$elanguage/$template") {
- $epath = "$edir/$type$etheme/$elanguage/$template";
- last CHECK;
- }
- }
+#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');
}
- }
-
- unless ($epath) {
- warn "Could not find $template in @tmpldirs";
- return 0;
- }
-
- if ($language eq $elanguage) {
- $returns{'foundlanguage'} = 1;
- } else {
- $returns{'foundlanguage'} = 0;
- warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
- }
- if ($theme eq $etheme) {
- $returns{'foundtheme'} = 1;
- } else {
- $returns{'foundtheme'} = 0;
- warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
- }
-
- $returns{'path'} = $epath;
-
- return (%returns);
-}
+ 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 getlanguageorder () {
- my @languageorder;
- my %prefs = systemprefs();
-
- if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
- @languageorder = split (/,/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
- } elsif ($prefs{'languageorder'}) {
- @languageorder = split (/,/ ,lc($prefs{'languageorder'}));
- } else { # here should be another elsif checking for apache's languageorder
- @languageorder = ('en');
- }
-
- return (@languageorder);
+ 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 (defined $query and $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("<html>\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) = shift;
- #print "<br>goto target = $target<br>";
- my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
- return $string;
+sub setlanguagecookie {
+ my ( $query, $language, $uri ) = @_;
+ my $cookie = $query->cookie(
+ -name => 'KohaOpacLanguage',
+ -value => $language,
+ -expires => ''
+ );
+ print $query->redirect(
+ -uri => $uri,
+ -cookie => $cookie
+ );
}
+sub getlanguagecookie {
+ my ($query) = @_;
+ my $lang;
+ if ($query->cookie('KohaOpacLanguage')){
+ $lang = $query->cookie('KohaOpacLanguage') ;
+ }else{
+ $lang = $ENV{HTTP_ACCEPT_LANGUAGE};
+
+ }
+ $lang = substr($lang, 0, 2);
-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=<FILE>;
- close FILE;
- # my $count=@string;
- # $string[$count]="<BLOCKQUOTE>";
- return @string;
+ return $lang;
}
-=item endmenu
-
- @lines = &endmenu($type);
- print join("", @lines);
-
-Given a page type, or category, returns a set of lines of HTML which,
-when concatenated, generate the menu at the bottom of the web page.
-
-C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
-C<report>, C<circulation>, or something else, in which case the menu
-will be for the catalog pages.
-
+=item FormatNumber
=cut
-#'
-sub endmenu {
- my ($type) = @_;
- if ( ! defined $type ) { $type=''; }
- # FIXME - It's bad form to die in a CGI script. It's even worse form
- # to die without issuing an error message.
- 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=<FILE>;
- close FILE;
- return @string;
+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' => ','
+ );
+} else { # US by default..
+ $num = new Number::Format(
+ 'int_curr_symbol' => '',
+ 'mon_thousands_sep' => ',',
+ 'mon_decimal_point' => '.'
+ );
}
-
-sub mktablehdr() {
- return("<table border=0 cellspacing=0 cellpadding=5>\n");
+return $num;
}
+=item FormatData
-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="<tr valign=top bgcolor=$colour>";
- while ($i <$cols){
- if (defined $data[$cols]) { # if there is a background image
- $string.="<td background=\"$data[$cols]\">";
- } else { # if there's no background image
- $string.="<td>";
- }
- if (! defined $data[$i]) {$data[$i]="";}
- if ($data[$i] eq "") {
- $string.=" </td>";
- } else {
- $string.="$data[$i]</td>";
- }
- $i++;
- }
- $string=$string."</tr>\n";
- return($string);
-}
+FormatData($data_hashref)
+C<$data_hashref> is a ref to data to format
-sub mktableft() {
- return("</table>\n");
-}
+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 mkform{
- my ($action,%inputs)=@_;
- my $string="<form action=$action method=post>\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."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
- } else {
- my $text;
- if ($data[0] eq 'radio') {
- $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
- <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
- }
- if ($data[0] eq 'text') {
- $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
- }
- if ($data[0] eq 'textarea') {
- $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
- }
- if ($data[0] eq 'select') {
- $text="<select name=$keys[$i2]>";
- my $i=1;
- while ($data[$i] ne "") {
- my $val = $data[$i+1];
- $text = $text."<option value=$data[$i]>$val";
- $i = $i+2;
- }
- $text=$text."</select>";
- }
- $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','<input type=submit>','<input type=reset>');
- $string=$string.mktableft;
- $string=$string."</form>";
+sub FormatData{
+ my $data_hashref=shift;
+ $$data_hashref{$_} = format_date( $$data_hashref{$_} ) for grep{/date/} keys (%$data_hashref);
}
-sub mkform3 {
- my ($action, %inputs) = @_;
- my $string = "<form action=\"$action\" method=\"post\">\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]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
- } else {
- my $text;
- if ($data[0] eq 'radio') {
- $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
- <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
- }
- # FIXME - Is 40 the right size in all cases?
- if ($data[0] eq 'text') {
- $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
- }
- # FIXME - Is 40x4 the right size in all cases?
- if ($data[0] eq 'textarea') {
- $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
- }
- if ($data[0] eq 'select') {
- $text="<select name=$keys[$i2]>";
- my $i=1;
- while ($data[$i] ne "") {
- my $val = $data[$i+1];
- $text = $text."<option value=$data[$i]>$val";
- $i = $i+2; # FIXME - Use $i += 2.
- }
- $text=$text."</select>";
- }
-# $string=$string.mktablerow(2,'white',$keys[$i2],$text);
- $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
- }
- $i2++;
- }
- my $temp=join("\n",@order);
- # FIXME - Use ".=". That's what it's for.
- $string=$string.$temp;
- $string=$string.mktablerow(1,'white','<input type=submit>');
- $string=$string.mktableft;
- $string=$string."</form>";
- # FIXME - A return statement, while not strictly necessary, would be nice.
-}
-
-# XXX - POD
-sub mkformnotable{
- my ($action,@inputs)=@_;
- my $string="<form action=$action method=post>\n";
- my $count=@inputs;
- for (my $i=0; $i<$count; $i++){
- if ($inputs[$i][0] eq 'hidden'){
- $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
- }
- if ($inputs[$i][0] eq 'radio') {
- $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
- }
- if ($inputs[$i][0] eq 'text') {
- $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
- }
- if ($inputs[$i][0] eq 'textarea') {
- $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
- }
- if ($inputs[$i][0] eq 'reset'){
- $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
- }
- if ($inputs[$i][0] eq 'submit'){
- $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
- }
- }
- $string=$string."</form>";
-}
+=item pagination_bar
-=item mkform2
+ pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name)
- $str = &mkform2($action,
- $fieldname => "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
- ...
- );
- print $str;
+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.
-Takes a set of arguments that define an input form, generates an HTML
-string for the form, and returns the 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.
-C<$action> is the action for the form, usually the URL of the script
-that will process it.
+C<$nb_pages> is the total number of pages available.
-The remaining arguments define the fields in the form. C<$fieldname>
-is the field's name. This is for the script's benefit, and will not be
-shown to the user.
+C<$current_page> is the current page number. This page number won't become a
+link.
-C<$fieldpos> is an integer; fields will be output in order of
-increasing C<$fieldpos>. This number must be unique: if two fields
-have the same C<$fieldpos>, one will be picked at random, and the
-other will be ignored. See below for special considerations, however.
+This function returns HTML, without any language dependency.
-If C<$required> is the string C<R>, then the field is required, and
-the label will have C< (Req.)> appended.
-
-C<$label> is a string that will appear next to the input field.
-
-C<$fieldtype> specifies the type of the input field. It may be one of
-the following:
-
-=over 4
-
-=item C<hidden>
-
-Generates a hidden field, used to pass data to the script without
-showing it to the user. C<$value0> is its value.
-
-=item C<radio>
-
-Generates a pair of radio buttons, with values C<$value0> and
-C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
-the user, next to the radio button.
-
-=item C<text>
-
-Generates a one-line text input field. Its size may be specified by
-C<$value0>. The default is 40. The initial text of the field may be
-specified by C<$value1>.
-
-=item C<textarea>
+=cut
-Generates a text input area. C<$value0> may be a string of the form
-"WWWxHHH", in which case the text input area will be WWW columns wide
-and HHH rows tall. The size defaults to 40x4.
+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" . ' '
+ . '<a href="'
+ . $url
+ . '1" rel="start">'
+ . '<<' . '</a>';
+ }
+ else {
+ $pagination_bar .=
+ "\n" . ' <span class="inactive"><<</span>';
+ }
-The initial text (which, of course, may not contain any tabs) may be
-specified by C<$value1>.
+ # link on previous page ?
+ if ( $current_page > 1 ) {
+ my $previous = $current_page - 1;
-=item C<select>
+ $pagination_bar .=
+ "\n" . ' '
+ . '<a href="'
+ . $url
+ . $previous
+ . '" rel="prev">' . '<' . '</a>';
+ }
+ else {
+ $pagination_bar .=
+ "\n" . ' <span class="inactive"><</span>';
+ }
-Generates a list of items, from which the user may choose one. Here,
-C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
-pair, the key specifies an internal label for a choice, and the value
-specifies the description of the choice that will be shown the user.
+ 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" . ' <span class="inactive">...</span>';
+ }
+
+ if ( $page_number == $current_page ) {
+ $pagination_bar .=
+ "\n" . ' '
+ . '<span class="currentPage">'
+ . $page_number
+ . '</span>';
+ }
+ else {
+ $pagination_bar .=
+ "\n" . ' '
+ . '<a href="'
+ . $url
+ . $page_number . '">'
+ . $page_number . '</a>';
+ }
+ $last_displayed_page = $page_number;
+ }
+ }
-If C<$value0> is the same as one of the keys that follows, then the
-corresponding choice will initially be selected.
+ # link on next page?
+ if ( $current_page < $nb_pages ) {
+ my $next = $current_page + 1;
-=back
+ $pagination_bar .= "\n"
+ . ' <a href="'
+ . $url
+ . $next
+ . '" rel="next">' . '>' . '</a>';
+ }
+ else {
+ $pagination_bar .=
+ "\n" . ' <span class="inactive">></span>';
+ }
-=cut
-#'
-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="<form action=$action method=post>\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."<input type=hidden name=$key value=\"$data[1]\">\n";
- } else {
- my $text;
- if ($data[0] eq 'radio') {
- $text="<input type=radio name=$key value=$data[1]>$data[1]
- <input type=radio name=$key value=$data[2]>$data[2]";
- } elsif ($data[0] eq 'text') {
- my $size = $data[1];
- if ($size eq "") {
- $size=40;
+ # link to last page?
+ if ( $current_page != $nb_pages ) {
+ $pagination_bar .= "\n"
+ . ' <a href="'
+ . $url
+ . $nb_pages
+ . '" rel="last">'
+ . '>>' . '</a>';
}
- $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
- } elsif ($data[0] eq 'textarea') {
- my @size=split("x",$data[1]);
- if ($data[1] eq "") {
- $size[0] = 40;
- $size[1] = 4;
+ else {
+ $pagination_bar .=
+ "\n" . ' <span class="inactive">>></span>';
}
- $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
- } elsif ($data[0] eq 'select') {
- $text="<select name=$key>";
- my $sel=$data[1];
- my $i=2;
- while ($data[$i] ne "") {
- my $val = $data[$i+1];
- $text = $text."<option value=\"$data[$i]\"";
- if ($data[$i] eq $sel) {
- $text = $text." selected";
- }
- $text = $text.">$val";
- $i = $i+2;
- }
- $text=$text."</select>";
- }
- if ($reqd eq "R") {
- $ltext = $ltext." (Req)";
- }
- $order[$posn] =mktablerow(2,'white',$ltext,$text);
}
- }
- $string=$string.join("\n",@order);
- $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
- $string=$string.mktableft;
- $string=$string."</form>";
-}
-
-=pod
-=head2 &endpage
-
- &endpage does not expect any arguments, it returns the string:
- </body></html>\n
-
-=cut
-
-sub endpage() {
- return("</body></html>\n");
+ return $pagination_bar;
}
-=pod
-
-=head2 &mklink
-
- &mklink expects two arguments, the url to link to and the text of the link.
- It returns this string:
- <a href="$url">$text</a>
- where $url is the first argument and $text is the second.
-
-=cut
-
-sub mklink($$) {
- my ($url,$text)=@_;
- my $string="<a href=\"$url\">$text</a>";
- return ($string);
-}
+=item output_with_http_headers
-=pod
+ &output_with_http_headers($query, $cookie, $data, $content_type[, $status])
-=head2 &mkheadr
+Outputs $data with the appropriate HTTP headers,
+the authentication cookie $cookie and a Content-Type specified in
+$content_type.
- &mkeadr expects two strings, a type and the text to use in the header.
- types are:
+If applicable, $cookie can be undef, and it will not be sent.
-=over
+$content_type is one of the following: 'html', 'js', 'json', 'xml', 'rss', or 'atom'.
-=item 1 ends with <br>
-
-=item 2 no special ending tag
-
-=item 3 ends with <p>
-
-=back
-
- Other than this, the return value is the same:
- <FONT SIZE=6><em>$text</em></FONT>$string
- Where $test is the text passed in and $string is the tag generated from
- the type value.
+$status is an HTTP status message, like '403 Authentication Required'. It defaults to '200 OK'.
=cut
-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="<FONT SIZE=6><em>$text</em></FONT><br>";
- }
- if ($type eq '2'){
- $string="<FONT SIZE=6><em>$text</em></FONT><br>";
- }
- if ($type eq '3'){
- $string="<FONT SIZE=6><em>$text</em></FONT><p>";
- }
- return ($string);
+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';
+ }
+ # remove SUDOC specific NSB NSE
+ $data =~ s/\x{C2}\x{98}|\x{C2}\x{9C}/ /g;
+ $data =~ s/\x{C2}\x{88}|\x{C2}\x{89}/ /g;
+ print $query->header($options), $data;
}
-=pod
-
-=head2 ¢er and &endcenter
-
- ¢er and &endcenter take no arguments and return html tags <CENTER> and
- </CENTER> respectivley.
-
-=cut
-
-sub center() {
- return ("<CENTER>\n");
-}
-
-sub endcenter() {
- return ("</CENTER>\n");
-}
-
-=pod
-
-=head2 &bold
-
- &bold requires that a single string be passed in by the caller. &bold
- will return "<b>$text</b>" where $text is the string passed in.
-
-=cut
+sub output_html_with_http_headers ($$$) {
+ my ( $query, $cookie, $data ) = @_;
+ output_with_http_headers( $query, $cookie, $data, 'html' );
+}
-sub bold($) {
- my ($text)=shift;
- return("<b>$text</b>");
+sub is_ajax () {
+ my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
+ return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ? 1 : 0;
}
-#---------------------------------------------
-# Create an HTML option list for a <SELECT> form tag by using
-# values from a DB file
-sub getkeytableselectoptions {
- use strict;
- # inputs
- my (
- $dbh, # DBI handle
- $tablename, # name of table containing list of choices
- $keyfieldname, # column name of code to use in option list
- $descfieldname, # column name of descriptive field
- $showkey, # flag to show key in description
- $default, # optional default key
- )=@_;
- my $selectclause; # return value
-
- my (
- $sth, $query,
- $key, $desc, $orderfieldname,
- );
- my $debug=0;
-
- requireDBI($dbh,"getkeytableselectoptions");
-
- if ( $showkey ) {
- $orderfieldname=$keyfieldname;
- } else {
- $orderfieldname=$descfieldname;
- }
- $query= "select $keyfieldname,$descfieldname
- from $tablename
- order by $orderfieldname ";
- print "<PRE>Query=$query </PRE>\n" if $debug;
- $sth=$dbh->prepare($query);
- $sth->execute;
- while ( ($key, $desc) = $sth->fetchrow) {
- if ($showkey || ! $desc ) { $desc="$key - $desc"; }
- $selectclause.="<option";
- if (defined $default && $default eq $key) {
- $selectclause.=" selected";
- }
- $selectclause.=" value='$key'>$desc\n";
- print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
- }
- return $selectclause;
-} # sub getkeytableselectoptions
-
-#---------------------------------
-
-END { } # module clean-up code here (global destructor)
+END { } # module clean-up code here (global destructor)
1;
__END__
+
=back
-=head1 SEE ALSO
+=head1 AUTHOR
-L<DBI(3)|DBI>
+Koha Developement team <info@koha.org>
=cut