C4/Biblio.pm

   1 package C4::Biblio;
   2 # New XML API added by tgarip@neu.edu.tr 25/08/06
   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 use strict;
  20 require Exporter;
  21 use C4::Context;
  22 use XML::Simple;
  23 use Encode;
  24 use utf8;
  25
  26 use vars qw($VERSION @ISA @EXPORT);
  27
  28 # set the version for version checking
  29 $VERSION = 2.01;
  30
  31 @ISA = qw(Exporter);
  32
  33 # &itemcount removed, now  resides in Search.pm
  34 #
  35 @EXPORT = qw(
  36
  37 &getitemtypes
  38 &getkohafields
  39 &getshelves
  40
  41 &NEWnewbiblio
  42 &NEWnewitem
  43 &NEWmodbiblio
  44 &NEWmoditem
  45 &NEWdelbiblio
  46 &NEWdelitem
  47 &NEWmodbiblioframework
  48
  49
  50 &MARCfind_marc_from_kohafield
  51 &MARCfind_frameworkcode
  52 &MARCfind_itemtype
  53 &MARCgettagslib
  54 &MARCitemsgettagslib
  55
  56 &MARCfind_attr_from_kohafield
  57 &MARChtml2xml
  58
  59
  60 &XMLgetbiblio
  61 &XMLgetbibliohash
  62 &XMLgetitem
  63 &XMLgetitemhash
  64 &XMLgetallitems
  65 &XML_xml2hash
  66 &XML_xml2hash_onerecord
  67 &XML_hash2xml
  68 &XMLmarc2koha
  69 &XMLmarc2koha_onerecord
  70 &XML_readline
  71 &XML_readline_onerecord
  72 &XML_readline_asarray
  73 &XML_writeline
  74 &XML_writeline_id
  75 &XMLmoditemonefield
  76 &XMLkoha2marc
  77 &XML_separate
  78 &XML_record_header
  79 &ZEBRAdelbiblio
  80 &ZEBRAgetrecord
  81 &ZEBRAop
  82 &ZEBRAopserver
  83 &ZEBRA_readyXML
  84 &ZEBRA_readyXML_noheader
  85
  86 &newbiblio
  87 &modbiblio
  88 &DisplayISBN
  89
  90 );
  91
  92 #################### XML XML  XML  XML ###################
  93 ### XML Read- Write functions
  94 sub XML_readline_onerecord{
  95 my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
  96 #$xml represents one record of MARCXML as perlhashed
  97 ### $recordtype is needed for mapping the correct field
  98  ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
  99
 100 if ($tag){
 101 my $biblio=$xml->{'datafield'};
 102 my $controlfields=$xml->{'controlfield'};
 103 my $leader=$xml->{'leader'};
 104  if ($tag>9){
 105         foreach my $data (@$biblio){
 106             if ($data->{'tag'} eq $tag){
 107                 foreach my $subfield ( $data->{'subfield'}){
 108                     foreach my $code ( @$subfield){
 109                         if ($code->{'code'} eq $subf){
 110                         return $code->{'content'};
 111                         }
 112                    }
 113                 }
 114            }
 115         }
 116   }else{
 117         if ($tag eq "000" || $tag eq "LDR"){
 118                 return  $leader->[0] if $leader->[0];
 119         }else{
 120              foreach my $control (@$controlfields){
 121                 if ($control->{'tag'} eq $tag){
 122                 return  $control->{'content'} if $control->{'content'};
 123                 }
 124             }
 125         }
 126    }##tag
 127 }## if tag is mapped
 128 return "";
 129 }
 130 sub XML_readline_asarray{
 131 my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
 132 #$xml represents one record of MARCXML as perlhashed
 133 ## returns an array of read fields--useful for readind repeated fields
 134 ### $recordtype is needed for mapping the correct field if supplied
 135 ### If only $tag is give reads the whole tag
 136 my @value;
 137  ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
 138 if ($tag){
 139 my $biblio=$xml->{'datafield'};
 140 my $controlfields=$xml->{'controlfield'};
 141 my $leader=$xml->{'leader'};
 142  if ($tag>9){
 143         foreach my $data (@$biblio){
 144             if ($data->{'tag'} eq $tag){
 145                 foreach my $subfield ( $data->{'subfield'}){
 146                     foreach my $code ( @$subfield){
 147                         if ($code->{'code'} eq $subf || !$subf){
 148                         push @value, $code->{'content'};
 149                         }
 150                    }
 151                 }
 152            }
 153         }
 154   }else{
 155         if ($tag eq "000" || $tag eq "LDR"){
 156                 push @value,  $leader->[0] if $leader->[0];
 157         }else{
 158              foreach my $control (@$controlfields){
 159                 if ($control->{'tag'} eq $tag){
 160                 push @value,    $control->{'content'} if $control->{'content'};
 161
 162                 }
 163             }
 164         }
 165    }##tag
 166 }## if tag is mapped
 167 return @value;
 168 }
 169
 170 sub XML_readline{
 171 my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
 172 #$xml represents one record node hashed of holdings or a complete xml koharecord
 173 ### $recordtype is needed for reading the child records( like holdings records) .Otherwise main  record is assumed ( like biblio)
 174 ## holding records are parsed and sent here one by one
 175 # If kohafieldname given find tag
 176
 177 ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
 178 my @itemresults;
 179 if ($tag){
 180 if ($recordtype eq "holdings"){
 181         my $item=$xml->{'datafield'};
 182         my $hcontrolfield=$xml->{'controlfield'};
 183      if ($tag>9){
 184         foreach my $data (@$item){
 185             if ($data->{'tag'} eq $tag){
 186                 foreach my $subfield ( $data->{'subfield'}){
 187                     foreach my $code ( @$subfield){
 188                         if ($code->{'code'} eq $subf){
 189                         return $code->{content};
 190                         }
 191                    }
 192                 }
 193            }
 194         }
 195       }else{
 196         foreach my $control (@$hcontrolfield){
 197                 if ($control->{'tag'} eq $tag){
 198                 return  $control->{'content'};
 199                 }
 200         }
 201       }##tag
 202
 203 }else{ ##Not a holding read biblio
 204 my $biblio=$xml->{'record'}->[0]->{'datafield'};
 205 my $controlfields=$xml->{'record'}->[0]->{'controlfield'};
 206  if ($tag>9){
 207         foreach my $data (@$biblio){
 208             if ($data->{'tag'} eq $tag){
 209                 foreach my $subfield ( $data->{'subfield'}){
 210                     foreach my $code ( @$subfield){
 211                         if ($code->{'code'} eq $subf){
 212                         return $code->{'content'};
 213                         }
 214                    }
 215                 }
 216            }
 217         }
 218   }else{
 219
 220         foreach my $control (@$controlfields){
 221                 if ($control->{'tag'} eq $tag){
 222                 return  $control->{'content'}if $control->{'content'};
 223                 }
 224         }
 225    }##tag
 226 }## Holding or not
 227 }## if tag is mapped
 228 return "";
 229 }
 230
 231 sub XML_writeline{
 232 ## This routine modifies one line of marcxml record hash
 233 my ($xml,$kohafield,$newvalue,$recordtype,$tag,$subf)=@_;
 234 $newvalue= Encode::decode('utf8',$newvalue) if $newvalue;
 235 my $biblio=$xml->{'datafield'};
 236 my $controlfield=$xml->{'controlfield'};
 237  ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
 238 my $updated;
 239     if ($tag>9){
 240         foreach my $data (@$biblio){
 241                         if ($data->{'tag'} eq $tag){
 242                         my @subfields=$data->{'subfield'};
 243                         my @newsubs;
 244                         foreach my $subfield ( @subfields){
 245                               foreach my $code ( @$subfield){
 246                                 if ($code->{'code'} eq $subf){
 247                                 $code->{'content'}=$newvalue;
 248                                 $updated=1;
 249                                 }
 250                               push @newsubs,$code;
 251                               }
 252                         }
 253                      if (!$updated){
 254                          push @newsubs,{code=>$subf,content=>$newvalue};
 255                         $data->{subfield}= \@newsubs;
 256                         $updated=1;
 257                      }
 258                 }
 259          }
 260         ## Tag did not exist
 261              if (!$updated){
 262                 if ($subf){
 263                         push @$biblio,
 264                                            {
 265                                              'ind1' => ' ',
 266                                              'ind2' => ' ',
 267                                              'subfield' => [
 268                                                              {
 269                                                                'content' =>$newvalue,
 270                                                                'code' => $subf
 271                                                              }
 272                                                            ],
 273                                              'tag' =>$tag
 274                                            } ;
 275                    }else{
 276                         push @$biblio,
 277                                            {
 278                                              'ind1' => ' ',
 279                                              'ind2' => ' ',
 280                                              'tag' =>$tag
 281                                            } ;
 282                    }
 283            }## created now
 284     }elsif ($tag>0){
 285         foreach my $control (@$controlfield){
 286                 if ($control->{'tag'} eq $tag){
 287                         $control->{'content'}=$newvalue;
 288                         $updated=1;
 289                 }
 290              }
 291          if (!$updated){
 292            push @$controlfield,{tag=>$tag,content=>$newvalue};
 293         }
 294    }
 295 return $xml;
 296 }
 297
 298 sub XML_writeline_id {
 299 ### This routine is similar to XML_writeline but replaces a given value and do not create a new field
 300 ## Useful for repeating fields
 301 ## Currently  usedin authorities
 302 my ($xml,$oldvalue,$newvalue,$tag,$subf)=@_;
 303 $newvalue= Encode::decode('utf8',$newvalue) if $newvalue;
 304 my $biblio=$xml->{'datafield'};
 305 my $controlfield=$xml->{'controlfield'};
 306     if ($tag>9){
 307         foreach my $data (@$biblio){
 308                         if ($data->{'tag'} eq $tag){
 309                         my @subfields=$data->{'subfield'};
 310                         foreach my $subfield ( @subfields){
 311                               foreach my $code ( @$subfield){
 312                                 if ($code->{'code'} eq $subf && $code->{'content'} eq $oldvalue){
 313                                 $code->{'content'}=$newvalue;
 314                                 }
 315                               }
 316                         }
 317                 }
 318          }
 319     }else{
 320         foreach my $control(@$controlfield){
 321                 if ($control->{'tag'} eq $tag  && $control->{'content'} eq $oldvalue ){
 322                         $control->{'content'}=$newvalue;
 323                 }
 324              }
 325    }
 326 return $xml;
 327 }
 328
 329 sub XML_xml2hash{
 330 ##make a perl hash from xml file
 331 my ($xml)=@_;
 332   my $hashed = XMLin( $xml ,KeyAttr =>['leader','controlfield','datafield'],ForceArray => ['leader','controlfield','datafield','subfield','holdings','record'],KeepRoot=>0);
 333 return $hashed;
 334 }
 335
 336 sub XML_separate{
 337 ##Separates items from biblio
 338 my $hashed=shift;
 339 my $biblio=$hashed->{record}->[0];
 340 my @items;
 341 my $items=$hashed->{holdings}->[0]->{record};
 342 foreach my $item (@$items){
 343  push @items,$item;
 344 }
 345 return ($biblio,@items);
 346 }
 347
 348 sub XML_xml2hash_onerecord{
 349 ##make a perl hash from xml file
 350 my ($xml)=@_;
 351 return undef unless $xml;
 352   my $hashed = XMLin( $xml ,KeyAttr =>['leader','controlfield','datafield'],ForceArray => ['leader','controlfield','datafield','subfield'],KeepRoot=>0);
 353 return $hashed;
 354 }
 355 sub XML_hash2xml{
 356 ## turn a hash back to xml
 357 my ($hashed,$root)=@_;
 358 $root="record" unless $root;
 359 my $xml= XMLout($hashed,KeyAttr=>['leader','controlfıeld','datafield'],NoSort => 1,AttrIndent => 0,KeepRoot=>0,SuppressEmpty => 1,RootName=>$root );
 360 return $xml;
 361 }
 362
 363
 364
 365 sub XMLgetbiblio {
 366     # Returns MARC::XML of the biblionumber passed in parameter.
 367     my ( $dbh, $biblionumber ) = @_;
 368     my $sth =      $dbh->prepare("select marcxml from biblio where biblionumber=? "  );
 369     $sth->execute( $biblionumber);
 370    my ($marcxml)=$sth->fetchrow;
 371         $marcxml=Encode::decode('utf8',$marcxml);
 372  return ($marcxml);
 373 }
 374
 375 sub XMLgetbibliohash{
 376 ## Utility to return s hashed MARCXML
 377 my ($dbh,$biblionumber)=@_;
 378 my $xml=XMLgetbiblio($dbh,$biblionumber);
 379 my $xmlhash=XML_xml2hash_onerecord($xml);
 380 return $xmlhash;
 381 }
 382
 383 sub XMLgetitem {
 384    # Returns MARC::XML   of the item passed in parameter uses either itemnumber or barcode
 385     my ( $dbh, $itemnumber,$barcode ) = @_;
 386 my $sth;
 387 if ($itemnumber){
 388    $sth = $dbh->prepare("select marcxml from items  where itemnumber=?"  );
 389     $sth->execute($itemnumber);
 390 }else{
 391  $sth = $dbh->prepare("select marcxml from items where barcode=?"  );
 392     $sth->execute($barcode);
 393 }
 394  my ($marcxml)=$sth->fetchrow;
 395 $marcxml=Encode::decode('utf8',$marcxml);
 396     return ($marcxml);
 397 }
 398 sub XMLgetitemhash{
 399 ## Utility to return s hashed MARCXML
 400  my ( $dbh, $itemnumber,$barcode ) = @_;
 401 my $xml=XMLgetitem( $dbh, $itemnumber,$barcode);
 402 my $xmlhash=XML_xml2hash_onerecord($xml);
 403 return $xmlhash;
 404 }
 405
 406
 407 sub XMLgetallitems {
 408 # warn "XMLgetallitems";
 409     # Returns an array of MARC:XML   of the items passed in parameter as biblionumber
 410     my ( $dbh, $biblionumber ) = @_;
 411 my @results;
 412 my   $sth = $dbh->prepare("select marcxml from items where biblionumber =?"  );
 413     $sth->execute($biblionumber);
 414
 415  while(my ($marcxml)=$sth->fetchrow_array){
 416 $marcxml=Encode::decode('utf8',$marcxml);
 417     push @results,$marcxml;
 418 }
 419 return @results;
 420 }
 421
 422 sub XMLmarc2koha {
 423 # warn "XMLmarc2koha";
 424 ##Returns two hashes from KOHA_XML record hashed
 425 ## A biblio hash and and array of item hashes
 426         my ($dbh,$xml,$related_record,@fields) = @_;
 427         my ($result,@items);
 428
 429 ## if @fields is given do not bother about the rest of fields just parse those
 430
 431 if ($related_record eq "biblios" || $related_record eq "" || !$related_record){
 432         if (@fields){
 433                 foreach my $field(@fields){
 434                 my $val=&XML_readline($xml,$field,'biblios');
 435                         $result->{$field}=$val if $val;
 436
 437                 }
 438         }else{
 439         my $sth2=$dbh->prepare("SELECT  marctokoha from koha_attr where  recordtype like 'biblios' and tagfield is not null" );
 440         $sth2->execute();
 441         my $field;
 442                 while ($field=$sth2->fetchrow) {
 443                 $result->{$field}=&XML_readline($xml,$field,'biblios');
 444                 }
 445         }
 446
 447 ## we only need the following for biblio data
 448
 449 # modify copyrightdate to keep only the 1st year found
 450         my $temp = $result->{'copyrightdate'};
 451         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 452         if ($1>0) {
 453                 $result->{'copyrightdate'} = $1;
 454         } else { # if no cYYYY, get the 1st date.
 455                 $temp =~ m/(\d\d\d\d)/;
 456                 $result->{'copyrightdate'} = $1;
 457         }
 458 # modify publicationyear to keep only the 1st year found
 459         $temp = $result->{'publicationyear'};
 460         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 461         if ($1>0) {
 462                 $result->{'publicationyear'} = $1;
 463         } else { # if no cYYYY, get the 1st date.
 464                 $temp =~ m/(\d\d\d\d)/;
 465                 $result->{'publicationyear'} = $1;
 466         }
 467 }
 468 if ($related_record eq "holdings" || $related_record eq ""  || !$related_record){
 469 my $holdings=$xml->{holdings}->[0]->{record};
 470
 471
 472         if (@fields){
 473             foreach my $holding (@$holdings){
 474 my $itemresult;
 475                 foreach my $field(@fields){
 476                 my $val=&XML_readline($holding,$field,'holdings');
 477                 $itemresult->{$field}=$val if $val;
 478                 }
 479             push @items, $itemresult;
 480            }
 481         }else{
 482         my $sth2=$dbh->prepare("SELECT  marctokoha from koha_attr where recordtype like 'holdings' and tagfield is not null" );
 483            foreach my $holding (@$holdings){
 484            $sth2->execute();
 485             my $field;
 486 my $itemresult;
 487                 while ($field=$sth2->fetchrow) {
 488                 $itemresult->{$field}=&XML_readline($xml,$field,'holdings');
 489                 }
 490          push @items, $itemresult;
 491            }
 492         }
 493
 494 }
 495
 496         return ($result,@items);
 497 }
 498 sub XMLmarc2koha_onerecord {
 499 # warn "XMLmarc2koha_onerecord";
 500 ##Returns a koha hash from MARCXML hash
 501
 502         my ($dbh,$xml,$related_record,@fields) = @_;
 503         my ($result);
 504
 505 ## if @fields is given do not bother about the rest of fields just parse those
 506
 507         if (@fields){
 508                 foreach my $field(@fields){
 509                 my $val=&XML_readline_onerecord($xml,$field,$related_record);
 510                         $result->{$field}=$val if $val;
 511                 }
 512         }else{
 513         my $sth2=$dbh->prepare("SELECT  marctokoha from koha_attr where  recordtype like ? and tagfield is not null" );
 514         $sth2->execute($related_record);
 515         my $field;
 516                 while ($field=$sth2->fetchrow) {
 517                 $result->{$field}=&XML_readline_onerecord($xml,$field,$related_record);
 518                 }
 519         }
 520         return ($result);
 521 }
 522
 523 sub XMLmodLCindex{
 524 # warn "XMLmodLCindex";
 525 my ($dbh,$xmlhash)=@_;
 526 my ($lc)=XML_readline_onerecord($xmlhash,"classification","biblios");
 527 my ($cutter)=XML_readline_onerecord($xmlhash,"subclass","biblios");
 528
 529         if ($lc){
 530         $lc.=$cutter;
 531         my ($lcsort)=calculatelc($lc);
 532         $xmlhash=XML_writeline($xmlhash,"lcsort",$lcsort,"biblios");
 533         }
 534 return $xmlhash;
 535 }
 536
 537 sub XMLmoditemonefield{
 538 # This routine takes itemnumber and biblionumber and updates XMLmarc;
 539 ### the ZEBR DB update can wait depending on $donotupdate flag
 540 my ($dbh,$biblionumber,$itemnumber,$itemfield,$newvalue,$donotupdate)=@_;
 541 my ($record) = XMLgetitem($dbh,$itemnumber);
 542         my $recordhash=XML_xml2hash_onerecord($record);
 543         XML_writeline( $recordhash, $itemfield, $newvalue,"holdings" );
 544  if($donotupdate){
 545         ## Prevent various update calls to zebra wait until all changes finish
 546                 $record=XML_hash2xml($recordhash);
 547                 my $sth=$dbh->prepare("update items set marcxml=? where itemnumber=?");
 548                 $sth->execute($record,$itemnumber);
 549                 $sth->finish;
 550         }else{
 551                 NEWmoditem($dbh,$recordhash,$biblionumber,$itemnumber);
 552   }
 553
 554 }
 555
 556 sub XMLkoha2marc {
 557 # warn "MARCkoha2marc";
 558 ## This routine  is still used for acqui management
 559 ##Returns a  XML recordhash from a kohahash
 560         my ($dbh,$result,$recordtype) = @_;
 561 ###create a basic MARCXML
 562 # find today's date
 563 my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
 564         $year += 1900;
 565         $mon += 1;
 566         my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
 567                 $year,$mon,$mday,$hour,$min,$sec);
 568 $year=substr($year,2,2);
 569         my $accdate=sprintf("%2d%02d%02d",$year,$mon,$mday);
 570 my ($titletag,$titlesubf)=MARCfind_marc_from_kohafield("title","biblios");
 571 ##create a dummy record
 572 my $xml="<record><leader>     naa a22     7ar4500</leader><controlfield tag='xxx'></controlfield><datafield ind1='' ind2='' tag='$titletag'></datafield></record>";
 573 ## Now build XML
 574         my $record = XML_xml2hash($xml);
 575         my $sth2=$dbh->prepare("SELECT  marctokoha from koha_attr where tagfield is not null and recordtype=?");
 576         $sth2->execute($recordtype);
 577         my $field;
 578         while (($field)=$sth2->fetchrow) {
 579                 $record=XML_writeline($record,$field,$result->{$field},$recordtype) if $result->{$field};
 580         }
 581 return $record;
 582 }
 583
 584 #
 585 #
 586 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
 587 #
 588 ## Script to deal with MARCXML related tables
 589
 590
 591 ##Sub to match kohafield to Z3950 -attributes
 592
 593 sub MARCfind_attr_from_kohafield {
 594 # warn "MARCfind_attr_from_kohafield";
 595 ## returns attribute
 596     my (  $kohafield ) = @_;
 597     return 0, 0 unless $kohafield;
 598
 599         my $relations = C4::Context->attrfromkohafield;
 600         return ($relations->{$kohafield});
 601 }
 602
 603
 604 sub MARCgettagslib {
 605 # warn "MARCgettagslib";
 606     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
 607     $frameworkcode = "" unless $frameworkcode;
 608     my $sth;
 609     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
 610
 611     # check that framework exists
 612     $sth =
 613       $dbh->prepare(
 614         "select count(*) from biblios_tag_structure where frameworkcode=?");
 615     $sth->execute($frameworkcode);
 616     my ($total) = $sth->fetchrow;
 617     $frameworkcode = "" unless ( $total > 0 );
 618     $sth =
 619       $dbh->prepare(
 620 "select tagfield,liblibrarian,libopac,mandatory,repeatable from biblios_tag_structure where frameworkcode=? order by tagfield"
 621     );
 622     $sth->execute($frameworkcode);
 623     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
 624
 625     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
 626         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 627         $res->{$tab}->{tab}        = "";            # XXX
 628         $res->{$tag}->{mandatory}  = $mandatory;
 629         $res->{$tag}->{repeatable} = $repeatable;
 630     }
 631
 632     $sth =
 633       $dbh->prepare(
 634 "select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,seealso,hidden,isurl,link from biblios_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
 635     );
 636     $sth->execute($frameworkcode);
 637
 638     my $subfield;
 639     my $authorised_value;
 640     my $authtypecode;
 641     my $value_builder;
 642
 643     my $seealso;
 644     my $hidden;
 645     my $isurl;
 646         my $link;
 647
 648     while (
 649         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
 650         $mandatory,     $repeatable, $authorised_value, $authtypecode,
 651         $value_builder,   $seealso,          $hidden,
 652         $isurl,                 $link )
 653         = $sth->fetchrow
 654       )
 655     {
 656         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 657         $res->{$tag}->{$subfield}->{tab}              = $tab;
 658         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 659         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 660         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 661         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 662         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 663         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 664         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 665         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 666         $res->{$tag}->{$subfield}->{link}            = $link;
 667     }
 668     return $res;
 669 }
 670 sub MARCitemsgettagslib {
 671 # warn "MARCitemsgettagslib";
 672     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
 673     $frameworkcode = "" unless $frameworkcode;
 674     my $sth;
 675     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
 676
 677     # check that framework exists
 678     $sth =
 679       $dbh->prepare(
 680         "select count(*) from holdings_tag_structure where frameworkcode=?");
 681     $sth->execute($frameworkcode);
 682     my ($total) = $sth->fetchrow;
 683     $frameworkcode = "" unless ( $total > 0 );
 684     $sth =
 685       $dbh->prepare(
 686 "select tagfield,liblibrarian,libopac,mandatory,repeatable from holdings_tag_structure where frameworkcode=? order by tagfield"
 687     );
 688     $sth->execute($frameworkcode);
 689     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
 690
 691     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
 692         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 693         $res->{$tab}->{tab}        = "";            # XXX
 694         $res->{$tag}->{mandatory}  = $mandatory;
 695         $res->{$tag}->{repeatable} = $repeatable;
 696     }
 697
 698     $sth =
 699       $dbh->prepare(
 700 "select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,seealso,hidden,isurl,link from holdings_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
 701     );
 702     $sth->execute($frameworkcode);
 703
 704     my $subfield;
 705     my $authorised_value;
 706     my $authtypecode;
 707     my $value_builder;
 708
 709     my $seealso;
 710     my $hidden;
 711     my $isurl;
 712         my $link;
 713
 714     while (
 715         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
 716         $mandatory,     $repeatable, $authorised_value, $authtypecode,
 717         $value_builder, $seealso,          $hidden,
 718         $isurl,                 $link )
 719         = $sth->fetchrow
 720       )
 721     {
 722         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 723         $res->{$tag}->{$subfield}->{tab}              = $tab;
 724         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 725         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 726         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 727         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 728         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 729         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 730         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 731         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 732         $res->{$tag}->{$subfield}->{link}            = $link;
 733     }
 734     return $res;
 735 }
 736 sub MARCfind_marc_from_kohafield {
 737 # warn "MARCfind_marc_from_kohafield";
 738     my (  $kohafield,$recordtype) = @_;
 739     return 0, 0 unless $kohafield;
 740 $recordtype="biblios" unless $recordtype;
 741         my $relations = C4::Context->marcfromkohafield;
 742         return ($relations->{$recordtype}->{$kohafield}->[0],$relations->{$recordtype}->{$kohafield}->[1]);
 743 }
 744
 745
 746
 747
 748 sub MARCfind_frameworkcode {
 749 # warn "MARCfind_frameworkcode";
 750     my ( $dbh, $biblionumber ) = @_;
 751     my $sth =
 752       $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
 753     $sth->execute($biblionumber);
 754     my ($frameworkcode) = $sth->fetchrow;
 755     return $frameworkcode;
 756 }
 757 sub MARCfind_itemtype {
 758 # warn "MARCfind_itemtype";
 759     my ( $dbh, $biblionumber ) = @_;
 760     my $sth =
 761       $dbh->prepare("select itemtype from biblio where biblionumber=?");
 762     $sth->execute($biblionumber);
 763     my ($itemtype) = $sth->fetchrow;
 764     return $itemtype;
 765 }
 766
 767
 768
 769 sub MARChtml2xml {
 770 # warn "MARChtml2xml ";
 771         my ($tags,$subfields,$values,$indicator,$ind_tag,$tagindex) = @_;
 772         my $xml= "<record>";
 773
 774     my $prevvalue;
 775     my $prevtag=-1;
 776     my $first=1;
 777         my $j = -1;
 778     for (my $i=0;$i<=@$tags;$i++){
 779                 @$values[$i] =~ s/&/&amp;/g;
 780                 @$values[$i] =~ s/</&lt;/g;
 781                 @$values[$i] =~ s/>/&gt;/g;
 782                 @$values[$i] =~ s/"/&quot;/g;
 783                 @$values[$i] =~ s/'/&apos;/g;
 784
 785                 if ((@$tags[$i].@$tagindex[$i] ne $prevtag)){
 786                         my $tag=@$tags[$i];
 787                         $j++ unless ($tag eq "");
 788                         ## warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i];
 789                         if (!$first){
 790                         $xml.="</datafield>\n";
 791                                 if (($tag> 10) && (@$values[$i] ne "")){
 792                                                 my $ind1 = substr(@$indicator[$j],0,1);
 793                         my $ind2 = substr(@$indicator[$j],1,1);
 794                         $xml.="<datafield tag=\"$tag\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
 795                         $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
 796                         $first=0;
 797                                 } else {
 798                         $first=1;
 799                                 }
 800                                 } else {
 801                         if (@$values[$i] ne "") {
 802                                 # leader
 803                                 if ($tag eq "000") {
 804                                 ##Force the leader to UTF8
 805                                 substr(@$values[$i],9,1)="a";
 806                                                 $xml.="<leader>@$values[$i]</leader>\n";
 807                                                 $first=1;
 808                                         # rest of the fixed fields
 809                                 } elsif ($tag < 10) {
 810                                                 $xml.="<controlfield tag=\"$tag\">@$values[$i]</controlfield>\n";
 811                                                 $first=1;
 812                                 } else {
 813                                                 my $ind1 = substr(@$indicator[$j],0,1);
 814                                                 my $ind2 = substr(@$indicator[$j],1,1);
 815                                                 $xml.="<datafield tag=\"$tag\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
 816                                                 $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
 817                                                 $first=0;
 818                                 }
 819                         }
 820                         }
 821                 } else { # @$tags[$i] eq $prevtag
 822                                  unless (@$values[$i] eq "") {
 823                         my $tag=@$tags[$i];
 824                                         if ($first){
 825                                                 my $ind1 = substr(@$indicator[$j],0,1);
 826                                                 my $ind2 = substr(@$indicator[$j],1,1);
 827                                                 $xml.="<datafield tag=\"$tag\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
 828                                                 $first=0;
 829                                         }
 830                         $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
 831                                 }
 832                 }
 833                 $prevtag = @$tags[$i].@$tagindex[$i];
 834         }
 835         $xml.="</record>";
 836         # warn $xml;
 837         $xml=Encode::decode('utf8',$xml);
 838         return $xml;
 839 }
 840 sub XML_record_header {
 841 ####  this one is for <record>
 842     my $format = shift;
 843     my $enc = shift || 'UTF-8';
 844 ##
 845     return( <<MARC_XML_HEADER );
 846 <?xml version="1.0" encoding="$enc"?>
 847 <record  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
 848   xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
 849   xmlns="http://www.loc.gov/MARC21/slim">
 850 MARC_XML_HEADER
 851 }
 852
 853
 854 sub collection_header {
 855 ####  this one is for koha collection
 856     my $format = shift;
 857     my $enc = shift || 'UTF-8';
 858     return( <<KOHA_XML_HEADER );
 859 <?xml version="1.0" encoding="$enc"?>
 860 <kohacollection xmlns:marc="http://loc.gov/MARC21/slim" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:noNamespaceSchemaLocation="http://library.neu.edu.tr/kohanamespace/koharecord.xsd">
 861 KOHA_XML_HEADER
 862 }
 863
 864
 865
 866
 867
 868
 869
 870
 871 ##########################NEW NEW NEW#############################
 872 sub NEWnewbiblio {
 873     my ( $dbh, $xml, $frameworkcode) = @_;
 874 $frameworkcode="" unless $frameworkcode;
 875 my $biblionumber=XML_readline_onerecord($xml,"biblionumber","biblios");
 876 ## In case reimporting records with biblionumbers keep them
 877 if ($biblionumber){
 878 $biblionumber=NEWmodbiblio( $dbh, $biblionumber,$xml,$frameworkcode );
 879 }else{
 880     $biblionumber = NEWaddbiblio( $dbh, $xml,$frameworkcode );
 881 }
 882
 883    return ( $biblionumber );
 884 }
 885
 886
 887
 888
 889
 890 sub NEWmodbiblioframework {
 891         my ($dbh,$biblionumber,$frameworkcode) =@_;
 892         my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=$biblionumber");
 893         $sth->execute($frameworkcode);
 894         return 1;
 895 }
 896
 897
 898 sub NEWdelbiblio {
 899     my ( $dbh, $biblionumber ) = @_;
 900 ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver");
 901 }
 902
 903
 904 sub NEWnewitem {
 905     my ( $dbh, $xmlhash, $biblionumber ) = @_;
 906         my $itemtype= MARCfind_itemtype($dbh,$biblionumber);
 907
 908 ## In case we are re-importing marc records from bulk import do not change itemnumbers
 909 my $itemnumber=XML_readline_onerecord($xmlhash,"itemnumber","holdings");
 910 if ($itemnumber){
 911 NEWmoditem ( $dbh, $xmlhash, $biblionumber, $itemnumber);
 912 }else{
 913
 914 ##Add biblionumber to $record
 915 $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"holdings");
 916 #    MARCkoha2marcOnefield($record,"biblionumber",$biblionumber,"holdings");
 917  my $sth=$dbh->prepare("select notforloan from itemtypes where itemtype='$itemtype'");
 918 $sth->execute();
 919 my $notforloan=$sth->fetchrow;
 920 ##Change the notforloan field if $notforloan found
 921         if ($notforloan >0){
 922         $xmlhash=XML_writeline($xmlhash,"notforloan",$notforloan,"holdings");
 923         }
 924 my $dateaccessioned=XML_readline_onerecord($xmlhash,"dateaccessioned","holdings");
 925 unless($dateaccessioned){
 926 # find today's date
 927 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
 928 localtime(time); $year +=1900; $mon +=1;
 929 my $date = "$year-".sprintf ("%0.2d", $mon)."-".sprintf("%0.2d",$mday);
 930
 931 $xmlhash=XML_writeline($xmlhash,"dateaccessioned",$date,"holdings");
 932 }
 933
 934 ## Now calculate itempart of cutter-- This is NEU specific
 935 my $itemcallnumber=XML_readline_onerecord($xmlhash,"itemcallnumber","holdings");
 936 if ($itemcallnumber){
 937 my ($cutterextra)=itemcalculator($dbh,$biblionumber,$itemcallnumber);
 938 $xmlhash=XML_writeline($xmlhash,"cutterextra",$cutterextra,"holdings");
 939 }
 940
 941 ##NEU specific add cataloguers cardnumber as well
 942 my $me= C4::Context->userenv;
 943 my $cataloger=$me->{'cardnumber'} if ($me);
 944 $xmlhash=XML_writeline($xmlhash,"circid",$cataloger,"holdings") if $cataloger;
 945
 946 ##Add item to SQL
 947 my  $itemnumber = &OLDnewitems( $dbh, $xmlhash );
 948
 949 # add the item to zebra it will add the biblio as well!!!
 950     ZEBRAop( $dbh, $biblionumber,"specialUpdate","biblioserver" );
 951 return $itemnumber;
 952 }## added new item
 953
 954 }
 955
 956
 957
 958 sub NEWmoditem{
 959     my ( $dbh, $xmlhash, $biblionumber, $itemnumber ) = @_;
 960
 961 ##Add itemnumber incase lost (old bug 090c was lost sometimes) --just incase
 962 $xmlhash=XML_writeline($xmlhash,"itemnumber",$itemnumber,"holdings");
 963 ##Add biblionumber incase lost on html
 964 $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"holdings");
 965 ##Read barcode
 966 my $barcode=XML_readline_onerecord($xmlhash,"barcode","holdings");
 967 ## Now calculate itempart of cutter-- This is NEU specific
 968 my $itemcallnumber=XML_readline_onerecord($xmlhash,"itemcallnumber","holdings");
 969 if ($itemcallnumber){
 970 my ($cutterextra)=itemcalculator($dbh,$biblionumber,$itemcallnumber);
 971 $xmlhash=XML_writeline($xmlhash,"cutterextra",$cutterextra,"holdings");
 972 }
 973
 974 ##NEU specific add cataloguers cardnumber as well
 975 my $me= C4::Context->userenv;
 976 my $cataloger=$me->{'cardnumber'} if ($me);
 977 $xmlhash=XML_writeline($xmlhash,"circid",$cataloger,"holdings") if $cataloger;
 978 my $xml=XML_hash2xml($xmlhash);
 979     OLDmoditem( $dbh, $xml,$biblionumber,$itemnumber,$barcode );
 980     ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
 981 }
 982
 983 sub NEWdelitem {
 984     my ( $dbh, $itemnumber ) = @_;
 985 my $sth=$dbh->prepare("SELECT biblionumber from items where itemnumber=?");
 986 $sth->execute($itemnumber);
 987 my $biblionumber=$sth->fetchrow;
 988 OLDdelitem( $dbh, $itemnumber ) ;
 989 ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
 990
 991 }
 992
 993
 994
 995
 996 sub NEWaddbiblio {
 997     my ( $dbh, $xmlhash,$frameworkcode ) = @_;
 998      my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
 999     $sth->execute;
1000     my $data   = $sth->fetchrow;
1001     my $biblionumber = $data + 1;
1002     $sth->finish;
1003     # we must add biblionumber
1004 my $record;
1005 $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"biblios");
1006
1007 ###NEU specific add cataloguers cardnumber as well
1008
1009 my $me= C4::Context->userenv;
1010 my $cataloger=$me->{'cardnumber'} if ($me);
1011 $xmlhash=XML_writeline($xmlhash,"indexedby",$cataloger,"biblios") if $cataloger;
1012
1013 ## We must add the indexing fields for LC in MARC record--TG
1014 &XMLmodLCindex($dbh,$xmlhash);
1015
1016 ##Find itemtype
1017 my $itemtype=XML_readline_onerecord($xmlhash,"itemtype","biblios");
1018 ##Find ISBN
1019 my $isbn=XML_readline_onerecord($xmlhash,"isbn","biblios");
1020 ##Find ISSN
1021 my $issn=XML_readline_onerecord($xmlhash,"issn","biblios");
1022 ##Find Title
1023 my $title=XML_readline_onerecord($xmlhash,"title","biblios");
1024 ##Find Author
1025 my $author=XML_readline_onerecord($xmlhash,"title","biblios");
1026 my $xml=XML_hash2xml($xmlhash);
1027
1028     $sth = $dbh->prepare("insert into biblio set biblionumber  = ?,frameworkcode=?, itemtype=?,marcxml=?,title=?,author=?,isbn=?,issn=?" );
1029     $sth->execute( $biblionumber,$frameworkcode, $itemtype,$xml ,$title,$author,$isbn,$issn  );
1030
1031     $sth->finish;
1032 ### Do not add biblio to ZEBRA unless there is an item with it -- depends on system preference defaults to NO
1033 if (C4::Context->preference('AddaloneBiblios')){
1034  ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
1035 }
1036     return ($biblionumber);
1037 }
1038
1039 sub NEWmodbiblio {
1040     my ( $dbh, $biblionumber,$xmlhash,$frameworkcode ) = @_;
1041 ##Add biblionumber incase lost on html
1042
1043 $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"biblios");
1044
1045 ###NEU specific add cataloguers cardnumber as well
1046 my $me= C4::Context->userenv;
1047 my $cataloger=$me->{'cardnumber'} if ($me);
1048
1049 $xmlhash=XML_writeline($xmlhash,"indexedby",$cataloger,"biblios") if $cataloger;
1050
1051 ## We must add the indexing fields for LC in MARC record--TG
1052
1053   XMLmodLCindex($dbh,$xmlhash);
1054     OLDmodbiblio ($dbh,$xmlhash,$biblionumber,$frameworkcode);
1055     my $ok=ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
1056     return ($biblionumber);
1057 }
1058
1059 #
1060 #
1061 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1062 #
1063 #
1064
1065 sub OLDnewitems {
1066
1067     my ( $dbh, $xmlhash) = @_;
1068     my $sth = $dbh->prepare("SELECT max(itemnumber) from items");
1069     my $data;
1070     my $itemnumber;
1071     $sth->execute;
1072     $data       = $sth->fetchrow_hashref;
1073     $itemnumber = $data->{'max(itemnumber)'} + 1;
1074     $sth->finish;
1075       $xmlhash=XML_writeline(  $xmlhash, "itemnumber", $itemnumber,"holdings" );
1076 my $biblionumber=XML_readline_onerecord($xmlhash,"biblionumber","holdings");
1077  my $barcode=XML_readline_onerecord($xmlhash,"barcode","holdings");
1078 my $xml=XML_hash2xml($xmlhash);
1079         $sth = $dbh->prepare( "Insert into items set itemnumber = ?,    biblionumber  = ?,barcode = ?,marcxml=?"   );
1080         $sth->execute($itemnumber,$biblionumber,$barcode,$xml);
1081     return $itemnumber;
1082 }
1083
1084 sub OLDmoditem {
1085     my ( $dbh, $xml,$biblionumber,$itemnumber,$barcode  ) = @_;
1086     my $sth =$dbh->prepare("replace items set  biblionumber=?,marcxml=?,barcode=? , itemnumber=?");
1087     $sth->execute($biblionumber,$xml,$barcode,$itemnumber);
1088     $sth->finish;
1089 }
1090
1091 sub OLDdelitem {
1092     my ( $dbh, $itemnumber ) = @_;
1093 my $sth = $dbh->prepare("select * from items where itemnumber=?");
1094     $sth->execute($itemnumber);
1095     if ( my $data = $sth->fetchrow_hashref ) {
1096         $sth->finish;
1097         my $query = "replace deleteditems set ";
1098         my @bind  = ();
1099         foreach my $temp ( keys %$data ) {
1100             $query .= "$temp = ?,";
1101             push ( @bind, $data->{$temp} );
1102         }
1103
1104         #replacing the last , by ",?)"
1105         $query =~ s/\,$//;
1106         $sth = $dbh->prepare($query);
1107         $sth->execute(@bind);
1108         $sth->finish;
1109    $sth = $dbh->prepare("Delete from items where itemnumber=?");
1110     $sth->execute($itemnumber);
1111     $sth->finish;
1112   }
1113  $sth->finish;
1114 }
1115
1116 sub OLDmodbiblio {
1117 # modifies the biblio table
1118 my ($dbh,$xmlhash,$biblionumber,$frameworkcode) = @_;
1119         if (!$frameworkcode){
1120         $frameworkcode="";
1121         }
1122 ##Find itemtype
1123 my $itemtype=XML_readline_onerecord($xmlhash,"itemtype","biblios");
1124 ##Find ISBN
1125 my $isbn=XML_readline_onerecord($xmlhash,"isbn","biblios");
1126 ##Find ISSN
1127 my $issn=XML_readline_onerecord($xmlhash,"issn","biblios");
1128 ##Find Title
1129 my $title=XML_readline_onerecord($xmlhash,"title","biblios");
1130 ##Find Author
1131 my $author=XML_readline_onerecord($xmlhash,"author","biblios");
1132 my $xml=XML_hash2xml($xmlhash);
1133
1134 $isbn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g;
1135 $issn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g;
1136 $isbn=~s/^\s+|\s+$//g;
1137 $isbn=substr($isbn,0,13);
1138         my $sth = $dbh->prepare("REPLACE  biblio set biblionumber=?,marcxml=?,frameworkcode=? ,itemtype=? , title=?,author=?,isbn=?,issn=?" );
1139         $sth->execute( $biblionumber ,$xml, $frameworkcode,$itemtype, $title,$author,$isbn,$issn);
1140         $sth->finish;
1141     return $biblionumber;
1142 }
1143
1144 sub OLDdelbiblio {
1145     my ( $dbh, $biblionumber ) = @_;
1146     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1147     $sth->execute($biblionumber);
1148     if ( my $data = $sth->fetchrow_hashref ) {
1149         $sth->finish;
1150         my $query = "replace deletedbiblio set ";
1151         my @bind  = ();
1152            foreach my $temp ( keys %$data ) {
1153             $query .= "$temp = ?,";
1154             push ( @bind, $data->{$temp} );
1155            }
1156
1157         #replacing the last , by ",?)"
1158         $query =~ s/\,$//;
1159         $sth = $dbh->prepare($query);
1160         $sth->execute(@bind);
1161         $sth->finish;
1162         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1163         $sth->execute($biblionumber);
1164         $sth->finish;
1165     }
1166     $sth->finish;
1167 }
1168
1169
1170 #
1171 #
1172 #
1173 #ZEBRA ZEBRA ZEBRA
1174 #
1175 #
1176
1177 sub ZEBRAdelbiblio {
1178 ## Zebra calls this routine to delete after it deletes biblio from ZEBRAddb
1179  my ( $dbh, $biblionumber ) = @_;
1180 my $sth=$dbh->prepare("SELECT itemnumber FROM items where biblionumber=?");
1181
1182 $sth->execute($biblionumber);
1183         while (my $itemnumber =$sth->fetchrow){
1184         OLDdelitem($dbh,$itemnumber) ;
1185         }
1186 OLDdelbiblio($dbh,$biblionumber) ;
1187 }
1188
1189 sub ZEBRAgetrecord{
1190 my $biblionumber=shift;
1191 my @kohafield="biblionumber";
1192 my @value=$biblionumber;
1193 my ($count,@result)=C4::Search::ZEBRAsearch_kohafields(\@kohafield,\@value);
1194
1195    if ($count>0){
1196    my ( $xmlrecord, @itemsrecord) = XML_separate($result[0]);
1197    return ($xmlrecord, @itemsrecord);
1198    }else{
1199    return (undef,undef);
1200    }
1201 }
1202
1203 sub ZEBRAop {
1204 ### Puts the zebra update in queue writes in zebraserver table
1205 my ($dbh,$biblionumber,$op,$server)=@_;
1206 my ($record);
1207 my $sth=$dbh->prepare("insert into zebraqueue  (biblio_auth_number ,server,operation) values(?,?,?)");
1208 $sth->execute($biblionumber,$server,$op);
1209 }
1210
1211
1212 sub ZEBRAopserver{
1213
1214 ###Accepts a $server variable thus we can use it to update  biblios, authorities or other zebra dbs
1215 my ($record,$op,$server,$biblionumber)=@_;
1216 my @Zconnbiblio;
1217 my @port;
1218 my $Zpackage;
1219 my $tried=0;
1220 my $recon=0;
1221 my $reconnect=0;
1222 $record=Encode::encode("UTF-8",$record);
1223 my $shadow=$server."shadow";
1224 reconnect:
1225
1226 $Zconnbiblio[0]=C4::Context->Zconnauth($server);
1227 if ($record){
1228 my $Zpackage = $Zconnbiblio[0]->package();
1229 $Zpackage->option(action => $op);
1230         $Zpackage->option(record => $record);
1231         $Zpackage->option(recordIdOpaque => $biblionumber);
1232 retry:
1233                 $Zpackage->send("update");
1234 my $i;
1235 my $event;
1236
1237 while (($i = ZOOM::event(\@Zconnbiblio)) != 0) {
1238     $event = $Zconnbiblio[0]->last_event();
1239     last if $event == ZOOM::Event::ZEND;
1240 }
1241  my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x();
1242         if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update
1243                 sleep 1;        ##  wait a sec!
1244                 $tried=$tried+1;
1245                 goto "retry";
1246         }elsif ($error==2 && $tried<2) {## timeout --temporary zebra error !whatever that means
1247                 sleep 2;        ##  wait two seconds!
1248                 $tried=$tried+1;
1249                 goto "retry";
1250         }elsif($error==10004 && $recon==0){##Lost connection -reconnect
1251                 sleep 1;        ##  wait a sec!
1252                 $recon=1;
1253                 $Zpackage->destroy();
1254                 $Zconnbiblio[0]->destroy();
1255                 goto "reconnect";
1256         }elsif ($error){
1257         #       warn "Error-$server   $op  /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
1258                 $Zpackage->destroy();
1259                 $Zconnbiblio[0]->destroy();
1260         #       ZEBRAopfiles($dbh,$biblionumber,$record,$op,$server);
1261                 return 0;
1262         }
1263         ## System preference batchMode=1 means wea are bulk importing
1264         ## DO NOT COMMIT while in batchMode for faster operation
1265         my $batchmode=C4::Context->preference('batchMode');
1266          if (C4::Context->$shadow >0 && !$batchmode){
1267          $Zpackage->send('commit');
1268                 while (($i = ZOOM::event(\@Zconnbiblio)) != 0) {
1269                  $event = $Zconnbiblio[0]->last_event();
1270                 last if $event == ZOOM::Event::ZEND;
1271                 }
1272              my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x();
1273              if ($error) { ## This is serious ZEBRA server is not updating
1274              $Zpackage->destroy();
1275              $Zconnbiblio[0]->destroy();
1276              return 0;
1277             }
1278          }##commit
1279 #
1280 $Zpackage->destroy();
1281 $Zconnbiblio[0]->destroy();
1282 return 1;
1283 }
1284 return 0;
1285 }
1286
1287 sub ZEBRA_readyXML{
1288 my ($dbh,$biblionumber)=@_;
1289 my $biblioxml=XMLgetbiblio($dbh,$biblionumber);
1290 my @itemxml=XMLgetallitems($dbh,$biblionumber);
1291 my $zebraxml=collection_header();
1292 $zebraxml.="<koharecord>";
1293 $zebraxml.=$biblioxml;
1294 $zebraxml.="<holdings>";
1295       foreach my $item(@itemxml){
1296         $zebraxml.=$item if $item;
1297      }
1298 $zebraxml.="</holdings>";
1299 $zebraxml.="</koharecord>";
1300 $zebraxml.="</kohacollection>";
1301 return $zebraxml;
1302 }
1303
1304 sub ZEBRA_readyXML_noheader{
1305 my ($dbh,$biblionumber)=@_;
1306 my $biblioxml=XMLgetbiblio($dbh,$biblionumber);
1307 my @itemxml=XMLgetallitems($dbh,$biblionumber);
1308 my $zebraxml="<koharecord>";
1309 $zebraxml.=$biblioxml;
1310 $zebraxml.="<holdings>";
1311       foreach my $item(@itemxml){
1312         $zebraxml.=$item if $item;
1313      }
1314 $zebraxml.="</holdings>";
1315 $zebraxml.="</koharecord>";
1316 return $zebraxml;
1317 }
1318
1319 #
1320 #
1321 # various utility subs and those not complying to new rules
1322 #
1323 #
1324
1325 sub newbiblio {
1326 ## Used in acqui management -- creates the biblio from koha hash
1327     my ($biblio) = @_;
1328     my $dbh    = C4::Context->dbh;
1329 my $record=XMLkoha2marc($dbh,$biblio,"biblios");
1330    my $biblionumber=NEWnewbiblio($dbh,$record);
1331     return ($biblionumber);
1332 }
1333 sub modbiblio {
1334 ## Used in acqui management -- modifies the biblio from koha hash rather than xml-hash
1335     my ($biblio) = @_;
1336     my $dbh    = C4::Context->dbh;
1337 my $record=XMLkoha2marc($dbh,$biblio,"biblios");
1338    my $biblionumber=NEWmodbiblio($dbh,$record,$biblio->{biblionumber});
1339     return ($biblionumber);
1340 }
1341
1342 sub newitems {
1343 ## Used in acqui management -- creates the item from hash rather than marc-record
1344     my ( $item, @barcodes ) = @_;
1345     my $dbh = C4::Context->dbh;
1346     my $errors;
1347     my $itemnumber;
1348     my $error;
1349     foreach my $barcode (@barcodes) {
1350         $item->{barcode}=$barcode;
1351 my $record=MARCkoha2marc($dbh,$item,"holdings");
1352   my $itemnumber=     NEWnewitem($dbh,$record,$item->{biblionumber});
1353
1354     }
1355     return $itemnumber ;
1356 }
1357
1358
1359
1360
1361 sub getitemtypes {
1362     my $dbh   = C4::Context->dbh;
1363     my $query = "select * from itemtypes order by description";
1364     my $sth   = $dbh->prepare($query);
1365
1366     # || die "Cannot prepare $query" . $dbh->errstr;
1367     my $count = 0;
1368     my @results;
1369     $sth->execute;
1370     # || die "Cannot execute $query\n" . $sth->errstr;
1371     while ( my $data = $sth->fetchrow_hashref ) {
1372         $results[$count] = $data;
1373         $count++;
1374     }    # while
1375
1376     $sth->finish;
1377     return ( $count, @results );
1378 }    # sub getitemtypes
1379
1380
1381
1382 sub getkohafields{
1383 #returns MySQL like fieldnames to emulate searches on sql like fieldnames
1384 my $type=@_;
1385 ## Either opac or intranet to select appropriate fields
1386 ## Assumes intranet
1387 $type="intra" unless $type;
1388 if ($type eq "intranet"){ $type="intra";}
1389 my $dbh   = C4::Context->dbh;
1390   my $i=0;
1391 my @results;
1392 $type=$type."show";
1393 my $sth=$dbh->prepare("SELECT  * FROM koha_attr  where $type=1 order by liblibrarian");
1394 $sth->execute();
1395 while (my $data=$sth->fetchrow_hashref){
1396         $results[$i]=$data;
1397         $i++;
1398         }
1399 $sth->finish;
1400 return ($i,@results);
1401 }
1402
1403
1404
1405
1406
1407 sub DisplayISBN {
1408 ## Old style ISBN handling should be modified to accept 13 digits
1409
1410         my ($isbn)=@_;
1411         my $seg1;
1412         if(substr($isbn, 0, 1) <=7) {
1413                 $seg1 = substr($isbn, 0, 1);
1414         } elsif(substr($isbn, 0, 2) <= 94) {
1415                 $seg1 = substr($isbn, 0, 2);
1416         } elsif(substr($isbn, 0, 3) <= 995) {
1417                 $seg1 = substr($isbn, 0, 3);
1418         } elsif(substr($isbn, 0, 4) <= 9989) {
1419                 $seg1 = substr($isbn, 0, 4);
1420         } else {
1421                 $seg1 = substr($isbn, 0, 5);
1422         }
1423         my $x = substr($isbn, length($seg1));
1424         my $seg2;
1425         if(substr($x, 0, 2) <= 19) {
1426 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
1427                 $seg2 = substr($x, 0, 2);
1428         } elsif(substr($x, 0, 3) <= 699) {
1429                 $seg2 = substr($x, 0, 3);
1430         } elsif(substr($x, 0, 4) <= 8399) {
1431                 $seg2 = substr($x, 0, 4);
1432         } elsif(substr($x, 0, 5) <= 89999) {
1433                 $seg2 = substr($x, 0, 5);
1434         } elsif(substr($x, 0, 6) <= 9499999) {
1435                 $seg2 = substr($x, 0, 6);
1436         } else {
1437                 $seg2 = substr($x, 0, 7);
1438         }
1439         my $seg3=substr($x,length($seg2));
1440         $seg3=substr($seg3,0,length($seg3)-1) ;
1441         my $seg4 = substr($x, -1, 1);
1442         return "$seg1-$seg2-$seg3-$seg4";
1443 }
1444 sub calculatelc{
1445 ## Function to create padded LC call number for sorting items with their LC code. Not exported
1446 my  ($classification)=@_;
1447 $classification=~s/^\s+|\s+$//g;
1448 my $i=0;
1449 my $lc2;
1450 my $lc1;
1451 for  ($i=0; $i<length($classification);$i++){
1452 my $c=(substr($classification,$i,1));
1453         if ($c ge '0' && $c le '9'){
1454
1455         $lc2=substr($classification,$i);
1456         last;
1457         }else{
1458         $lc1.=substr($classification,$i,1);
1459
1460         }
1461 }#while
1462
1463 my $other=length($lc1);
1464 if(!$lc1){$other=0;}
1465 my $extras;
1466 if ($other<4){
1467         for (1..(4-$other)){
1468         $extras.="0";
1469         }
1470 }
1471  $lc1.=$extras;
1472 $lc2=~ s/^ //g;
1473
1474 $lc2=~ s/ //g;
1475 $extras="";
1476 ##Find the decimal part of $lc2
1477 my $pos=index($lc2,".");
1478 if ($pos<0){$pos=length($lc2);}
1479 if ($pos>=0 && $pos<5){
1480 ##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
1481
1482         for (1..(5-$pos)){
1483         $extras.="0";
1484         }
1485 }
1486 $lc2=$extras.$lc2;
1487 return($lc1.$lc2);
1488 }
1489
1490 sub itemcalculator{
1491 ## Sublimentary function to obtain sorted LC for items. Not exported
1492 my ($dbh,$biblionumber,$callnumber)=@_;
1493 my $xmlhash=XMLgetbibliohash($dbh,$biblionumber);
1494 my $lc=XML_readline_onerecord($xmlhash,"classification","biblios");
1495 my $cutter=XML_readline_onerecord($xmlhash,"subclass","biblios");
1496 my $all=$lc." ".$cutter;
1497 my $total=length($all);
1498 my $cutterextra=substr($callnumber,$total);
1499 return $cutterextra;
1500
1501 }
1502
1503
1504 #### This function allows decoding of only title and author out of a MARC record
1505   sub func_title_author {
1506         my ($tagno,$tagdata) = @_;
1507   my ($titlef,$subf)=&MARCfind_marc_from_kohafield("title","biblios");
1508   my ($authf,$subf)=&MARCfind_marc_from_kohafield("author","biblios");
1509         return ($tagno == $titlef || $tagno == $authf);
1510     }
1511
1512
1513
1514 END { }    # module clean-up code here (global destructor)
1515
1516 =back
1517
1518 =head1 AUTHOR
1519
1520 Koha Developement team <info@koha.org>
1521
1522
1523