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