File Coverage

File:C4/Koha.pm
Coverage:7.8%

linestmtbrancondsubtimecode
1package C4::Koha;
2
3# Copyright 2000-2002 Katipo Communications
4# Parts Copyright 2010 Nelsonville Public Library
5# Parts copyright 2010 BibLibre
6#
7# This file is part of Koha.
8#
9# Koha is free software; you can redistribute it and/or modify it under the
10# terms of the GNU General Public License as published by the Free Software
11# Foundation; either version 2 of the License, or (at your option) any later
12# version.
13#
14# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License along
19# with Koha; if not, write to the Free Software Foundation, Inc.,
20# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
22
23
44
44
44
439121
324
1763
use strict;
24#use warnings; FIXME - Bug 2505
25
44
44
44
1736
310
785
use C4::Context;
26
44
44
44
30266
121344
3939
use Memoize;
27
28
44
44
44
541
309
6772
use vars qw($VERSION @ISA @EXPORT $DEBUG);
29
30BEGIN {
31
44
346
        $VERSION = 3.01;
32
44
399
        require Exporter;
33
44
683
        @ISA = qw(Exporter);
34
44
791
        @EXPORT = qw(
35                &slashifyDate
36                &subfield_is_koha_internal_p
37                &GetPrinters &GetPrinter
38                &GetItemTypes &getitemtypeinfo
39                &GetCcodes
40                &GetSupportName &GetSupportList
41                &get_itemtypeinfos_of
42                &getframeworks &getframeworkinfo
43                &getauthtypes &getauthtype
44                &getallthemes
45                &getFacets
46                &displayServers
47                &getnbpages
48                &get_infos_of
49                &get_notforloan_label_of
50                &getitemtypeimagedir
51                &getitemtypeimagesrc
52                &getitemtypeimagelocation
53                &GetAuthorisedValues
54                &GetAuthorisedValueCategories
55                &GetKohaAuthorisedValues
56                &GetKohaAuthorisedValuesFromField
57    &GetKohaAuthorisedValueLib
58    &GetAuthorisedValueByCode
59    &GetKohaImageurlFromAuthorisedValues
60                &GetAuthValCode
61                &GetNormalizedUPC
62                &GetNormalizedISBN
63                &GetNormalizedEAN
64                &GetNormalizedOCLCNumber
65        &xml_escape
66
67                $DEBUG
68        );
69
44
251000
        $DEBUG = 0;
70}
71
72# expensive functions
73memoize('GetAuthorisedValues');
74
75 - 89
=head1 NAME

C4::Koha - Perl Module containing convenience functions for Koha scripts

=head1 SYNOPSIS

use C4::Koha;

=head1 DESCRIPTION

Koha.pm provides many functions for Koha scripts.

=head1 FUNCTIONS

=cut
90
91 - 98
=head2 slashifyDate

  $slash_date = &slashifyDate($dash_date);

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.

=cut
99
100sub slashifyDate {
101
102    # accepts a date of the form xx-xx-xx[xx] and returns it in the
103    # form xx/xx/xx[xx]
104
2
2462
    my @dateOut = split( '-', shift );
105
2
318
    return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
106}
107
108# FIXME.. this should be moved to a MARC-specific module
109sub subfield_is_koha_internal_p ($) {
110
0
0
    my ($subfield) = @_;
111
112    # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
113    # But real MARC subfields are always single-character
114    # so it really is safer just to check the length
115
116
0
0
    return length $subfield != 1;
117}
118
119 - 125
=head2 GetSupportName

  $itemtypename = &GetSupportName($codestring);

Returns a string with the name of the itemtype.

=cut
126
127sub GetSupportName{
128
0
0
        my ($codestring)=@_;
129
0
0
        return if (! $codestring);
130
0
0
        my $resultstring;
131
0
0
        my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
132
0
0
        if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
133
0
0
                my $query = qq|
134                        SELECT description
135                        FROM itemtypes
136                        WHERE itemtype=?
137                        order by description
138                |;
139
0
0
                my $sth = C4::Context->dbh->prepare($query);
140
0
0
                $sth->execute($codestring);
141
0
0
                ($resultstring)=$sth->fetchrow;
142
0
0
                return $resultstring;
143        } else {
144
0
0
        my $sth =
145            C4::Context->dbh->prepare(
146                    "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
147                    );
148
0
0
        $sth->execute( $advanced_search_types, $codestring );
149
0
0
        my $data = $sth->fetchrow_hashref;
150
0
0
        return $$data{'lib'};
151        }
152
153}
154 - 180
=head2 GetSupportList

  $itemtypes = &GetSupportList();

Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).

build a HTML select with the following code :

=head3 in PERL SCRIPT

    my $itemtypes = GetSupportList();
    $template->param(itemtypeloop => $itemtypes);

=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="itemtype" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->> <!--TMPL_IF Name="imageurl"--><img alt="<!-- TMPL_VAR name="description" -->" src="<!--TMPL_VAR Name="imageurl"-->><!--TMPL_ELSE-->"<!-- TMPL_VAR name="description" --><!--/TMPL_IF--></option>
        <!-- /TMPL_LOOP -->
        </select>
        <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
        <input type="submit" value="OK" class="button">
    </form>

=cut
181
182sub GetSupportList{
183
0
0
        my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
184
0
0
        if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
185
0
0
                my $query = qq|
186                        SELECT *
187                        FROM itemtypes
188                        order by description
189                |;
190
0
0
                my $sth = C4::Context->dbh->prepare($query);
191
0
0
                $sth->execute;
192
0
0
                return $sth->fetchall_arrayref({});
193        } else {
194
0
0
                my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
195
0
0
0
0
                my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
196
0
0
                return \@results;
197        }
198}
199 - 234
=head2 GetItemTypes

  $itemtypes = &GetItemTypes();

Returns information about existing itemtypes.

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>

=cut
235
236sub GetItemTypes {
237
238    # returns a reference to a hash of references to itemtypes...
239
0
0
    my %itemtypes;
240
0
0
    my $dbh = C4::Context->dbh;
241
0
0
    my $query = qq|
242        SELECT *
243        FROM itemtypes
244    |;
245
0
0
    my $sth = $dbh->prepare($query);
246
0
0
    $sth->execute;
247
0
0
    while ( my $IT = $sth->fetchrow_hashref ) {
248
0
0
        $itemtypes{ $IT->{'itemtype'} } = $IT;
249    }
250
0
0
    return ( \%itemtypes );
251}
252
253sub get_itemtypeinfos_of {
254
0
0
    my @itemtypes = @_;
255
256
0
0
0
0
    my $placeholders = join( ', ', map { '?' } @itemtypes );
257
0
0
    my $query = <<"END_SQL";
258SELECT itemtype,
259       description,
260       imageurl,
261       notforloan
262  FROM itemtypes
263  WHERE itemtype IN ( $placeholders )
264END_SQL
265
266
0
0
    return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
267}
268
269# this is temporary until we separate collection codes and item types
270sub GetCcodes {
271
0
0
    my $count = 0;
272
0
0
    my @results;
273
0
0
    my $dbh = C4::Context->dbh;
274
0
0
    my $sth =
275      $dbh->prepare(
276        "SELECT * FROM authorised_values ORDER BY authorised_value");
277
0
0
    $sth->execute;
278
0
0
    while ( my $data = $sth->fetchrow_hashref ) {
279
0
0
        if ( $data->{category} eq "CCODE" ) {
280
0
0
            $count++;
281
0
0
            $results[$count] = $data;
282
283            #warn "data: $data";
284        }
285    }
286
0
0
    $sth->finish;
287
0
0
    return ( $count, @results );
288}
289
290 - 325
=head2 getauthtypes

  $authtypes = &getauthtypes();

Returns information about existing authtypes.

build a HTML select with the following code :

=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>


=cut
326
327sub getauthtypes {
328
329    # returns a reference to a hash of references to authtypes...
330
0
0
    my %authtypes;
331
0
0
    my $dbh = C4::Context->dbh;
332
0
0
    my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
333
0
0
    $sth->execute;
334
0
0
    while ( my $IT = $sth->fetchrow_hashref ) {
335
0
0
        $authtypes{ $IT->{'authtypecode'} } = $IT;
336    }
337
0
0
    return ( \%authtypes );
338}
339
340sub getauthtype {
341
0
0
    my ($authtypecode) = @_;
342
343    # returns a reference to a hash of references to authtypes...
344
0
0
    my %authtypes;
345
0
0
    my $dbh = C4::Context->dbh;
346
0
0
    my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
347
0
0
    $sth->execute($authtypecode);
348
0
0
    my $res = $sth->fetchrow_hashref;
349
0
0
    return $res;
350}
351
352 - 387
=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
388
389sub getframeworks {
390
391    # returns a reference to a hash of references to branches...
392
0
0
    my %itemtypes;
393
0
0
    my $dbh = C4::Context->dbh;
394
0
0
    my $sth = $dbh->prepare("select * from biblio_framework");
395
0
0
    $sth->execute;
396
0
0
    while ( my $IT = $sth->fetchrow_hashref ) {
397
0
0
        $itemtypes{ $IT->{'frameworkcode'} } = $IT;
398    }
399
0
0
    return ( \%itemtypes );
400}
401
402 - 408
=head2 getframeworkinfo

  $frameworkinfo = &getframeworkinfo($frameworkcode);

Returns information about an frameworkcode.

=cut
409
410sub getframeworkinfo {
411
0
0
    my ($frameworkcode) = @_;
412
0
0
    my $dbh = C4::Context->dbh;
413
0
0
    my $sth =
414      $dbh->prepare("select * from biblio_framework where frameworkcode=?");
415
0
0
    $sth->execute($frameworkcode);
416
0
0
    my $res = $sth->fetchrow_hashref;
417
0
0
    return $res;
418}
419
420 - 426
=head2 getitemtypeinfo

  $itemtype = &getitemtype($itemtype);

Returns information about an itemtype.

=cut
427
428sub getitemtypeinfo {
429
0
0
    my ($itemtype) = @_;
430
0
0
    my $dbh = C4::Context->dbh;
431
0
0
    my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
432
0
0
    $sth->execute($itemtype);
433
0
0
    my $res = $sth->fetchrow_hashref;
434
435
0
0
    $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
436
437
0
0
    return $res;
438}
439
440 - 448
=head2 getitemtypeimagedir

  my $directory = getitemtypeimagedir( 'opac' );

pass in 'opac' or 'intranet'. Defaults to 'opac'.

returns the full path to the appropriate directory containing images.

=cut
449
450sub getitemtypeimagedir {
451
0
0
        my $src = shift || 'opac';
452
0
0
        if ($src eq 'intranet') {
453
0
0
                return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
454        } else {
455
0
0
                return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
456        }
457}
458
459sub getitemtypeimagesrc {
460
0
0
        my $src = shift || 'opac';
461
0
0
        if ($src eq 'intranet') {
462
0
0
                return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
463        } else {
464
0
0
                return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
465        }
466}
467
468sub getitemtypeimagelocation($$) {
469
0
0
        my ( $src, $image ) = @_;
470
471
0
0
        return '' if ( !$image );
472
0
0
    require URI::Split;
473
474
0
0
        my $scheme = ( URI::Split::uri_split( $image ) )[0];
475
476
0
0
        return $image if ( $scheme );
477
478
0
0
        return getitemtypeimagesrc( $src ) . '/' . $image;
479}
480
481 - 494
=head3 _getImagesFromDirectory

Find all of the image files in a directory in the filesystem

parameters: a directory name

returns: a list of images in that directory.

Notes: this does not traverse into subdirectories. See
_getSubdirectoryNames for help with that.
Images are assumed to be files with .gif or .png file extensions.
The image names returned do not have the directory name on them.

=cut
495
496sub _getImagesFromDirectory {
497
0
0
    my $directoryname = shift;
498
0
0
    return unless defined $directoryname;
499
0
0
    return unless -d $directoryname;
500
501
0
0
    if ( opendir ( my $dh, $directoryname ) ) {
502
0
0
0
0
        my @images = grep { /\.(gif|png)$/i } readdir( $dh );
503
0
0
        closedir $dh;
504
0
0
        @images = sort(@images);
505
0
0
        return @images;
506    } else {
507
0
0
        warn "unable to opendir $directoryname: $!";
508
0
0
        return;
509    }
510}
511
512 - 524
=head3 _getSubdirectoryNames

Find all of the directories in a directory in the filesystem

parameters: a directory name

returns: a list of subdirectories in that directory.

Notes: this does not traverse into subdirectories. Only the first
level of subdirectories are returned.
The directory names returned don't have the parent directory name on them.

=cut
525
526sub _getSubdirectoryNames {
527
0
0
    my $directoryname = shift;
528
0
0
    return unless defined $directoryname;
529
0
0
    return unless -d $directoryname;
530
531
0
0
    if ( opendir ( my $dh, $directoryname ) ) {
532
0
0
0
0
        my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
533
0
0
        closedir $dh;
534
0
0
        return @directories;
535    } else {
536
0
0
        warn "unable to opendir $directoryname: $!";
537
0
0
        return;
538    }
539}
540
541 - 558
=head3 getImageSets

returns: a listref of hashrefs. Each hash represents another collection of images.

 { imagesetname => 'npl', # the name of the image set (npl is the original one)
         images => listref of image hashrefs
 }

each image is represented by a hashref like this:

 { KohaImage     => 'npl/image.gif',
   StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
   OpacImageURL  => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
   checked       => 0 or 1: was this the image passed to this method?
                    Note: I'd like to remove this somehow.
 }

=cut
559
560sub getImageSets {
561
0
0
    my %params = @_;
562
0
0
    my $checked = $params{'checked'} || '';
563
564
0
0
    my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
565                             url => getitemtypeimagesrc('intranet'),
566                        },
567                  opac => { filesystem => getitemtypeimagedir('opac'),
568                             url => getitemtypeimagesrc('opac'),
569                        }
570                  };
571
572
0
0
    my @imagesets = (); # list of hasrefs of image set data to pass to template
573
0
0
    my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
574
0
0
    foreach my $imagesubdir ( @subdirectories ) {
575
0
0
    warn $imagesubdir if $DEBUG;
576
0
0
        my @imagelist = (); # hashrefs of image info
577
0
0
        my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
578
0
0
        my $imagesetactive = 0;
579
0
0
        foreach my $thisimage ( @imagenames ) {
580
0
0
            push( @imagelist,
581                  { KohaImage => "$imagesubdir/$thisimage",
582                    StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
583                    OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
584                    checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
585               }
586             );
587
0
0
             $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
588        }
589
0
0
        push @imagesets, { imagesetname => $imagesubdir,
590                           imagesetactive => $imagesetactive,
591                           images => \@imagelist };
592
593    }
594
0
0
    return \@imagesets;
595}
596
597 - 608
=head2 GetPrinters

  $printers = &GetPrinters();
  @queues = keys %$printers;

Returns information about existing printer queues.

C<$printers> is a reference-to-hash whose keys are the print queues
defined in the printers table of the Koha database. The values are
references-to-hash, whose keys are the fields in the printers table.

=cut
609
610sub GetPrinters {
611
0
0
    my %printers;
612
0
0
    my $dbh = C4::Context->dbh;
613
0
0
    my $sth = $dbh->prepare("select * from printers");
614
0
0
    $sth->execute;
615
0
0
    while ( my $printer = $sth->fetchrow_hashref ) {
616
0
0
        $printers{ $printer->{'printqueue'} } = $printer;
617    }
618
0
0
    return ( \%printers );
619}
620
621 - 625
=head2 GetPrinter

  $printer = GetPrinter( $query, $printers );

=cut
626
627sub GetPrinter ($$) {
628
0
0
    my ( $query, $printers ) = @_; # get printer for this query from printers
629
0
0
    my $printer = $query->param('printer');
630
0
0
    my %cookie = $query->cookie('userenv');
631
0
0
    ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
632
0
0
    ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
633
0
0
    return $printer;
634}
635
636 - 641
=head2 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
642
643sub getnbpages {
644
0
0
    my ( $nb_items, $nb_items_per_page ) = @_;
645
646
0
0
    return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
647}
648
649 - 656
=head2 getallthemes

  (@themes) = &getallthemes('opac');
  (@themes) = &getallthemes('intranet');

Returns an array of all available themes.

=cut
657
658sub getallthemes {
659
0
0
    my $type = shift;
660
0
0
    my $htdocs;
661
0
0
    my @themes;
662
0
0
    if ( $type eq 'intranet' ) {
663
0
0
        $htdocs = C4::Context->config('intrahtdocs');
664    }
665    else {
666
0
0
        $htdocs = C4::Context->config('opachtdocs');
667    }
668
0
0
    opendir D, "$htdocs";
669
0
0
    my @dirlist = readdir D;
670
0
0
    foreach my $directory (@dirlist) {
671
0
0
        -d "$htdocs/$directory/en" and push @themes, $directory;
672    }
673
0
0
    return @themes;
674}
675
676sub getFacets {
677
0
0
    my $facets;
678
0
0
    if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
679
0
0
        $facets = [
680            {
681                link_value => 'su-to',
682                label_value => 'Topics',
683                tags =>
684                  [ '600', '601', '602', '603', '604', '605', '606', '610' ],
685                subfield => 'a',
686            },
687            {
688                link_value => 'su-geo',
689                label_value => 'Places',
690                tags => ['651'],
691                subfield => 'a',
692            },
693            {
694                link_value => 'su-ut',
695                label_value => 'Titles',
696                tags => [ '500', '501', '502', '503', '504', ],
697                subfield => 'a',
698            },
699            {
700                link_value => 'au',
701                label_value => 'Authors',
702                tags => [ '700', '701', '702', ],
703                subfield => 'a',
704            },
705            {
706                link_value => 'se',
707                label_value => 'Series',
708                tags => ['225'],
709                subfield => 'a',
710            },
711            ];
712
713
0
0
            my $library_facet;
714
715
0
0
            $library_facet = {
716                link_value => 'branch',
717                label_value => 'Libraries',
718                tags => [ '995', ],
719                subfield => 'b',
720                expanded => '1',
721            };
722
0
0
            push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
723    }
724    else {
725
0
0
        $facets = [
726            {
727                link_value => 'su-to',
728                label_value => 'Topics',
729                tags => ['650'],
730                subfield => 'a',
731            },
732
733            # {
734            # link_value => 'su-na',
735            # label_value => 'People and Organizations',
736            # tags => ['600', '610', '611'],
737            # subfield => 'a',
738            # },
739            {
740                link_value => 'su-geo',
741                label_value => 'Places',
742                tags => ['651'],
743                subfield => 'a',
744            },
745            {
746                link_value => 'su-ut',
747                label_value => 'Titles',
748                tags => ['630'],
749                subfield => 'a',
750            },
751            {
752                link_value => 'au',
753                label_value => 'Authors',
754                tags => [ '100', '110', '700', ],
755                subfield => 'a',
756            },
757            {
758                link_value => 'se',
759                label_value => 'Series',
760                tags => [ '440', '490', ],
761                subfield => 'a',
762            },
763            ];
764
0
0
            my $library_facet;
765
0
0
            $library_facet = {
766                link_value => 'branch',
767                label_value => 'Libraries',
768                tags => [ '952', ],
769                subfield => 'b',
770                expanded => '1',
771            };
772
0
0
            push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
773    }
774
0
0
    return $facets;
775}
776
777 - 801
=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. The optional 4th argument is an arrayref of
items passed to the C<execute()> call. It is designed to bind
parameters to any placeholders in your SQL.

  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
802
803sub get_infos_of {
804
0
0
    my ( $query, $key_name, $value_name, $bind_params ) = @_;
805
806
0
0
    my $dbh = C4::Context->dbh;
807
808
0
0
    my $sth = $dbh->prepare($query);
809
0
0
    $sth->execute( @$bind_params );
810
811
0
0
    my %infos_of;
812
0
0
    while ( my $row = $sth->fetchrow_hashref ) {
813
0
0
        if ( defined $value_name ) {
814
0
0
            $infos_of{ $row->{$key_name} } = $row->{$value_name};
815        }
816        else {
817
0
0
            $infos_of{ $row->{$key_name} } = $row;
818        }
819    }
820
0
0
    $sth->finish;
821
822
0
0
    return \%infos_of;
823}
824
825 - 843
=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
844
845# FIXME - why not use GetAuthorisedValues ??
846#
847sub get_notforloan_label_of {
848
0
0
    my $dbh = C4::Context->dbh;
849
850
0
0
    my $query = '
851SELECT authorised_value
852  FROM marc_subfield_structure
853  WHERE kohafield = \'items.notforloan\'
854  LIMIT 0, 1
855';
856
0
0
    my $sth = $dbh->prepare($query);
857
0
0
    $sth->execute();
858
0
0
    my ($statuscode) = $sth->fetchrow_array();
859
860
0
0
    $query = '
861SELECT lib,
862       authorised_value
863  FROM authorised_values
864  WHERE category = ?
865';
866
0
0
    $sth = $dbh->prepare($query);
867
0
0
    $sth->execute($statuscode);
868
0
0
    my %notforloan_label_of;
869
0
0
    while ( my $row = $sth->fetchrow_hashref ) {
870
0
0
        $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
871    }
872
0
0
    $sth->finish;
873
874
0
0
    return \%notforloan_label_of;
875}
876
877 - 899
=head2 displayServers

   my $servers = displayServers();
   my $servers = displayServers( $position );
   my $servers = displayServers( $position, $type );

displayServers returns a listref of hashrefs, each containing
information about available z3950 servers. Each hashref has a format
like:

    {
      'checked'    => 'checked',
      'encoding'   => 'MARC-8'
      'icon'       => undef,
      'id'         => 'LIBRARY OF CONGRESS',
      'label'      => '',
      'name'       => 'server',
      'opensearch' => '',
      'value'      => 'z3950.loc.gov:7090/',
      'zed'        => 1,
    },

=cut
900
901sub displayServers {
902
0
0
    my ( $position, $type ) = @_;
903
0
0
    my $dbh = C4::Context->dbh;
904
905
0
0
    my $strsth = 'SELECT * FROM z3950servers';
906
0
0
    my @where_clauses;
907
0
0
    my @bind_params;
908
909
0
0
    if ($position) {
910
0
0
        push @bind_params, $position;
911
0
0
        push @where_clauses, ' position = ? ';
912    }
913
914
0
0
    if ($type) {
915
0
0
        push @bind_params, $type;
916
0
0
        push @where_clauses, ' type = ? ';
917    }
918
919    # reassemble where clause from where clause pieces
920
0
0
    if (@where_clauses) {
921
0
0
        $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
922    }
923
924
0
0
    my $rq = $dbh->prepare($strsth);
925
0
0
    $rq->execute(@bind_params);
926
0
0
    my @primaryserverloop;
927
928
0
0
    while ( my $data = $rq->fetchrow_hashref ) {
929
0
0
        push @primaryserverloop,
930          { label => $data->{description},
931            id => $data->{name},
932            name => "server",
933            value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
934            encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
935            checked => "checked",
936            icon => $data->{icon},
937            zed => $data->{type} eq 'zed',
938            opensearch => $data->{type} eq 'opensearch'
939          };
940    }
941
0
0
    return \@primaryserverloop;
942}
943
944
945 - 951
=head2 GetKohaImageurlFromAuthorisedValues

$authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );

Return the first url of the authorised value image represented by $lib.

=cut
952
953sub GetKohaImageurlFromAuthorisedValues {
954
0
0
    my ( $category, $lib ) = @_;
955
0
0
    my $dbh = C4::Context->dbh;
956
0
0
    my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
957
0
0
    $sth->execute( $category, $lib );
958
0
0
    while ( my $data = $sth->fetchrow_hashref ) {
959
0
0
        return $data->{'imageurl'};
960    }
961}
962
963 - 967
=head2 GetAuthValCode

  $authvalcode = GetAuthValCode($kohafield,$frameworkcode);

=cut
968
969sub GetAuthValCode {
970
0
0
        my ($kohafield,$fwcode) = @_;
971
0
0
        my $dbh = C4::Context->dbh;
972
0
0
        $fwcode='' unless $fwcode;
973
0
0
        my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
974
0
0
        $sth->execute($kohafield,$fwcode);
975
0
0
        my ($authvalcode) = $sth->fetchrow_array;
976
0
0
        return $authvalcode;
977}
978
979 - 985
=head2 GetAuthValCodeFromField

  $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);

C<$subfield> can be undefined

=cut
986
987sub GetAuthValCodeFromField {
988
0
0
        my ($field,$subfield,$fwcode) = @_;
989
0
0
        my $dbh = C4::Context->dbh;
990
0
0
        $fwcode='' unless $fwcode;
991
0
0
        my $sth;
992
0
0
        if (defined $subfield) {
993
0
0
            $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
994
0
0
            $sth->execute($field,$subfield,$fwcode);
995        } else {
996
0
0
            $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
997
0
0
            $sth->execute($field,$fwcode);
998        }
999
0
0
        my ($authvalcode) = $sth->fetchrow_array;
1000
0
0
        return $authvalcode;
1001}
1002
1003 - 1013
=head2 GetAuthorisedValues

  $authvalues = GetAuthorisedValues([$category], [$selected]);

This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.

C<$category> returns authorised values for just one category (optional).

C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.

=cut
1014
1015sub GetAuthorisedValues {
1016    my ($category,$selected,$opac) = @_;
1017        my @results;
1018    my $dbh = C4::Context->dbh;
1019    my $query = "SELECT * FROM authorised_values";
1020    $query .= " WHERE category = '" . $category . "'" if $category;
1021    $query .= " ORDER BY category, lib, lib_opac";
1022    my $sth = $dbh->prepare($query);
1023    $sth->execute;
1024        while (my $data=$sth->fetchrow_hashref) {
1025            if ($selected && $selected eq $data->{'authorised_value'} ) {
1026                    $data->{'selected'} = 1;
1027            }
1028            if ($opac && $data->{'lib_opac'}) {
1029                $data->{'lib'} = $data->{'lib_opac'};
1030            }
1031            push @results, $data;
1032        }
1033    #my $data = $sth->fetchall_arrayref({});
1034    return \@results; #$data;
1035}
1036
1037 - 1044
=head2 GetAuthorisedValueCategories

  $auth_categories = GetAuthorisedValueCategories();

Return an arrayref of all of the available authorised
value categories.

=cut
1045
1046sub GetAuthorisedValueCategories {
1047
0
0
    my $dbh = C4::Context->dbh;
1048
0
0
    my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1049
0
0
    $sth->execute;
1050
0
0
    my @results;
1051
0
0
    while (defined (my $category = $sth->fetchrow_array) ) {
1052
0
0
        push @results, $category;
1053    }
1054
0
0
    return \@results;
1055}
1056
1057 - 1064
=head2 GetAuthorisedValueByCode

$authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );

Return the lib attribute from authorised_values from the row identified
by the passed category and code

=cut
1065
1066sub GetAuthorisedValueByCode {
1067
0
0
    my ( $category, $authvalcode ) = @_;
1068
1069
0
0
    my $dbh = C4::Context->dbh;
1070
0
0
    my $sth = $dbh->prepare("SELECT lib FROM authorised_values WHERE category=? AND authorised_value =?");
1071
0
0
    $sth->execute( $category, $authvalcode );
1072
0
0
    while ( my $data = $sth->fetchrow_hashref ) {
1073
0
0
        return $data->{'lib'};
1074    }
1075}
1076
1077 - 1087
=head2 GetKohaAuthorisedValues

Takes $kohafield, $fwcode as parameters.

If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.

Returns hashref of Code => description

Returns undef if no authorised value category is defined for the kohafield.

=cut
1088
1089sub GetKohaAuthorisedValues {
1090
0
0
  my ($kohafield,$fwcode,$opac) = @_;
1091
0
0
  $fwcode='' unless $fwcode;
1092
0
0
  my %values;
1093
0
0
  my $dbh = C4::Context->dbh;
1094
0
0
  my $avcode = GetAuthValCode($kohafield,$fwcode);
1095
0
0
  if ($avcode) {
1096
0
0
        my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1097
0
0
    $sth->execute($avcode);
1098
0
0
        while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1099
0
0
                $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1100    }
1101
0
0
    return \%values;
1102  } else {
1103
0
0
   return undef;
1104  }
1105}
1106
1107 - 1118
=head2 GetKohaAuthorisedValuesFromField

Takes $field, $subfield, $fwcode as parameters.

If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
$subfield can be undefined

Returns hashref of Code => description

Returns undef if no authorised value category is defined for the given field and subfield 

=cut
1119
1120sub GetKohaAuthorisedValuesFromField {
1121
0
0
  my ($field, $subfield, $fwcode,$opac) = @_;
1122
0
0
  $fwcode='' unless $fwcode;
1123
0
0
  my %values;
1124
0
0
  my $dbh = C4::Context->dbh;
1125
0
0
  my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1126
0
0
  if ($avcode) {
1127
0
0
        my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1128
0
0
    $sth->execute($avcode);
1129
0
0
        while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1130
0
0
                $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1131    }
1132
0
0
    return \%values;
1133  } else {
1134
0
0
   return undef;
1135  }
1136}
1137
1138 - 1144
=head2 xml_escape

  my $escaped_string = C4::Koha::xml_escape($string);

Convert &, <, >, ', and " in a string to XML entities

=cut
1145
1146sub xml_escape {
1147
4
940
    my $str = shift;
1148
4
27
    return '' unless defined $str;
1149
2
14
    $str =~ s/&/&amp;/g;
1150
2
7
    $str =~ s/</&lt;/g;
1151
2
6
    $str =~ s/>/&gt;/g;
1152
2
8
    $str =~ s/'/&apos;/g;
1153
2
7
    $str =~ s/"/&quot;/g;
1154
2
16
    return $str;
1155}
1156
1157 - 1165
=head2 GetKohaAuthorisedValueLib

Takes $category, $authorised_value as parameters.

If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.

Returns authorised value description

=cut
1166
1167sub GetKohaAuthorisedValueLib {
1168
0
0
  my ($category,$authorised_value,$opac) = @_;
1169
0
0
  my $value;
1170
0
0
  my $dbh = C4::Context->dbh;
1171
0
0
  my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1172
0
0
  $sth->execute($category,$authorised_value);
1173
0
0
  my $data = $sth->fetchrow_hashref;
1174
0
0
  $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1175
0
0
  return $value;
1176}
1177
1178 - 1187
=head2 display_marc_indicators

  my $display_form = C4::Koha::display_marc_indicators($field);

C<$field> is a MARC::Field object

Generate a display form of the indicators of a variable
MARC field, replacing any blanks with '#'.

=cut
1188
1189sub display_marc_indicators {
1190
0
0
    my $field = shift;
1191
0
0
    my $indicators = '';
1192
0
0
    if ($field->tag() >= 10) {
1193
0
0
        $indicators = $field->indicator(1) . $field->indicator(2);
1194
0
0
        $indicators =~ s/ /#/g;
1195    }
1196
0
0
    return $indicators;
1197}
1198
1199sub GetNormalizedUPC {
1200
0
0
 my ($record,$marcflavour) = @_;
1201
0
0
    my (@fields,$upc);
1202
1203
0
0
    if ($marcflavour eq 'UNIMARC') {
1204
0
0
        @fields = $record->field('072');
1205
0
0
        foreach my $field (@fields) {
1206
0
0
            my $upc = _normalize_match_point($field->subfield('a'));
1207
0
0
            if ($upc ne '') {
1208
0
0
                return $upc;
1209            }
1210        }
1211
1212    }
1213    else { # assume marc21 if not unimarc
1214
0
0
        @fields = $record->field('024');
1215
0
0
        foreach my $field (@fields) {
1216
0
0
            my $indicator = $field->indicator(1);
1217
0
0
            my $upc = _normalize_match_point($field->subfield('a'));
1218
0
0
            if ($indicator == 1 and $upc ne '') {
1219
0
0
                return $upc;
1220            }
1221        }
1222    }
1223}
1224
1225# Normalizes and returns the first valid ISBN found in the record
1226# ISBN13 are converted into ISBN10. This is required to get Amazon cover book.
1227sub GetNormalizedISBN {
1228
0
0
    my ($isbn,$record,$marcflavour) = @_;
1229
0
0
    my @fields;
1230
0
0
    if ($isbn) {
1231        # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1232        # anything after " | " should be removed, along with the delimiter
1233
0
0
        $isbn =~ s/(.*)( \| )(.*)/$1/;
1234
0
0
        return _isbn_cleanup($isbn);
1235    }
1236
0
0
    return undef unless $record;
1237
1238
0
0
    if ($marcflavour eq 'UNIMARC') {
1239
0
0
        @fields = $record->field('010');
1240
0
0
        foreach my $field (@fields) {
1241
0
0
            my $isbn = $field->subfield('a');
1242
0
0
            if ($isbn) {
1243
0
0
                return _isbn_cleanup($isbn);
1244            } else {
1245
0
0
                return undef;
1246            }
1247        }
1248    }
1249    else { # assume marc21 if not unimarc
1250
0
0
        @fields = $record->field('020');
1251
0
0
        foreach my $field (@fields) {
1252
0
0
            $isbn = $field->subfield('a');
1253
0
0
            if ($isbn) {
1254
0
0
                return _isbn_cleanup($isbn);
1255            } else {
1256
0
0
                return undef;
1257            }
1258        }
1259    }
1260}
1261
1262sub GetNormalizedEAN {
1263
0
0
    my ($record,$marcflavour) = @_;
1264
0
0
    my (@fields,$ean);
1265
1266
0
0
    if ($marcflavour eq 'UNIMARC') {
1267
0
0
        @fields = $record->field('073');
1268
0
0
        foreach my $field (@fields) {
1269
0
0
            $ean = _normalize_match_point($field->subfield('a'));
1270
0
0
            if ($ean ne '') {
1271
0
0
                return $ean;
1272            }
1273        }
1274    }
1275    else { # assume marc21 if not unimarc
1276
0
0
        @fields = $record->field('024');
1277
0
0
        foreach my $field (@fields) {
1278
0
0
            my $indicator = $field->indicator(1);
1279
0
0
            $ean = _normalize_match_point($field->subfield('a'));
1280
0
0
            if ($indicator == 3 and $ean ne '') {
1281
0
0
                return $ean;
1282            }
1283        }
1284    }
1285}
1286sub GetNormalizedOCLCNumber {
1287
0
0
    my ($record,$marcflavour) = @_;
1288
0
0
    my (@fields,$oclc);
1289
1290
0
0
    if ($marcflavour eq 'UNIMARC') {
1291        # TODO: add UNIMARC fields
1292    }
1293    else { # assume marc21 if not unimarc
1294
0
0
        @fields = $record->field('035');
1295
0
0
        foreach my $field (@fields) {
1296
0
0
            $oclc = $field->subfield('a');
1297
0
0
            if ($oclc =~ /OCoLC/) {
1298
0
0
                $oclc =~ s/\(OCoLC\)//;
1299
0
0
                return $oclc;
1300            } else {
1301
0
0
                return undef;
1302            }
1303        }
1304    }
1305}
1306
1307sub _normalize_match_point {
1308
0
0
    my $match_point = shift;
1309
0
0
    (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1310
0
0
    $normalized_match_point =~ s/-//g;
1311
1312
0
0
    return $normalized_match_point;
1313}
1314
1315sub _isbn_cleanup {
1316
6
3184
    require Business::ISBN;
1317
6
23838
    my $isbn = Business::ISBN->new( $_[0] );
1318
6
1675
    if ( $isbn ) {
1319
6
99
        $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1320
6
767
        if (defined $isbn) {
1321
6
57
            return $isbn->as_string([]);
1322        }
1323    }
1324
0
    return;
1325}
1326
13271;
1328