C4/Biblio.pm

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