C4/Koha.pm

   1 package C4::Koha;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 # $Id$
  21
  22 use strict;
  23 require Exporter;
  24 use C4::Context;
  25 use C4::Output;
  26 use vars qw($VERSION @ISA @EXPORT);
  27
  28 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
  29
  30 =head1 NAME
  31
  32 C4::Koha - Perl Module containing convenience functions for Koha scripts
  33
  34 =head1 SYNOPSIS
  35
  36   use C4::Koha;
  37
  38
  39 =head1 DESCRIPTION
  40
  41 Koha.pm provides many functions for Koha scripts.
  42
  43 =head1 FUNCTIONS
  44
  45 =over 2
  46
  47 =cut
  48
  49 @ISA    = qw(Exporter);
  50 @EXPORT = qw(
  51   &slashifyDate
  52   &DisplayISBN
  53   &subfield_is_koha_internal_p
  54   &GetPrinters &GetPrinter
  55   &GetItemTypes &getitemtypeinfo
  56   &GetCcodes
  57   &GetAuthItemlost
  58   &GetAuthItembinding
  59   &get_itemtypeinfos_of
  60   &getframeworks &getframeworkinfo
  61   &getauthtypes &getauthtype
  62   &getallthemes
  63   &getFacets
  64   &displaySortby
  65   &displayIndexes
  66   &displaySubtypesLimit
  67   &displayLimitTypes
  68   &displayServers
  69   &getnbpages
  70   &getitemtypeimagesrcfromurl
  71   &get_infos_of
  72   &get_notforloan_label_of
  73   &GetDepartments
  74   &GetDepartmentLib
  75   &getitemtypeimagedir
  76   &getitemtypeimagesrc
  77   &GetAuthorisedValues
  78   &FixEncoding
  79   &GetKohaAuthorisedValues
  80   $DEBUG
  81   );
  82
  83 my $DEBUG = 0;
  84
  85 =head2 slashifyDate
  86
  87   $slash_date = &slashifyDate($dash_date);
  88
  89 Takes a string of the form "DD-MM-YYYY" (or anything separated by
  90 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
  91
  92 =cut
  93
  94 sub slashifyDate {
  95
  96     # accepts a date of the form xx-xx-xx[xx] and returns it in the
  97     # form xx/xx/xx[xx]
  98     my @dateOut = split( '-', shift );
  99     return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
 100 }
 101
 102
 103 =head2 DisplayISBN
 104
 105 my $string = DisplayISBN( $isbn );
 106
 107 =cut
 108
 109 sub DisplayISBN {
 110     my ($isbn) = @_;
 111     my $seg1;
 112     if ( substr( $isbn, 0, 1 ) <= 7 ) {
 113         $seg1 = substr( $isbn, 0, 1 );
 114     }
 115     elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
 116         $seg1 = substr( $isbn, 0, 2 );
 117     }
 118     elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
 119         $seg1 = substr( $isbn, 0, 3 );
 120     }
 121     elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
 122         $seg1 = substr( $isbn, 0, 4 );
 123     }
 124     else {
 125         $seg1 = substr( $isbn, 0, 5 );
 126     }
 127     my $x = substr( $isbn, length($seg1) );
 128     my $seg2;
 129     if ( substr( $x, 0, 2 ) <= 19 ) {
 130
 131         #         if(sTmp2 < 10) sTmp2 = "0" sTmp2;
 132         $seg2 = substr( $x, 0, 2 );
 133     }
 134     elsif ( substr( $x, 0, 3 ) <= 699 ) {
 135         $seg2 = substr( $x, 0, 3 );
 136     }
 137     elsif ( substr( $x, 0, 4 ) <= 8399 ) {
 138         $seg2 = substr( $x, 0, 4 );
 139     }
 140     elsif ( substr( $x, 0, 5 ) <= 89999 ) {
 141         $seg2 = substr( $x, 0, 5 );
 142     }
 143     elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
 144         $seg2 = substr( $x, 0, 6 );
 145     }
 146     else {
 147         $seg2 = substr( $x, 0, 7 );
 148     }
 149     my $seg3 = substr( $x, length($seg2) );
 150     $seg3 = substr( $seg3, 0, length($seg3) - 1 );
 151     my $seg4 = substr( $x, -1, 1 );
 152     return "$seg1-$seg2-$seg3-$seg4";
 153 }
 154
 155 # FIXME.. this should be moved to a MARC-specific module
 156 sub subfield_is_koha_internal_p ($) {
 157     my ($subfield) = @_;
 158
 159     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
 160     # But real MARC subfields are always single-character
 161     # so it really is safer just to check the length
 162
 163     return length $subfield != 1;
 164 }
 165
 166 =head2 GetItemTypes
 167
 168   $itemtypes = &GetItemTypes();
 169
 170 Returns information about existing itemtypes.
 171
 172 build a HTML select with the following code :
 173
 174 =head3 in PERL SCRIPT
 175
 176 my $itemtypes = GetItemTypes;
 177 my @itemtypesloop;
 178 foreach my $thisitemtype (sort keys %$itemtypes) {
 179     my $selected = 1 if $thisitemtype eq $itemtype;
 180     my %row =(value => $thisitemtype,
 181                 selected => $selected,
 182                 description => $itemtypes->{$thisitemtype}->{'description'},
 183             );
 184     push @itemtypesloop, \%row;
 185 }
 186 $template->param(itemtypeloop => \@itemtypesloop);
 187
 188 =head3 in TEMPLATE
 189
 190 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 191     <select name="itemtype">
 192         <option value="">Default</option>
 193     <!-- TMPL_LOOP name="itemtypeloop" -->
 194         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
 195     <!-- /TMPL_LOOP -->
 196     </select>
 197     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 198     <input type="submit" value="OK" class="button">
 199 </form>
 200
 201
 202 =cut
 203
 204 sub GetItemTypes {
 205
 206     # returns a reference to a hash of references to branches...
 207     my %itemtypes;
 208     my $dbh   = C4::Context->dbh;
 209     my $query = qq|
 210         SELECT *
 211         FROM   itemtypes
 212     |;
 213     my $sth = $dbh->prepare($query);
 214     $sth->execute;
 215     while ( my $IT = $sth->fetchrow_hashref ) {
 216         $itemtypes{ $IT->{'itemtype'} } = $IT;
 217     }
 218     return ( \%itemtypes );
 219 }
 220
 221 sub get_itemtypeinfos_of {
 222     my @itemtypes = @_;
 223
 224     my $query = '
 225 SELECT itemtype,
 226        description,
 227        notforloan
 228   FROM itemtypes
 229   WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
 230 ';
 231
 232     return get_infos_of( $query, 'itemtype' );
 233 }
 234
 235 # this is temporary until we separate collection codes and item types
 236 sub GetCcodes {
 237     my $count = 0;
 238     my @results;
 239     my $dbh = C4::Context->dbh;
 240     my $sth =
 241       $dbh->prepare(
 242         "SELECT * FROM authorised_values ORDER BY authorised_value");
 243     $sth->execute;
 244     while ( my $data = $sth->fetchrow_hashref ) {
 245         if ( $data->{category} eq "CCODE" ) {
 246             $count++;
 247             $results[$count] = $data;
 248
 249             #warn "data: $data";
 250         }
 251     }
 252     $sth->finish;
 253     return ( $count, @results );
 254 }
 255
 256 =head2
 257
 258 grab itemlost authorized values
 259
 260 =cut
 261
 262 sub GetAuthItemlost {
 263     my $itemlost = shift;
 264     my $count    = 0;
 265     my @results;
 266     my $dbh = C4::Context->dbh;
 267     my $sth =
 268       $dbh->prepare(
 269         "SELECT * FROM authorised_values ORDER BY authorised_value");
 270     $sth->execute;
 271     while ( my $data = $sth->fetchrow_hashref ) {
 272         if ( $data->{category} eq "ITEMLOST" ) {
 273             $count++;
 274             if ( $itemlost eq $data->{'authorised_value'} ) {
 275                 $data->{'selected'} = 1;
 276             }
 277             $results[$count] = $data;
 278
 279             #warn "data: $data";
 280         }
 281     }
 282     $sth->finish;
 283     return ( $count, @results );
 284 }
 285
 286 =head2 GetAuthItembinding
 287
 288 grab itemlost authorized values
 289
 290 =cut
 291
 292 sub GetAuthItembinding {
 293     my $itembinding = shift;
 294     my $count       = 0;
 295     my @results;
 296     my $dbh = C4::Context->dbh;
 297     my $sth =
 298       $dbh->prepare(
 299         "SELECT * FROM authorised_values ORDER BY authorised_value");
 300     $sth->execute;
 301     while ( my $data = $sth->fetchrow_hashref ) {
 302         if ( $data->{category} eq "BINDING" ) {
 303             $count++;
 304             if ( $itembinding eq $data->{'authorised_value'} ) {
 305                 $data->{'selected'} = 1;
 306             }
 307             $results[$count] = $data;
 308
 309             #warn "data: $data";
 310         }
 311     }
 312     $sth->finish;
 313     return ( $count, @results );
 314 }
 315
 316 =head2 getauthtypes
 317
 318   $authtypes = &getauthtypes();
 319
 320 Returns information about existing authtypes.
 321
 322 build a HTML select with the following code :
 323
 324 =head3 in PERL SCRIPT
 325
 326 my $authtypes = getauthtypes;
 327 my @authtypesloop;
 328 foreach my $thisauthtype (keys %$authtypes) {
 329     my $selected = 1 if $thisauthtype eq $authtype;
 330     my %row =(value => $thisauthtype,
 331                 selected => $selected,
 332                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
 333             );
 334     push @authtypesloop, \%row;
 335 }
 336 $template->param(itemtypeloop => \@itemtypesloop);
 337
 338 =head3 in TEMPLATE
 339
 340 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 341     <select name="authtype">
 342     <!-- TMPL_LOOP name="authtypeloop" -->
 343         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
 344     <!-- /TMPL_LOOP -->
 345     </select>
 346     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 347     <input type="submit" value="OK" class="button">
 348 </form>
 349
 350
 351 =cut
 352
 353 sub getauthtypes {
 354
 355     # returns a reference to a hash of references to authtypes...
 356     my %authtypes;
 357     my $dbh = C4::Context->dbh;
 358     my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
 359     $sth->execute;
 360     while ( my $IT = $sth->fetchrow_hashref ) {
 361         $authtypes{ $IT->{'authtypecode'} } = $IT;
 362     }
 363     return ( \%authtypes );
 364 }
 365
 366 sub getauthtype {
 367     my ($authtypecode) = @_;
 368
 369     # returns a reference to a hash of references to authtypes...
 370     my %authtypes;
 371     my $dbh = C4::Context->dbh;
 372     my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
 373     $sth->execute($authtypecode);
 374     my $res = $sth->fetchrow_hashref;
 375     return $res;
 376 }
 377
 378 =head2 getframework
 379
 380   $frameworks = &getframework();
 381
 382 Returns information about existing frameworks
 383
 384 build a HTML select with the following code :
 385
 386 =head3 in PERL SCRIPT
 387
 388 my $frameworks = frameworks();
 389 my @frameworkloop;
 390 foreach my $thisframework (keys %$frameworks) {
 391     my $selected = 1 if $thisframework eq $frameworkcode;
 392     my %row =(value => $thisframework,
 393                 selected => $selected,
 394                 description => $frameworks->{$thisframework}->{'frameworktext'},
 395             );
 396     push @frameworksloop, \%row;
 397 }
 398 $template->param(frameworkloop => \@frameworksloop);
 399
 400 =head3 in TEMPLATE
 401
 402 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
 403     <select name="frameworkcode">
 404         <option value="">Default</option>
 405     <!-- TMPL_LOOP name="frameworkloop" -->
 406         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
 407     <!-- /TMPL_LOOP -->
 408     </select>
 409     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
 410     <input type="submit" value="OK" class="button">
 411 </form>
 412
 413
 414 =cut
 415
 416 sub getframeworks {
 417
 418     # returns a reference to a hash of references to branches...
 419     my %itemtypes;
 420     my $dbh = C4::Context->dbh;
 421     my $sth = $dbh->prepare("select * from biblio_framework");
 422     $sth->execute;
 423     while ( my $IT = $sth->fetchrow_hashref ) {
 424         $itemtypes{ $IT->{'frameworkcode'} } = $IT;
 425     }
 426     return ( \%itemtypes );
 427 }
 428
 429 =head2 getframeworkinfo
 430
 431   $frameworkinfo = &getframeworkinfo($frameworkcode);
 432
 433 Returns information about an frameworkcode.
 434
 435 =cut
 436
 437 sub getframeworkinfo {
 438     my ($frameworkcode) = @_;
 439     my $dbh             = C4::Context->dbh;
 440     my $sth             =
 441       $dbh->prepare("select * from biblio_framework where frameworkcode=?");
 442     $sth->execute($frameworkcode);
 443     my $res = $sth->fetchrow_hashref;
 444     return $res;
 445 }
 446
 447 =head2 getitemtypeinfo
 448
 449   $itemtype = &getitemtype($itemtype);
 450
 451 Returns information about an itemtype.
 452
 453 =cut
 454
 455 sub getitemtypeinfo {
 456     my ($itemtype) = @_;
 457     my $dbh        = C4::Context->dbh;
 458     my $sth        = $dbh->prepare("select * from itemtypes where itemtype=?");
 459     $sth->execute($itemtype);
 460     my $res = $sth->fetchrow_hashref;
 461
 462     $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
 463
 464     return $res;
 465 }
 466
 467 sub getitemtypeimagesrcfromurl {
 468     my ($imageurl) = @_;
 469
 470     if ( defined $imageurl and $imageurl !~ m/^http/ ) {
 471         $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
 472     }
 473
 474     return $imageurl;
 475 }
 476
 477 sub getitemtypeimagedir {
 478     return C4::Context->opachtdocs . '/'
 479       . C4::Context->preference('template')
 480       . '/itemtypeimg';
 481 }
 482
 483 sub getitemtypeimagesrc {
 484     return '/opac-tmpl' . '/'
 485       . C4::Context->preference('template')
 486       . '/itemtypeimg';
 487 }
 488
 489 =head2 GetPrinters
 490
 491   $printers = &GetPrinters($env);
 492   @queues = keys %$printers;
 493
 494 Returns information about existing printer queues.
 495
 496 C<$env> is ignored.
 497
 498 C<$printers> is a reference-to-hash whose keys are the print queues
 499 defined in the printers table of the Koha database. The values are
 500 references-to-hash, whose keys are the fields in the printers table.
 501
 502 =cut
 503
 504 sub GetPrinters {
 505     my ($env) = @_;
 506     my %printers;
 507     my $dbh = C4::Context->dbh;
 508     my $sth = $dbh->prepare("select * from printers");
 509     $sth->execute;
 510     while ( my $printer = $sth->fetchrow_hashref ) {
 511         $printers{ $printer->{'printqueue'} } = $printer;
 512     }
 513     return ( \%printers );
 514 }
 515
 516 =head2 GetPrinter
 517
 518 $printer = GetPrinter( $query, $printers );
 519
 520 =cut
 521
 522 sub GetPrinter ($$) {
 523     my ( $query, $printers ) = @_;    # get printer for this query from printers
 524     my $printer = $query->param('printer');
 525     my %cookie = $query->cookie('userenv');
 526     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
 527     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
 528     return $printer;
 529 }
 530
 531 =item getnbpages
 532
 533 Returns the number of pages to display in a pagination bar, given the number
 534 of items and the number of items per page.
 535
 536 =cut
 537
 538 sub getnbpages {
 539     my ( $nb_items, $nb_items_per_page ) = @_;
 540
 541     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
 542 }
 543
 544 =item getallthemes
 545
 546   (@themes) = &getallthemes('opac');
 547   (@themes) = &getallthemes('intranet');
 548
 549 Returns an array of all available themes.
 550
 551 =cut
 552
 553 sub getallthemes {
 554     my $type = shift;
 555     my $htdocs;
 556     my @themes;
 557     if ( $type eq 'intranet' ) {
 558         $htdocs = C4::Context->config('intrahtdocs');
 559     }
 560     else {
 561         $htdocs = C4::Context->config('opachtdocs');
 562     }
 563     opendir D, "$htdocs";
 564     my @dirlist = readdir D;
 565     foreach my $directory (@dirlist) {
 566         -d "$htdocs/$directory/en" and push @themes, $directory;
 567     }
 568     return @themes;
 569 }
 570
 571 sub getFacets {
 572     my $facets;
 573     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 574         $facets = [
 575             {
 576                 link_value  => 'su-to',
 577                 label_value => 'Topics',
 578                 tags        =>
 579                   [ '600', '601', '602', '603', '604', '605', '606', '610' ],
 580                 subfield => 'a',
 581             },
 582             {
 583                 link_value  => 'su-geo',
 584                 label_value => 'Places',
 585                 tags        => ['651'],
 586                 subfield    => 'a',
 587             },
 588             {
 589                 link_value  => 'su-ut',
 590                 label_value => 'Titles',
 591                 tags        => [ '500', '501', '502', '503', '504', ],
 592                 subfield    => 'a',
 593             },
 594             {
 595                 link_value  => 'au',
 596                 label_value => 'Authors',
 597                 tags        => [ '700', '701', '702', ],
 598                 subfield    => 'a',
 599             },
 600             {
 601                 link_value  => 'se',
 602                 label_value => 'Series',
 603                 tags        => ['225'],
 604                 subfield    => 'a',
 605             },
 606             {
 607                 link_value  => 'branch',
 608                 label_value => 'Branches',
 609                 tags        => [ '995', ],
 610                 subfield    => 'b',
 611                 expanded    => '1',
 612             },
 613         ];
 614     }
 615     else {
 616         $facets = [
 617             {
 618                 link_value  => 'su-to',
 619                 label_value => 'Topics',
 620                 tags        => ['650'],
 621                 subfield    => 'a',
 622             },
 623
 624             #        {
 625             #        link_value => 'su-na',
 626             #        label_value => 'People and Organizations',
 627             #        tags => ['600', '610', '611'],
 628             #        subfield => 'a',
 629             #        },
 630             {
 631                 link_value  => 'su-geo',
 632                 label_value => 'Places',
 633                 tags        => ['651'],
 634                 subfield    => 'a',
 635             },
 636             {
 637                 link_value  => 'su-ut',
 638                 label_value => 'Titles',
 639                 tags        => ['630'],
 640                 subfield    => 'a',
 641             },
 642             {
 643                 link_value  => 'au',
 644                 label_value => 'Authors',
 645                 tags        => [ '100', '110', '700', ],
 646                 subfield    => 'a',
 647             },
 648             {
 649                 link_value  => 'se',
 650                 label_value => 'Series',
 651                 tags        => [ '440', '490', ],
 652                 subfield    => 'a',
 653             },
 654             {
 655                 link_value  => 'branch',
 656                 label_value => 'Branches',
 657                 tags        => [ '952', ],
 658                 subfield    => 'b',
 659                 expanded    => '1',
 660             },
 661         ];
 662     }
 663     return $facets;
 664 }
 665
 666 =head2 get_infos_of
 667
 668 Return a href where a key is associated to a href. You give a query, the
 669 name of the key among the fields returned by the query. If you also give as
 670 third argument the name of the value, the function returns a href of scalar.
 671
 672   my $query = '
 673 SELECT itemnumber,
 674        notforloan,
 675        barcode
 676   FROM items
 677 ';
 678
 679   # generic href of any information on the item, href of href.
 680   my $iteminfos_of = get_infos_of($query, 'itemnumber');
 681   print $iteminfos_of->{$itemnumber}{barcode};
 682
 683   # specific information, href of scalar
 684   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
 685   print $barcode_of_item->{$itemnumber};
 686
 687 =cut
 688
 689 sub get_infos_of {
 690     my ( $query, $key_name, $value_name ) = @_;
 691
 692     my $dbh = C4::Context->dbh;
 693
 694     my $sth = $dbh->prepare($query);
 695     $sth->execute();
 696
 697     my %infos_of;
 698     while ( my $row = $sth->fetchrow_hashref ) {
 699         if ( defined $value_name ) {
 700             $infos_of{ $row->{$key_name} } = $row->{$value_name};
 701         }
 702         else {
 703             $infos_of{ $row->{$key_name} } = $row;
 704         }
 705     }
 706     $sth->finish;
 707
 708     return \%infos_of;
 709 }
 710
 711 =head2 get_notforloan_label_of
 712
 713   my $notforloan_label_of = get_notforloan_label_of();
 714
 715 Each authorised value of notforloan (information available in items and
 716 itemtypes) is link to a single label.
 717
 718 Returns a href where keys are authorised values and values are corresponding
 719 labels.
 720
 721   foreach my $authorised_value (keys %{$notforloan_label_of}) {
 722     printf(
 723         "authorised_value: %s => %s\n",
 724         $authorised_value,
 725         $notforloan_label_of->{$authorised_value}
 726     );
 727   }
 728
 729 =cut
 730
 731 sub get_notforloan_label_of {
 732     my $dbh = C4::Context->dbh;
 733
 734     my $query = '
 735 SELECT authorised_value
 736   FROM marc_subfield_structure
 737   WHERE kohafield = \'items.notforloan\'
 738   LIMIT 0, 1
 739 ';
 740     my $sth = $dbh->prepare($query);
 741     $sth->execute();
 742     my ($statuscode) = $sth->fetchrow_array();
 743
 744     $query = '
 745 SELECT lib,
 746        authorised_value
 747   FROM authorised_values
 748   WHERE category = ?
 749 ';
 750     $sth = $dbh->prepare($query);
 751     $sth->execute($statuscode);
 752     my %notforloan_label_of;
 753     while ( my $row = $sth->fetchrow_hashref ) {
 754         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
 755     }
 756     $sth->finish;
 757
 758     return \%notforloan_label_of;
 759 }
 760
 761 sub displaySortby {
 762     my ($sort_by) = @_;
 763     $sort_by =~ s/</\&lt;/;
 764     $sort_by =~ s/>/\&gt;/;
 765     my $sort_by_loop = [
 766         { value => "1=9523 &gt;i", label => "Popularity (Most to Least)" },
 767         { value => "1=9523 &lt;i", label => "Popularity (Least to Most)" },
 768         { value => "1=1003 &lt;i", label => "Author (A-Z)" },
 769         { value => "1=1003 &gt;i", label => "Author (Z-A)" },
 770         {
 771             value => "1=20 &lt;i",
 772             label => "Call Number (Non-fiction 0-9 to Fiction A-Z)"
 773         },
 774         {
 775             value => "1=20 &gt;i",
 776             label => "Call Number (Fiction Z-A to Non-fiction 9-0)"
 777         },
 778         { value => "1=31 &gt;i", label => "Dates" },
 779         {
 780             value => "1=31 &gt;i",
 781             label =>
 782               "&nbsp;&nbsp;&nbsp;Publication/Copyright Date: Newest to Oldest"
 783         },
 784         {
 785             value => "1=31 &lt;i",
 786             label =>
 787               "&nbsp;&nbsp;&nbsp;Publication/Copyright Date: Oldest to Newest"
 788         },
 789         {
 790             value => "1=32 &gt;i",
 791             label => "&nbsp;&nbsp;&nbsp;Acquisition Date: Newest to Oldest"
 792         },
 793         {
 794             value => "1=32 &lt;i",
 795             label => "&nbsp;&nbsp;&nbsp;Acquisition Date: Oldest to Newest"
 796         },
 797         { value => "1=36 &lt;i", label => "Title (A-Z)" },
 798         { value => "1=36 &gt;i", label => "Title (Z-A)" },
 799     ];
 800     for my $hash (@$sort_by_loop) {
 801
 802         #warn "sort by: $sort_by ... hash:".$hash->{value};
 803         if ($sort_by && $hash->{value} eq $sort_by ) {
 804             $hash->{selected} = "selected";
 805         }
 806     }
 807     return $sort_by_loop;
 808
 809 }
 810
 811 sub displayIndexes {
 812     my $indexes = [
 813         { value => '',   label => 'Keyword' },
 814         { value => 'au', label => 'Author' },
 815         {
 816             value => 'au,phr',
 817             label => '&nbsp;&nbsp;&nbsp;&nbsp; Author Phrase'
 818         },
 819         { value => 'cpn', label => '&nbsp;&nbsp;&nbsp;&nbsp; Corporate Name' },
 820         { value => 'cfn', label => '&nbsp;&nbsp;&nbsp;&nbsp; Conference Name' },
 821         {
 822             value => 'cpn,phr',
 823             label => '&nbsp;&nbsp;&nbsp;&nbsp; Corporate Name Phrase'
 824         },
 825         {
 826             value => 'cfn,phr',
 827             label => '&nbsp;&nbsp;&nbsp;&nbsp; Conference Name Phrase'
 828         },
 829         { value => 'pn', label => '&nbsp;&nbsp;&nbsp;&nbsp; Personal Name' },
 830         {
 831             value => 'pn,phr',
 832             label => '&nbsp;&nbsp;&nbsp;&nbsp; Personal Name Phrase'
 833         },
 834         { value => 'ln', label => 'Language' },
 835
 836         #    { value => 'mt', label => 'Material Type' },
 837         #    { value => 'mt,phr', label => 'Material Type Phrase' },
 838         #    { value => 'mc', label => 'Musical Composition' },
 839         #    { value => 'mc,phr', label => 'Musical Composition Phrase' },
 840
 841         { value => 'nt',  label => 'Notes/Comments' },
 842         { value => 'pb',  label => 'Publisher' },
 843         { value => 'pl',  label => 'Publisher Location' },
 844         { value => 'sn',  label => 'Standard Number' },
 845         { value => 'nb',  label => '&nbsp;&nbsp;&nbsp;&nbsp; ISBN' },
 846         { value => 'ns',  label => '&nbsp;&nbsp;&nbsp;&nbsp; ISSN' },
 847         { value => 'lcn', label => '&nbsp;&nbsp;&nbsp;&nbsp; Call Number' },
 848         { value => 'su',  label => 'Subject' },
 849         {
 850             value => 'su,phr',
 851             label => '&nbsp;&nbsp;&nbsp;&nbsp; Subject Phrase'
 852         },
 853
 854 #    { value => 'de', label => '&nbsp;&nbsp;&nbsp;&nbsp; Descriptor' },
 855 #    { value => 'ge', label => '&nbsp;&nbsp;&nbsp;&nbsp; Genre/Form' },
 856 #    { value => 'gc', label => '&nbsp;&nbsp;&nbsp;&nbsp; Geographic Coverage' },
 857
 858 #     { value => 'nc', label => '&nbsp;&nbsp;&nbsp;&nbsp; Named Corporation and Conference' },
 859 #     { value => 'na', label => '&nbsp;&nbsp;&nbsp;&nbsp; Named Person' },
 860
 861         { value => 'ti',     label => 'Title' },
 862         { value => 'ti,phr', label => '&nbsp;&nbsp;&nbsp;&nbsp; Title Phrase' },
 863         { value => 'se',     label => '&nbsp;&nbsp;&nbsp;&nbsp; Series Title' },
 864     ];
 865     return $indexes;
 866 }
 867
 868 sub displaySubtypesLimit {
 869     my $outer_subtype_limits_loop = [
 870
 871         {    # in MARC21, aud codes are stored in 008/22 (Target audience)
 872             name                      => "limit",
 873             inner_subtype_limits_loop => [
 874                 {
 875                     value    => '',
 876                     label    => 'Any Audience',
 877                     selected => "selected"
 878                 },
 879                 { value => 'aud:a', label => 'Easy', },
 880                 { value => 'aud:c', label => 'Juvenile', },
 881                 { value => 'aud:d', label => 'Young Adult', },
 882                 { value => 'aud:e', label => 'Adult', },
 883
 884             ],
 885         },
 886         {    # in MARC21, fic is in 008/33, bio in 008/34, mus in LDR/06
 887             name                      => "limit",
 888             inner_subtype_limits_loop => [
 889                 { value => '', label => 'Any Content', selected => "selected" },
 890                 { value => 'fic:1', label => 'Fiction', },
 891                 { value => 'fic:0', label => 'Non Fiction', },
 892                 { value => 'bio:b', label => 'Biography', },
 893                 { value => 'mus:j', label => 'Musical recording', },
 894                 { value => 'mus:i', label => 'Non-musical recording', },
 895
 896             ],
 897         },
 898         {    # MARC21, these are codes stored in 007/00-01
 899             name                      => "limit",
 900             inner_subtype_limits_loop => [
 901                 { value => '', label => 'Any Format', selected => "selected" },
 902                 { value => 'l-format:ta', label => 'Regular print', },
 903                 { value => 'l-format:tb', label => 'Large print', },
 904                 { value => 'l-format:fk', label => 'Braille', },
 905                 { value => '',            label => '-----------', },
 906                 { value => 'l-format:sd', label => 'CD audio', },
 907                 { value => 'l-format:ss', label => 'Cassette recording', },
 908                 {
 909                     value => 'l-format:vf',
 910                     label => 'VHS tape / Videocassette',
 911                 },
 912                 { value => 'l-format:vd', label => 'DVD video / Videodisc', },
 913                 { value => 'l-format:co', label => 'CD Software', },
 914                 { value => 'l-format:cr', label => 'Website', },
 915
 916             ],
 917         },
 918         {    # in MARC21, these are codes in 008/24-28
 919             name                      => "limit",
 920             inner_subtype_limits_loop => [
 921                 { value => '',        label => 'Additional Content Types', },
 922                 { value => 'ctype:a', label => 'Abstracts/summaries', },
 923                 { value => 'ctype:b', label => 'Bibliographies', },
 924                 { value => 'ctype:c', label => 'Catalogs', },
 925                 { value => 'ctype:d', label => 'Dictionaries', },
 926                 { value => 'ctype:e', label => 'Encyclopedias ', },
 927                 { value => 'ctype:f', label => 'Handbooks', },
 928                 { value => 'ctype:g', label => 'Legal articles', },
 929                 { value => 'ctype:i', label => 'Indexes', },
 930                 { value => 'ctype:j', label => 'Patent document', },
 931                 { value => 'ctype:k', label => 'Discographies', },
 932                 { value => 'ctype:l', label => 'Legislation', },
 933                 { value => 'ctype:m', label => 'Theses', },
 934                 { value => 'ctype:n', label => 'Surveys', },
 935                 { value => 'ctype:o', label => 'Reviews', },
 936                 { value => 'ctype:p', label => 'Programmed texts', },
 937                 { value => 'ctype:q', label => 'Filmographies', },
 938                 { value => 'ctype:r', label => 'Directories', },
 939                 { value => 'ctype:s', label => 'Statistics', },
 940                 { value => 'ctype:t', label => 'Technical reports', },
 941                 { value => 'ctype:v', label => 'Legal cases and case notes', },
 942                 { value => 'ctype:w', label => 'Law reports and digests', },
 943                 { value => 'ctype:z', label => 'Treaties ', },
 944             ],
 945         },
 946     ];
 947     return $outer_subtype_limits_loop;
 948 }
 949
 950 sub displayLimitTypes {
 951     my $outer_limit_types_loop = [
 952
 953         {
 954             inner_limit_types_loop => [
 955                 {
 956                     label => "Books",
 957                     id    => "mc-books",
 958                     name  => "limit",
 959                     value => "(mc-collection:AF or mc-collection:MYS or mc-collection:SCI or mc-collection:NF or mc-collection:YA or mc-collection:BIO or mc-collection:LP or mc-collection:LPNF)",
 960                     icon  => "search-books.gif",
 961                     title =>
 962 "Books, Pamphlets, Technical reports, Manuscripts, Legal papers, Theses and dissertations",
 963                 },
 964
 965                 {
 966                     label => "Movies",
 967                     id    => "mc-movies",
 968                     name  => "limit",
 969                     value => "(mc-collection:DVD or mc-collection:AV or mc-collection:AVJ or mc-collection:AVJN or mc-collection:AVJNF or mc-collection:AVNF)",
 970                     icon  => "search-movies.gif",
 971                     title =>
 972 "Motion pictures, Videorecordings, Filmstrips, Slides, Transparencies, Photos, Cards, Charts, Drawings",
 973                 },
 974
 975                 {
 976                                         label => "Music",
 977                                 id => "mc-music",
 978                     name  => "limit",
 979                     value => "(mc-collection:CDM)",
 980                     icon  => "search-music.gif",
 981                     title => "Spoken, Books on CD and Cassette",
 982                 },
 983             ],
 984         },
 985         {
 986             inner_limit_types_loop => [
 987                 {
 988                     label => "Audio Books",
 989                                         id => "mc-audio-books",
 990                     name  => "limit",
 991                     value => "(mc-collection:AB or mc-collection:AC or mc-collection:JAC or mc-collection:YAC)",
 992                     icon  => "search-audio-books.gif",
 993                     title => "Spoken, Books on CD and Cassette",
 994                 },
 995
 996                 {
 997                     label => "Local History Materials",
 998                                 id => "mc-local-history",
 999                     name  => "limit",
1000                     value => "mc-collection:LH",
1001                     icon  => "Local history.gif",
1002                     title => "Local History Materials",
1003                 },
1004
1005     {label => "Large Print",
1006     id => "mc-large-print",
1007                     name  => "limit",
1008     value => "(mc-collection:LP or mc-collection:LPNF)",
1009     icon => "search-large-print.gif ",
1010     title => "Large Print",},
1011             ],
1012         },
1013 { inner_limit_types_loop => [
1014     {label => "Kids",
1015     id => "mc-kids",
1016                     name  => "limit",
1017     value => "(mc-collection:EASY or mc-collection:JNF or mc-collection:JF or mc-collection:JREF or mc-collection:JB)",
1018     icon => "search-kids.gif",
1019     title => "Music",},
1020
1021     {label => "Software/Internet",
1022     id => "mc-sofware-web",
1023                     name  => "limit",
1024     value => "(mc-collection:CDR)",
1025     icon => "search-software-web.gif",
1026     title => "Kits",},
1027
1028     {label => "Reference",
1029     id => "mc-reference",
1030                     name  => "limit",
1031                     value => "mc-collection:REF",
1032     icon => "search-reference.gif",
1033     title => "Reference",},
1034
1035             ],
1036         },
1037
1038     ];
1039     return $outer_limit_types_loop;
1040 }
1041
1042 sub displayServers {
1043     my ( $position, $type ) = @_;
1044     my $dbh    = C4::Context->dbh;
1045     my $strsth = "SELECT * FROM z3950servers where 1";
1046     $strsth .= " AND position=\"$position\"" if ($position);
1047     $strsth .= " AND type=\"$type\""         if ($type);
1048     my $rq = $dbh->prepare($strsth);
1049     $rq->execute;
1050     my @primaryserverloop;
1051
1052     while ( my $data = $rq->fetchrow_hashref ) {
1053         my %cell;
1054         $cell{label} = $data->{'description'};
1055         $cell{id}    = $data->{'name'};
1056         $cell{value} =
1057             $data->{host}
1058           . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
1059           . $data->{database}
1060           if ( $data->{host} );
1061         $cell{checked} = $data->{checked};
1062         push @primaryserverloop,
1063           {
1064             label => $data->{description},
1065             id    => $data->{name},
1066             name  => "server",
1067             value => $data->{host} . ":"
1068               . $data->{port} . "/"
1069               . $data->{database},
1070             checked    => "checked",
1071             icon       => $data->{icon},
1072             zed        => $data->{type} eq 'zed',
1073             opensearch => $data->{type} eq 'opensearch'
1074           };
1075     }
1076     return \@primaryserverloop;
1077 }
1078
1079 sub displaySecondaryServers {
1080
1081 #       my $secondary_servers_loop = [
1082 #               { inner_sup_servers_loop => [
1083 #               {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
1084 #               {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
1085 #               {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
1086 #               {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
1087 #       ],
1088 #       },
1089 #       ];
1090     return;    #$secondary_servers_loop;
1091 }
1092
1093 sub GetDepartments {
1094     my $dbh = C4::Context->dbh;
1095     my $sth = $dbh->prepare(
1096         "SELECT authorised_value,lib FROM authorised_values WHERE category='DPT'
1097         "
1098     );
1099     $sth->execute;
1100     my @getdepartments;
1101     my $i = 0;
1102     while ( my $data = $sth->fetchrow_hashref ) {
1103         $getdepartments[$i] = $data;
1104         $i++;
1105     }
1106     $sth->finish;
1107     return (@getdepartments);
1108 }
1109
1110 sub GetDepartmentLib {
1111     my ($authorisedvalue) = @_;
1112     my $dbh               = C4::Context->dbh;
1113     my $sth               = $dbh->prepare(
1114 "SELECT lib,authorised_value FROM authorised_values WHERE category='DPT' AND authorised_value=?
1115         "
1116     );
1117     $sth->execute($authorisedvalue);
1118     my (@lib) = $sth->fetchrow_array;
1119     $sth->finish;
1120     return (@lib);
1121 }
1122
1123 =head2 GetAuthorisedValues
1124
1125 $authvalues = GetAuthorisedValues($category);
1126
1127 this function get all authorised values from 'authosied_value' table into a reference to array which
1128 each value containt an hashref.
1129
1130 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
1131
1132 =cut
1133
1134 sub GetAuthorisedValues {
1135     my $category = shift;
1136     my $dbh      = C4::Context->dbh;
1137     my $query    = "SELECT * FROM authorised_values";
1138     $query .= " WHERE category = '" . $category . "'" if $category;
1139
1140     my $sth = $dbh->prepare($query);
1141     $sth->execute;
1142     my $data = $sth->fetchall_arrayref({});
1143     return $data;
1144 }
1145
1146 =item fixEncoding
1147
1148   $marcrecord = &fixEncoding($marcblob);
1149
1150 Returns a well encoded marcrecord.
1151
1152 =cut
1153 sub FixEncoding {
1154   my $marc=shift;
1155   my $record = MARC::Record->new_from_usmarc($marc);
1156   if (C4::Context->preference("MARCFLAVOUR") eq "UNIMARC"){
1157     use Encode::Guess;
1158     my $targetcharset="utf8" if (C4::Context->preference("TemplateEncoding") eq "utf-8");
1159     $targetcharset="latin1" if (C4::Context->preference("TemplateEncoding") eq "iso-8859-1");
1160     my $decoder = guess_encoding($marc, qw/utf8 latin1/);
1161 #     die $decoder unless ref($decoder);
1162     if (ref($decoder)) {
1163         my $newRecord=MARC::Record->new();
1164         foreach my $field ($record->fields()){
1165         if ($field->tag()<'010'){
1166             $newRecord->insert_grouped_field($field);
1167         } else {
1168             my $newField;
1169             my $createdfield=0;
1170             foreach my $subfield ($field->subfields()){
1171             if ($createdfield){
1172                 if (($newField->tag eq '100')) {
1173                 substr($subfield->[1],26,2,"0103") if ($targetcharset eq "latin1");
1174                 substr($subfield->[1],26,4,"5050") if ($targetcharset eq "utf8");
1175                 }
1176                 map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
1177                 $newField->add_subfields($subfield->[0]=>$subfield->[1]);
1178             } else {
1179                 map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
1180                 $newField=MARC::Field->new($field->tag(),$field->indicator(1),$field->indicator(2),$subfield->[0]=>$subfield->[1]);
1181                 $createdfield=1;
1182             }
1183             }
1184             $newRecord->insert_grouped_field($newField);
1185         }
1186         }
1187     #     warn $newRecord->as_formatted();
1188         return $newRecord;
1189     } else {
1190         return $record;
1191     }
1192   } else {
1193     return $record;
1194   }
1195 }
1196
1197 =head2 GetKohaAuthorisedValues
1198
1199         Takes $dbh , $kohafield as parameters.
1200         returns hashref of authvalCode => liblibrarian
1201         or undef if no authvals defined for kohafield.
1202
1203 =cut
1204
1205 sub GetKohaAuthorisedValues {
1206   my ($kohafield) = @_;
1207   my %values;
1208   my $dbh = C4::Context->dbh;
1209   my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=?');
1210   $sthnflstatus->execute($kohafield);
1211   my $authorised_valuecode = $sthnflstatus->fetchrow;
1212   if ($authorised_valuecode) {
1213     $sthnflstatus = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1214     $sthnflstatus->execute($authorised_valuecode);
1215     while ( my ($val, $lib) = $sthnflstatus->fetchrow_array ) {
1216       $values{$val}= $lib;
1217     }
1218   }
1219   return \%values;
1220 }
1221
1222
1223 1;
1224
1225 __END__
1226
1227 =back
1228
1229 =head1 AUTHOR
1230
1231 Koha Team
1232
1233 =cut