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