# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id$
+
use strict;
require Exporter;
use C4::Context;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
$date = slashifyDate("01-01-2002")
- $ethnicity = fixEthnicity('asian');
- ($categories, $labels) = borrowercategories();
- ($categories, $labels) = ethnicitycategories();
=head1 DESCRIPTION
=cut
@ISA = qw(Exporter);
-@EXPORT = qw(&slashifyDate
- &fixEthnicity
- &borrowercategories
- ðnicitycategories
- &subfield_is_koha_internal_p
- &getbranches &getprinters
- &getbranch &getprinter
- $DEBUG);
+@EXPORT = qw(
+ &subfield_is_koha_internal_p
+ &getbranches &getbranch &getbranchdetail
+ &getprinters &getprinter
+ &getitemtypes &getitemtypeinfo
+ get_itemtypeinfos_of
+ &getframeworks &getframeworkinfo
+ &getauthtypes &getauthtype
+ &getallthemes &getalllanguages
+ &getallbranches &getletters
+ &getbranchname
+ getnbpages
+ getitemtypeimagedir
+ getitemtypeimagesrc
+ getitemtypeimagesrcfromurl
+ &getcities
+ &getroadtypes
+ get_branchinfos_of
+ get_notforloan_label_of
+ get_infos_of
+ $DEBUG);
use vars qw();
my $DEBUG = 0;
-=item slashifyDate
+# FIXME.. this should be moved to a MARC-specific module
+sub subfield_is_koha_internal_p ($) {
+ my($subfield) = @_;
- $slash_date = &slashifyDate($dash_date);
+ # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
+ # But real MARC subfields are always single-character
+ # so it really is safer just to check the length
-Takes a string of the form "DD-MM-YYYY" (or anything separated by
-dashes), converts it to the form "YYYY/MM/DD", and returns the result.
+ return length $subfield != 1;
+}
+
+=head2 getbranches
+
+ $branches = &getbranches();
+ returns informations about branches.
+ Create a branch selector with the following code
+ Is branchIndependant sensitive
+ When IndependantBranches is set AND user is not superlibrarian, displays only user's branch
+
+=head3 in PERL SCRIPT
+
+my $branches = getbranches;
+my @branchloop;
+foreach my $thisbranch (sort keys %$branches) {
+ my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisbranch,
+ selected => $selected,
+ branchname => $branches->{$thisbranch}->{'branchname'},
+ );
+ push @branchloop, \%row;
+}
+
+
+=head3 in TEMPLATE
+ <select name="branch">
+ <option value="">Default</option>
+ <!-- TMPL_LOOP name="branchloop" -->
+ <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
+ <!-- /TMPL_LOOP -->
+ </select>
=cut
-sub slashifyDate {
- # accepts a date of the form xx-xx-xx[xx] and returns it in the
- # form xx/xx/xx[xx]
- my @dateOut = split('-', shift);
- return("$dateOut[2]/$dateOut[1]/$dateOut[0]")
+sub getbranches {
+# returns a reference to a hash of references to branches...
+ my %branches;
+ my $dbh = C4::Context->dbh;
+ my $sth;
+ if (C4::Context->preference("IndependantBranches") && (C4::Context->userenv->{flags}!=1)){
+ my $strsth ="Select * from branches ";
+ $strsth.= " WHERE branchcode = ".$dbh->quote(C4::Context->userenv->{branch});
+ $strsth.= " order by branchname";
+ $sth=$dbh->prepare($strsth);
+ } else {
+ $sth = $dbh->prepare("Select * from branches order by branchname");
+ }
+ $sth->execute;
+ while (my $branch=$sth->fetchrow_hashref) {
+ my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
+ $nsth->execute($branch->{'branchcode'});
+ while (my ($cat) = $nsth->fetchrow_array) {
+ # FIXME - This seems wrong. It ought to be
+ # $branch->{categorycodes}{$cat} = 1;
+ # otherwise, there's a namespace collision if there's a
+ # category with the same name as a field in the 'branches'
+ # table (i.e., don't create a category called "issuing").
+ # In addition, the current structure doesn't really allow
+ # you to list the categories that a branch belongs to:
+ # you'd have to list keys %$branch, and remove those keys
+ # that aren't fields in the "branches" table.
+ $branch->{$cat} = 1;
+ }
+ $branches{$branch->{'branchcode'}}=$branch;
+ }
+ return (\%branches);
+}
+
+sub getbranchname {
+ my ($branchcode)=@_;
+ my $dbh = C4::Context->dbh;
+ my $sth;
+ $sth = $dbh->prepare("Select branchname from branches where branchcode=?");
+ $sth->execute($branchcode);
+ my $branchname = $sth->fetchrow_array;
+ $sth->finish;
+
+ return($branchname);
}
-=item fixEthnicity
+=head2 getallbranches
+
+ $branches = &getallbranches();
+ returns informations about ALL branches.
+ Create a branch selector with the following code
+ IndependantBranches Insensitive...
+
+=head3 in PERL SCRIPT
+
+my $branches = getallbranches;
+my @branchloop;
+foreach my $thisbranch (keys %$branches) {
+ my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisbranch,
+ selected => $selected,
+ branchname => $branches->{$thisbranch}->{'branchname'},
+ );
+ push @branchloop, \%row;
+}
- $ethn_name = &fixEthnicity($ethn_code);
-Takes an ethnicity code (e.g., "european" or "pi") and returns the
-corresponding descriptive name from the C<ethnicity> table in the
-Koha database ("European" or "Pacific Islander").
+=head3 in TEMPLATE
+ <select name="branch">
+ <option value="">Default</option>
+ <!-- TMPL_LOOP name="branchloop" -->
+ <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
+ <!-- /TMPL_LOOP -->
+ </select>
=cut
-#'
-sub fixEthnicity($) {
- my $ethnicity = shift;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select name from ethnicity where code = ?");
- $sth->execute($ethnicity);
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- return $data->{'name'};
+sub getallbranches {
+# returns a reference to a hash of references to ALL branches...
+ my %branches;
+ my $dbh = C4::Context->dbh;
+ my $sth;
+ $sth = $dbh->prepare("Select * from branches order by branchname");
+ $sth->execute;
+ while (my $branch=$sth->fetchrow_hashref) {
+ my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
+ $nsth->execute($branch->{'branchcode'});
+ while (my ($cat) = $nsth->fetchrow_array) {
+ # FIXME - This seems wrong. It ought to be
+ # $branch->{categorycodes}{$cat} = 1;
+ # otherwise, there's a namespace collision if there's a
+ # category with the same name as a field in the 'branches'
+ # table (i.e., don't create a category called "issuing").
+ # In addition, the current structure doesn't really allow
+ # you to list the categories that a branch belongs to:
+ # you'd have to list keys %$branch, and remove those keys
+ # that aren't fields in the "branches" table.
+ $branch->{$cat} = 1;
+ }
+ $branches{$branch->{'branchcode'}}=$branch;
+ }
+ return (\%branches);
}
-=item borrowercategories
+=head2 getletters
+
+ $letters = &getletters($category);
+ returns informations about letters.
+ if needed, $category filters for letters given category
+ Create a letter selector with the following code
+
+=head3 in PERL SCRIPT
+
+my $letters = getletters($cat);
+my @letterloop;
+foreach my $thisletter (keys %$letters) {
+ my $selected = 1 if $thisletter eq $letter;
+ my %row =(value => $thisletter,
+ selected => $selected,
+ lettername => $letters->{$thisletter},
+ );
+ push @letterloop, \%row;
+}
- ($codes_arrayref, $labels_hashref) = &borrowercategories();
-Looks up the different types of borrowers in the database. Returns two
-elements: a reference-to-array, which lists the borrower category
-codes, and a reference-to-hash, which maps the borrower category codes
-to category descriptions.
+=head3 in TEMPLATE
+ <select name="letter">
+ <option value="">Default</option>
+ <!-- TMPL_LOOP name="letterloop" -->
+ <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
+ <!-- /TMPL_LOOP -->
+ </select>
=cut
-#'
-sub borrowercategories {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
- $sth->execute;
- my %labels;
- my @codes;
- while (my $data=$sth->fetchrow_hashref){
- push @codes,$data->{'categorycode'};
- $labels{$data->{'categorycode'}}=$data->{'description'};
- }
- $sth->finish;
- return(\@codes,\%labels);
+sub getletters {
+# returns a reference to a hash of references to ALL letters...
+ my $cat =@_;
+ my %letters;
+ my $dbh = C4::Context->dbh;
+ my $sth;
+ if ($cat ne ""){
+ $sth = $dbh->prepare("Select * from letter where module = \'".$cat."\' order by name");
+ } else {
+ $sth = $dbh->prepare("Select * from letter order by name");
+ }
+ $sth->execute;
+ my $count;
+ while (my $letter=$sth->fetchrow_hashref) {
+ $letters{$letter->{'code'}}=$letter->{'name'};
+ $count++;
+ }
+ return ($count,\%letters);
}
-=item ethnicitycategories
+=head2 getitemtypes
+
+ $itemtypes = &getitemtypes();
+
+Returns information about existing itemtypes.
- ($codes_arrayref, $labels_hashref) = ðnicitycategories();
+build a HTML select with the following code :
+
+=head3 in PERL SCRIPT
+
+my $itemtypes = getitemtypes;
+my @itemtypesloop;
+foreach my $thisitemtype (sort keys %$itemtypes) {
+ my $selected = 1 if $thisitemtype eq $itemtype;
+ my %row =(value => $thisitemtype,
+ selected => $selected,
+ description => $itemtypes->{$thisitemtype}->{'description'},
+ );
+ push @itemtypesloop, \%row;
+}
+$template->param(itemtypeloop => \@itemtypesloop);
+
+=head3 in TEMPLATE
+
+<form action='<!-- TMPL_VAR name="script_name" -->' method=post>
+ <select name="itemtype">
+ <option value="">Default</option>
+ <!-- TMPL_LOOP name="itemtypeloop" -->
+ <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
+ <!-- /TMPL_LOOP -->
+ </select>
+ <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
+ <input type="submit" value="OK" class="button">
+</form>
-Looks up the different ethnic types in the database. Returns two
-elements: a reference-to-array, which lists the ethnicity codes, and a
-reference-to-hash, which maps the ethnicity codes to ethnicity
-descriptions.
=cut
-#'
-sub ethnicitycategories {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select code,name from ethnicity order by name");
- $sth->execute;
- my %labels;
- my @codes;
- while (my $data=$sth->fetchrow_hashref){
- push @codes,$data->{'code'};
- $labels{$data->{'code'}}=$data->{'name'};
- }
- $sth->finish;
- return(\@codes,\%labels);
+sub getitemtypes {
+# returns a reference to a hash of references to branches...
+ my %itemtypes;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("select * from itemtypes");
+ $sth->execute;
+ while (my $IT=$sth->fetchrow_hashref) {
+ $itemtypes{$IT->{'itemtype'}}=$IT;
+ }
+ return (\%itemtypes);
}
-# FIXME.. this should be moved to a MARC-specific module
-sub subfield_is_koha_internal_p ($) {
- my($subfield) = @_;
+# FIXME this function is better and should replace getitemtypes everywhere
+sub get_itemtypeinfos_of {
+ my @itemtypes = @_;
- # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
- # But real MARC subfields are always single-character
- # so it really is safer just to check the length
+ my $query = '
+SELECT itemtype,
+ description,
+ notforloan
+ FROM itemtypes
+ WHERE itemtype IN ('.join(',', map({"'".$_."'"} @itemtypes)).')
+';
- return length $subfield != 1;
+ return get_infos_of($query, 'itemtype');
}
-=item getbranches
+=head2 getauthtypes
- $branches = &getbranches();
- @branch_codes = keys %$branches;
- %main_branch_info = %{$branches->{"MAIN"}};
+ $authtypes = &getauthtypes();
+
+Returns information about existing authtypes.
-Returns information about existing library branches.
+build a HTML select with the following code :
-C<$branches> is a reference-to-hash. Its keys are the branch codes for
-all of the existing library branches, and its values are
-references-to-hash describing that particular branch.
+=head3 in PERL SCRIPT
+
+my $authtypes = getauthtypes;
+my @authtypesloop;
+foreach my $thisauthtype (keys %$authtypes) {
+ my $selected = 1 if $thisauthtype eq $authtype;
+ my %row =(value => $thisauthtype,
+ selected => $selected,
+ authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
+ );
+ push @authtypesloop, \%row;
+}
+$template->param(itemtypeloop => \@itemtypesloop);
+
+=head3 in TEMPLATE
+
+<form action='<!-- TMPL_VAR name="script_name" -->' method=post>
+ <select name="authtype">
+ <!-- TMPL_LOOP name="authtypeloop" -->
+ <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
+ <!-- /TMPL_LOOP -->
+ </select>
+ <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
+ <input type="submit" value="OK" class="button">
+</form>
-In each branch description (C<%main_branch_info>, above), there is a
-key for each field in the branches table of the Koha database. In
-addition, there is a key for each branch category code to which the
-branch belongs (the category codes are taken from the branchrelations
-table).
=cut
-sub getbranches {
+sub getauthtypes {
+# returns a reference to a hash of references to authtypes...
+ my %authtypes;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("select * from auth_types order by authtypetext");
+ $sth->execute;
+ while (my $IT=$sth->fetchrow_hashref) {
+ $authtypes{$IT->{'authtypecode'}}=$IT;
+ }
+ return (\%authtypes);
+}
+
+sub getauthtype {
+ my ($authtypecode) = @_;
+# returns a reference to a hash of references to authtypes...
+ my %authtypes;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
+ $sth->execute($authtypecode);
+ my $res=$sth->fetchrow_hashref;
+ return $res;
+}
+
+=head2 getframework
+
+ $frameworks = &getframework();
+
+Returns information about existing frameworks
+
+build a HTML select with the following code :
+
+=head3 in PERL SCRIPT
+
+my $frameworks = frameworks();
+my @frameworkloop;
+foreach my $thisframework (keys %$frameworks) {
+ my $selected = 1 if $thisframework eq $frameworkcode;
+ my %row =(value => $thisframework,
+ selected => $selected,
+ description => $frameworks->{$thisframework}->{'frameworktext'},
+ );
+ push @frameworksloop, \%row;
+}
+$template->param(frameworkloop => \@frameworksloop);
+
+=head3 in TEMPLATE
+
+<form action='<!-- TMPL_VAR name="script_name" -->' method=post>
+ <select name="frameworkcode">
+ <option value="">Default</option>
+ <!-- TMPL_LOOP name="frameworkloop" -->
+ <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
+ <!-- /TMPL_LOOP -->
+ </select>
+ <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
+ <input type="submit" value="OK" class="button">
+</form>
+
+
+=cut
+
+sub getframeworks {
# returns a reference to a hash of references to branches...
- my %branches;
+ my %itemtypes;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from branches");
+ my $sth=$dbh->prepare("select * from biblio_framework");
$sth->execute;
- while (my $branch=$sth->fetchrow_hashref) {
- my $query = "select categorycode from branchrelations where branchcode = ?";
- my $nsth = $dbh->prepare($query);
- $nsth->execute($branch->{'branchcode'});
- while (my ($cat) = $nsth->fetchrow_array) {
- warn "XX";
- # FIXME - This seems wrong. It ought to be
- # $branch->{categorycodes}{$cat} = 1;
- # otherwise, there's a namespace collision if there's a
- # category with the same name as a field in the 'branches'
- # table (i.e., don't create a category called "issuing").
- # In addition, the current structure doesn't really allow
- # you to list the categories that a branch belongs to:
- # you'd have to list keys %$branch, and remove those keys
- # that aren't fields in the "branches" table.
- $branch->{$cat} = 1;
- }
- $branches{$branch->{'branchcode'}}=$branch;
+ while (my $IT=$sth->fetchrow_hashref) {
+ $itemtypes{$IT->{'frameworkcode'}}=$IT;
}
- return (\%branches);
+ return (\%itemtypes);
+}
+=head2 getframeworkinfo
+
+ $frameworkinfo = &getframeworkinfo($frameworkcode);
+
+Returns information about an frameworkcode.
+
+=cut
+
+sub getframeworkinfo {
+ my ($frameworkcode) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("select * from biblio_framework where frameworkcode=?");
+ $sth->execute($frameworkcode);
+ my $res = $sth->fetchrow_hashref;
+ return $res;
+}
+
+
+=head2 getitemtypeinfo
+
+ $itemtype = &getitemtype($itemtype);
+
+Returns information about an itemtype.
+
+=cut
+
+sub getitemtypeinfo {
+ my ($itemtype) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
+ $sth->execute($itemtype);
+ my $res = $sth->fetchrow_hashref;
+
+ $res->{imageurl} = getitemtypeimagesrcfromurl($res->{imageurl});
+
+ return $res;
+}
+
+sub getitemtypeimagesrcfromurl {
+ my ($imageurl) = @_;
+
+ if (defined $imageurl and $imageurl !~ m/^http/) {
+ $imageurl =
+ getitemtypeimagesrc()
+ .'/'.$imageurl
+ ;
+ }
+
+ return $imageurl;
+}
+
+sub getitemtypeimagedir {
+ return
+ C4::Context->intrahtdocs
+ .'/'.C4::Context->preference('template')
+ .'/itemtypeimg'
+ ;
}
-=item getprinters
+sub getitemtypeimagesrc {
+ return
+ '/intranet-tmpl'
+ .'/'.C4::Context->preference('template')
+ .'/itemtypeimg'
+ ;
+}
+
+=head2 getprinters
$printers = &getprinters($env);
@queues = keys %$printers;
}
return (\%printers);
}
+
sub getbranch ($$) {
my($query, $branches) = @_; # get branch for this query from branches
my $branch = $query->param('branch');
return $branch;
}
+=item getbranchdetail
+
+ $branchname = &getbranchdetail($branchcode);
+
+Given the branch code, the function returns the corresponding
+branch name for a comprehensive information display
+
+=cut
+
+sub getbranchdetail
+{
+ my ($branchcode) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
+ $sth->execute($branchcode);
+ my $branchname = $sth->fetchrow_hashref();
+ $sth->finish();
+ return $branchname;
+} # sub getbranchname
+
+
sub getprinter ($$) {
my($query, $printers) = @_; # get printer for this query from printers
my $printer = $query->param('printer');
- ($printer) || ($printer = $query->cookie('printer'));
+ ($printer) || ($printer = $query->cookie('printer')) || ($printer='');
($printers->{$printer}) || ($printer = (keys %$printers)[0]);
return $printer;
}
+=item getalllanguages
+
+ (@languages) = &getalllanguages($type);
+ (@languages) = &getalllanguages($type,$theme);
+
+Returns an array of all available languages.
+
+=cut
+
+sub getalllanguages {
+ my $type=shift;
+ my $theme=shift;
+ my $htdocs;
+ my @languages;
+ if ($type eq 'opac') {
+ $htdocs=C4::Context->config('opachtdocs');
+ if ($theme and -d "$htdocs/$theme") {
+ opendir D, "$htdocs/$theme";
+ foreach my $language (readdir D) {
+ next if $language=~/^\./;
+ next if $language eq 'all';
+ next if $language=~ /png$/;
+ next if $language=~ /css$/;
+ next if $language=~ /CVS$/;
+ next if $language=~ /itemtypeimg$/;
+ push @languages, $language;
+ }
+ return sort @languages;
+ } else {
+ my $lang;
+ foreach my $theme (getallthemes('opac')) {
+ opendir D, "$htdocs/$theme";
+ foreach my $language (readdir D) {
+ next if $language=~/^\./;
+ next if $language eq 'all';
+ next if $language=~ /png$/;
+ next if $language=~ /css$/;
+ next if $language=~ /CVS$/;
+ next if $language=~ /itemtypeimg$/;
+ $lang->{$language}=1;
+ }
+ }
+ @languages=keys %$lang;
+ return sort @languages;
+ }
+ } elsif ($type eq 'intranet') {
+ $htdocs=C4::Context->config('intrahtdocs');
+ if ($theme and -d "$htdocs/$theme") {
+ opendir D, "$htdocs/$theme";
+ foreach my $language (readdir D) {
+ next if $language=~/^\./;
+ next if $language eq 'all';
+ next if $language=~ /png$/;
+ next if $language=~ /css$/;
+ next if $language=~ /CVS$/;
+ next if $language=~ /itemtypeimg$/;
+ push @languages, $language;
+ }
+ return sort @languages;
+ } else {
+ my $lang;
+ foreach my $theme (getallthemes('opac')) {
+ opendir D, "$htdocs/$theme";
+ foreach my $language (readdir D) {
+ next if $language=~/^\./;
+ next if $language eq 'all';
+ next if $language=~ /png$/;
+ next if $language=~ /css$/;
+ next if $language=~ /CVS$/;
+ next if $language=~ /itemtypeimg$/;
+ $lang->{$language}=1;
+ }
+ }
+ @languages=keys %$lang;
+ return sort @languages;
+ }
+ } else {
+ my $lang;
+ my $htdocs=C4::Context->config('intrahtdocs');
+ foreach my $theme (getallthemes('intranet')) {
+ opendir D, "$htdocs/$theme";
+ foreach my $language (readdir D) {
+ next if $language=~/^\./;
+ next if $language eq 'all';
+ next if $language=~ /png$/;
+ next if $language=~ /css$/;
+ next if $language=~ /CVS$/;
+ next if $language=~ /itemtypeimg$/;
+ $lang->{$language}=1;
+ }
+ }
+ $htdocs=C4::Context->config('opachtdocs');
+ foreach my $theme (getallthemes('opac')) {
+ opendir D, "$htdocs/$theme";
+ foreach my $language (readdir D) {
+ next if $language=~/^\./;
+ next if $language eq 'all';
+ next if $language=~ /png$/;
+ next if $language=~ /css$/;
+ next if $language=~ /CVS$/;
+ next if $language=~ /itemtypeimg$/;
+ $lang->{$language}=1;
+ }
+ }
+ @languages=keys %$lang;
+ return sort @languages;
+ }
+}
+
+=item getallthemes
+
+ (@themes) = &getallthemes('opac');
+ (@themes) = &getallthemes('intranet');
+
+Returns an array of all available themes.
+
+=cut
+
+sub getallthemes {
+ my $type=shift;
+ my $htdocs;
+ my @themes;
+ if ($type eq 'intranet') {
+ $htdocs=C4::Context->config('intrahtdocs');
+ } else {
+ $htdocs=C4::Context->config('opachtdocs');
+ }
+ opendir D, "$htdocs";
+ my @dirlist=readdir D;
+ foreach my $directory (@dirlist) {
+ -d "$htdocs/$directory/en" and push @themes, $directory;
+ }
+ return @themes;
+}
+
+=item getnbpages
+
+Returns the number of pages to display in a pagination bar, given the number
+of items and the number of items per page.
+
+=cut
+
+sub getnbpages {
+ my ($nb_items, $nb_items_per_page) = @_;
+
+ return int(($nb_items - 1) / $nb_items_per_page) + 1;
+}
+
+
+=head2 getcities (OUEST-PROVENCE)
+
+ ($id_cityarrayref, $city_hashref) = &getcities();
+
+Looks up the different city and zip in the database. Returns two
+elements: a reference-to-array, which lists the zip city
+codes, and a reference-to-hash, which maps the name of the city.
+WHERE =>OUEST PROVENCE OR EXTERIEUR
+
+=cut
+sub getcities {
+ #my ($type_city) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("Select cityid,city_name from cities order by cityid ");
+ #$sth->execute($type_city);
+ $sth->execute();
+ my %city;
+ my @id;
+# insert empty value to create a empty choice in cgi popup
+
+while (my $data=$sth->fetchrow_hashref){
+
+ push @id,$data->{'cityid'};
+ $city{$data->{'cityid'}}=$data->{'city_name'};
+ }
+
+ #test to know if the table contain some records if no the function return nothing
+ my $id=@id;
+ $sth->finish;
+ if ($id eq 0)
+ {
+ return();
+ }
+ else{
+ unshift (@id ,"");
+ return(\@id,\%city);
+ }
+}
+
+
+=head2 getroadtypes (OUEST-PROVENCE)
+
+ ($idroadtypearrayref, $roadttype_hashref) = &getroadtypes();
+
+Looks up the different road type . Returns two
+elements: a reference-to-array, which lists the id_roadtype
+codes, and a reference-to-hash, which maps the road type of the road .
+
+
+=cut
+sub getroadtypes {
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("Select roadtypeid,road_type from roadtype order by road_type ");
+ $sth->execute();
+ my %roadtype;
+ my @id;
+# insert empty value to create a empty choice in cgi popup
+while (my $data=$sth->fetchrow_hashref){
+ push @id,$data->{'roadtypeid'};
+ $roadtype{$data->{'roadtypeid'}}=$data->{'road_type'};
+ }
+ #test to know if the table contain some records if no the function return nothing
+ my $id=@id;
+ $sth->finish;
+ if ($id eq 0)
+ {
+ return();
+ }
+ else{
+ unshift (@id ,"");
+ return(\@id,\%roadtype);
+ }
+}
+
+=head2 get_branchinfos_of
+
+ my $branchinfos_of = get_branchinfos_of(@branchcodes);
+
+Associates a list of branchcodes to the information of the branch, taken in
+branches table.
+
+Returns a href where keys are branchcodes and values are href where keys are
+branch information key.
+
+ print 'branchname is ', $branchinfos_of->{$code}->{branchname};
+
+=cut
+sub get_branchinfos_of {
+ my @branchcodes = @_;
+
+ my $query = '
+SELECT branchcode,
+ branchname
+ FROM branches
+ WHERE branchcode IN ('.join(',', map({"'".$_."'"} @branchcodes)).')
+';
+ return get_infos_of($query, 'branchcode');
+}
+
+=head2 get_notforloan_label_of
+
+ my $notforloan_label_of = get_notforloan_label_of();
+
+Each authorised value of notforloan (information available in items and
+itemtypes) is link to a single label.
+
+Returns a href where keys are authorised values and values are corresponding
+labels.
+
+ foreach my $authorised_value (keys %{$notforloan_label_of}) {
+ printf(
+ "authorised_value: %s => %s\n",
+ $authorised_value,
+ $notforloan_label_of->{$authorised_value}
+ );
+ }
+
+=cut
+sub get_notforloan_label_of {
+ my $dbh = C4::Context->dbh;
+
+ my $query = '
+SELECT authorised_value
+ FROM marc_subfield_structure
+ WHERE kohafield = \'items.notforloan\'
+ LIMIT 0, 1
+';
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my ($statuscode) = $sth->fetchrow_array();
+
+ $query = '
+SELECT lib,
+ authorised_value
+ FROM authorised_values
+ WHERE category = ?
+';
+ $sth = $dbh->prepare($query);
+ $sth->execute($statuscode);
+ my %notforloan_label_of;
+ while (my $row = $sth->fetchrow_hashref) {
+ $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
+ }
+ $sth->finish;
+
+ return \%notforloan_label_of;
+}
+
+=head2 get_infos_of
+
+Return a href where a key is associated to a href. You give a query, the
+name of the key among the fields returned by the query. If you also give as
+third argument the name of the value, the function returns a href of scalar.
+
+ my $query = '
+SELECT itemnumber,
+ notforloan,
+ barcode
+ FROM items
+';
+
+ # generic href of any information on the item, href of href.
+ my $iteminfos_of = get_infos_of($query, 'itemnumber');
+ print $iteminfos_of->{$itemnumber}{barcode};
+
+ # specific information, href of scalar
+ my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
+ print $barcode_of_item->{$itemnumber};
+
+=cut
+sub get_infos_of {
+ my ($query, $key_name, $value_name) = @_;
+
+ my $dbh = C4::Context->dbh;
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+
+ my %infos_of;
+ while (my $row = $sth->fetchrow_hashref) {
+ if (defined $value_name) {
+ $infos_of{ $row->{$key_name} } = $row->{$value_name};
+ }
+ else {
+ $infos_of{ $row->{$key_name} } = $row;
+ }
+ }
+ $sth->finish;
+
+ return \%infos_of;
+}
1;
__END__
=head1 AUTHOR
-Pat Eyler, pate@gnu.org
+Koha Team
=cut
projects / koha.git / blobdiff