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