Bug 7941 : Fix version numbers in modules
[koha.git] / C4 / Biblio.pm
index 4a9735f..1ab4fff 100644 (file)
@@ -27,7 +27,6 @@ use Carp;
 use MARC::Record;
 use MARC::File::USMARC;
 use MARC::File::XML;
-use ZOOM;
 use POSIX qw(strftime);
 
 use C4::Koha;
@@ -35,14 +34,13 @@ use C4::Dates qw/format_date/;
 use C4::Log;    # logaction
 use C4::ClassSource;
 use C4::Charset;
-require C4::Heading;
-require C4::Serials;
-require C4::Items;
+use C4::Linker;
+use C4::OAI::Sets;
 
 use vars qw($VERSION @ISA @EXPORT);
 
 BEGIN {
-    $VERSION = 1.00;
+    $VERSION = 3.07.00.049;
 
     require Exporter;
     @ISA = qw( Exporter );
@@ -74,6 +72,7 @@ BEGIN {
       &GetMarcControlnumber
       &GetMarcNotes
       &GetMarcISBN
+      &GetMarcISSN
       &GetMarcSubjects
       &GetMarcBiblio
       &GetMarcAuthors
@@ -84,6 +83,7 @@ BEGIN {
       &GetXmlBiblio
       &GetCOinSBiblio
       &GetMarcPrice
+      &MungeMarcPrice
       &GetMarcQuantity
 
       &GetAuthorisedValueDesc
@@ -114,6 +114,7 @@ BEGIN {
     # To link headings in a bib record
     # to authority records.
     push @EXPORT, qw(
+      &BiblioAutoLink
       &LinkBibHeadingsToAuthorities
     );
 
@@ -131,22 +132,18 @@ BEGIN {
       &TransformHtmlToMarc2
       &TransformHtmlToMarc
       &TransformHtmlToXml
-      &PrepareItemrecordDisplay
       &GetNoZebraIndexes
+      prepare_host_field
     );
 }
 
 eval {
-    my $servers = C4::Context->config('memcached_servers');
-    if ($servers) {
+    if (C4::Context->ismemcached) {
         require Memoize::Memcached;
         import Memoize::Memcached qw(memoize_memcached);
 
-        my $memcached = {
-            servers    => [$servers],
-            key_prefix => C4::Context->config('memcached_namespace') || 'koha',
-        };
-        memoize_memcached( 'GetMarcStructure', memcached => $memcached, expire_time => 600 );    #cache for 10 minutes
+        memoize_memcached( 'GetMarcStructure',
+                            memcached => C4::Context->memcached);
     }
 };
 
@@ -274,6 +271,11 @@ sub AddBiblio {
     # now add the record
     ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
 
+    # update OAI-PMH sets
+    if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
+        C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
+    }
+
     logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
     return ( $biblionumber, $biblioitemnumber );
 }
@@ -320,7 +322,7 @@ sub ModBiblio {
     SetUTF8Flag($record);
     my $dbh = C4::Context->dbh;
 
-    $frameworkcode = "" unless $frameworkcode;
+    $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
 
     _strip_item_fields($record, $frameworkcode);
 
@@ -345,6 +347,12 @@ sub ModBiblio {
     # modify the other koha tables
     _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
     _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
+
+    # update OAI-PMH sets
+    if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
+        C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
+    }
+
     return 1;
 }
 
@@ -389,7 +397,7 @@ sub ModBiblioframework {
 
 =head2 DelBiblio
 
-  my $error = &DelBiblio($dbh,$biblionumber);
+  my $error = &DelBiblio($biblionumber);
 
 Exported function (core API) for deleting a biblio in koha.
 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
@@ -417,9 +425,17 @@ sub DelBiblio {
     return $error if $error;
 
     # We delete attached subscriptions
-    my $subscriptions = &C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
+    require C4::Serials;
+    my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
     foreach my $subscription (@$subscriptions) {
-        &C4::Serials::DelSubscription( $subscription->{subscriptionid} );
+        C4::Serials::DelSubscription( $subscription->{subscriptionid} );
+    }
+
+    # We delete any existing holds
+    require C4::Reserves;
+    my ($count, $reserves) = C4::Reserves::GetReservesFromBiblionumber($biblionumber);
+    foreach my $res ( @$reserves ) {
+        C4::Reserves::CancelReserve( $res->{'biblionumber'}, $res->{'itemnumber'}, $res->{'borrowernumber'} );
     }
 
     # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
@@ -457,9 +473,42 @@ sub DelBiblio {
     return;
 }
 
+
+=head2 BiblioAutoLink
+
+  my $headings_linked = BiblioAutoLink($record, $frameworkcode)
+
+Automatically links headings in a bib record to authorities.
+
+=cut
+
+sub BiblioAutoLink {
+    my $record        = shift;
+    my $frameworkcode = shift;
+    my ( $num_headings_changed, %results );
+
+    my $linker_module =
+      "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
+    eval { eval "require $linker_module"; };
+    if ($@) {
+        $linker_module = 'C4::Linker::Default';
+        eval "require $linker_module";
+    }
+    if ($@) {
+        return 0, 0;
+    }
+
+    my $linker = $linker_module->new(
+        { 'options' => C4::Context->preference("LinkerOptions") } );
+    my ( $headings_changed, undef ) =
+      LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
+    # By default we probably don't want to relink things when cataloging
+    return $headings_changed;
+}
+
 =head2 LinkBibHeadingsToAuthorities
 
-  my $headings_linked = LinkBibHeadingsToAuthorities($marc);
+  my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
 
 Links bib headings to authority records by checking
 each authority-controlled field in the C<MARC::Record>
@@ -467,9 +516,9 @@ object C<$marc>, looking for a matching authority record,
 and setting the linking subfield $9 to the ID of that
 authority record.  
 
-If no matching authority exists, or if multiple
-authorities match, no $9 will be added, and any 
-existing one inthe field will be deleted.
+If $allowrelink is false, existing authids will never be
+replaced, regardless of the values of LinkerKeepStale and
+LinkerRelink.
 
 Returns the number of heading links changed in the
 MARC record.
@@ -477,37 +526,112 @@ MARC record.
 =cut
 
 sub LinkBibHeadingsToAuthorities {
-    my $bib = shift;
+    my $linker        = shift;
+    my $bib           = shift;
+    my $frameworkcode = shift;
+    my $allowrelink = shift;
+    my %results;
+    require C4::Heading;
+    require C4::AuthoritiesMarc;
 
+    $allowrelink = 1 unless defined $allowrelink;
     my $num_headings_changed = 0;
     foreach my $field ( $bib->fields() ) {
-        my $heading = C4::Heading->new_from_bib_field($field);
+        my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
         next unless defined $heading;
 
         # check existing $9
         my $current_link = $field->subfield('9');
 
-        # look for matching authorities
-        my $authorities = $heading->authorities();
+        if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
+        {
+            $results{'linked'}->{ $heading->display_form() }++;
+            next;
+        }
 
-        # want only one exact match
-        if ( $#{$authorities} == 0 ) {
-            my $authority = MARC::Record->new_from_usmarc( $authorities->[0] );
-            my $authid    = $authority->field('001')->data();
-            next if defined $current_link and $current_link eq $authid;
+        my ( $authid, $fuzzy ) = $linker->get_link($heading);
+        if ($authid) {
+            $results{ $fuzzy ? 'fuzzy' : 'linked' }
+              ->{ $heading->display_form() }++;
+            next if defined $current_link and $current_link == $authid;
 
             $field->delete_subfield( code => '9' ) if defined $current_link;
             $field->add_subfields( '9', $authid );
             $num_headings_changed++;
-        } else {
-            if ( defined $current_link ) {
+        }
+        else {
+            if ( defined $current_link
+                && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
+            {
+                $results{'fuzzy'}->{ $heading->display_form() }++;
+            }
+            elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
+                my $authtypedata =
+                  C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() );
+                my $marcrecordauth = MARC::Record->new();
+                if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
+                    $marcrecordauth->leader('     nz  a22     o  4500');
+                    SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
+                }
+                my $authfield =
+                  MARC::Field->new( $authtypedata->{auth_tag_to_report},
+                    '', '', "a" => "" . $field->subfield('a') );
+                map {
+                    $authfield->add_subfields( $_->[0] => $_->[1] )
+                      if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
+                } $field->subfields();
+                $marcrecordauth->insert_fields_ordered($authfield);
+
+# bug 2317: ensure new authority knows it's using UTF-8; currently
+# only need to do this for MARC21, as MARC::Record->as_xml_record() handles
+# automatically for UNIMARC (by not transcoding)
+# FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
+# use UTF-8, but as of 2008-08-05, did not want to introduce that kind
+# of change to a core API just before the 3.0 release.
+
+                if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
+                    $marcrecordauth->insert_fields_ordered(
+                        MARC::Field->new(
+                            '667', '', '',
+                            'a' => "Machine generated authority record."
+                        )
+                    );
+                    my $cite =
+                        $bib->author() . ", "
+                      . $bib->title_proper() . ", "
+                      . $bib->publication_date() . " ";
+                    $cite =~ s/^[\s\,]*//;
+                    $cite =~ s/[\s\,]*$//;
+                    $cite =
+                        "Work cat.: ("
+                      . C4::Context->preference('MARCOrgCode') . ")"
+                      . $bib->subfield( '999', 'c' ) . ": "
+                      . $cite;
+                    $marcrecordauth->insert_fields_ordered(
+                        MARC::Field->new( '670', '', '', 'a' => $cite ) );
+                }
+
+           #          warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
+
+                $authid =
+                  C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
+                    $heading->auth_type() );
+                $field->add_subfields( '9', $authid );
+                $num_headings_changed++;
+                $results{'added'}->{ $heading->display_form() }++;
+            }
+            elsif ( defined $current_link ) {
                 $field->delete_subfield( code => '9' );
                 $num_headings_changed++;
+                $results{'unlinked'}->{ $heading->display_form() }++;
+            }
+            else {
+                $results{'unlinked'}->{ $heading->display_form() }++;
             }
         }
 
     }
-    return $num_headings_changed;
+    return $num_headings_changed, \%results;
 }
 
 =head2 GetRecordValue
@@ -958,7 +1082,7 @@ sub GetMarcStructure {
     }
 
     $sth = $dbh->prepare(
-        "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue 
+        "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
          FROM   marc_subfield_structure 
          WHERE  frameworkcode=? 
          ORDER BY tagfield,tagsubfield
@@ -977,10 +1101,12 @@ sub GetMarcStructure {
     my $isurl;
     my $link;
     my $defaultvalue;
+    my $maxlength;
 
     while (
         (   $tag,          $subfield,      $liblibrarian, $libopac, $tab,    $mandatory, $repeatable, $authorised_value,
-            $authtypecode, $value_builder, $kohafield,    $seealso, $hidden, $isurl,     $link,       $defaultvalue
+            $authtypecode, $value_builder, $kohafield,    $seealso, $hidden, $isurl,     $link,       $defaultvalue,
+            $maxlength
         )
         = $sth->fetchrow
       ) {
@@ -997,6 +1123,7 @@ sub GetMarcStructure {
         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
         $res->{$tag}->{$subfield}->{'link'}           = $link;
         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
+        $res->{$tag}->{$subfield}->{maxlength}        = $maxlength;
     }
 
     $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
@@ -1043,9 +1170,12 @@ for the given frameworkcode
 
 sub GetMarcFromKohaField {
     my ( $kohafield, $frameworkcode ) = @_;
-    return 0, 0 unless $kohafield and defined $frameworkcode;
+    return (0, undef) unless $kohafield and defined $frameworkcode;
     my $relations = C4::Context->marcfromkohafield;
-    return ( $relations->{$frameworkcode}->{$kohafield}->[0], $relations->{$frameworkcode}->{$kohafield}->[1] );
+    if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
+        return @$mf;
+    }
+    return (0, undef);
 }
 
 =head2 GetMarcBiblio
@@ -1104,20 +1234,17 @@ sub GetXmlBiblio {
 
 =head2 GetCOinSBiblio
 
-  my $coins = GetCOinSBiblio($biblionumber);
+  my $coins = GetCOinSBiblio($record);
 
-Returns the COinS(a span) which can be included in a biblio record
+Returns the COinS (a span) which can be included in a biblio record
 
 =cut
 
 sub GetCOinSBiblio {
-    my ($biblionumber) = @_;
-    my $record = GetMarcBiblio($biblionumber);
+    my $record = shift;
 
     # get the coin format
     if ( ! $record ) {
-       # can't get a valid MARC::Record object, bail out at this point
-       warn "We called GetMarcBiblio with a biblionumber that doesn't exist biblionumber=$biblionumber";
        return;
     }
     my $pos7 = substr $record->leader(), 7, 1;
@@ -1279,12 +1406,56 @@ sub GetMarcPrice {
     for my $field ( $record->field(@listtags) ) {
         for my $subfield_value  ($field->subfield($subfield)){
             #check value
+            $subfield_value = MungeMarcPrice( $subfield_value );
             return $subfield_value if ($subfield_value);
         }
     }
     return 0; # no price found
 }
 
+=head2 MungeMarcPrice
+
+Return the best guess at what the actual price is from a price field.
+=cut
+
+sub MungeMarcPrice {
+    my ( $price ) = @_;
+
+    return unless ( $price =~ m/\d/ ); ## No digits means no price.
+
+    ## Look for the currency symbol of the active currency, if it's there,
+    ## start the price string right after the symbol. This allows us to prefer
+    ## this native currency price over other currency prices, if possible.
+    my $active_currency = C4::Context->dbh->selectrow_hashref( 'SELECT * FROM currency WHERE active = 1', {} );
+    my $symbol = quotemeta( $active_currency->{'symbol'} );
+    if ( $price =~ m/$symbol/ ) {
+        my @parts = split(/$symbol/, $price );
+        $price = $parts[1];
+    }
+
+    ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
+    ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
+
+    ## Split price into array on periods and commas
+    my @parts = split(/[\,\.]/, $price);
+
+    ## If the last grouping of digits is more than 2 characters, assume there is no decimal value and put it back.
+    my $decimal = pop( @parts );
+    if ( length( $decimal ) > 2 ) {
+        push( @parts, $decimal );
+        $decimal = '';
+    }
+
+    $price = join('', @parts );
+
+    if ( $decimal ) {
+     $price .= ".$decimal";
+    }
+
+    return $price;
+}
+
+
 =head2 GetMarcQuantity
 
 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
@@ -1381,9 +1552,9 @@ Get the control number / record Identifier from the MARC record and return it.
 sub GetMarcControlnumber {
     my ( $record, $marcflavour ) = @_;
     my $controlnumber = "";
-    # Control number or Record identifier are the same field in MARC21 and UNIMARC
+    # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
     # Keep $marcflavour for possible later use
-    if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC") {
+    if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
         my $controlnumberField = $record->field('001');
         if ($controlnumberField) {
             $controlnumber = $controlnumberField->data();
@@ -1397,7 +1568,7 @@ sub GetMarcControlnumber {
   $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
 
 Get all ISBNs from the MARC record and returns them in an array.
-ISBNs stored in differents places depending on MARC flavour
+ISBNs stored in different fields depending on MARC flavour
 
 =cut
 
@@ -1432,12 +1603,38 @@ sub GetMarcISBN {
     return \@marcisbns;
 }    # end GetMarcISBN
 
+
+=head2 GetMarcISSN
+
+  $marcissnsarray = GetMarcISSN( $record, $marcflavour );
+
+Get all valid ISSNs from the MARC record and returns them in an array.
+ISSNs are stored in different fields depending on MARC flavour
+
+=cut
+
+sub GetMarcISSN {
+    my ( $record, $marcflavour ) = @_;
+    my $scope;
+    if ( $marcflavour eq "UNIMARC" ) {
+        $scope = '011';
+    }
+    else {    # assume MARC21 or NORMARC
+        $scope = '022';
+    }
+    my @marcissns;
+    foreach my $field ( $record->field($scope) ) {
+        push @marcissns, $field->subfield( 'a' );
+    }
+    return \@marcissns;
+}    # end GetMarcISSN
+
 =head2 GetMarcNotes
 
   $marcnotesarray = GetMarcNotes( $record, $marcflavour );
 
 Get all notes from the MARC record and returns them in an array.
-The note are stored in differents places depending on MARC flavour
+The note are stored in different fields depending on MARC flavour
 
 =cut
 
@@ -1477,7 +1674,7 @@ sub GetMarcNotes {
   $marcsubjcts = GetMarcSubjects($record,$marcflavour);
 
 Get all subjects from the MARC record and returns them in an array.
-The subjects are stored in differents places depending on MARC flavour
+The subjects are stored in different fields depending on MARC flavour
 
 =cut
 
@@ -1537,7 +1734,7 @@ sub GetMarcSubjects {
 
             # ignore $9
             my @this_link_loop = @link_loop;
-            push @subfields_loop, { code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $subject_subfield->[0] eq 9 );
+            push @subfields_loop, { code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $subject_subfield->[0] eq 9 || $subject_subfield->[0] eq '0' );
             $counter++;
         }
 
@@ -1552,7 +1749,7 @@ sub GetMarcSubjects {
   authors = GetMarcAuthors($record,$marcflavour);
 
 Get all authors from the MARC record and returns them in an array.
-The authors are stored in differents places depending on MARC flavour
+The authors are stored in different fields depending on MARC flavour
 
 =cut
 
@@ -1615,12 +1812,13 @@ sub GetMarcAuthors {
                 $separator = C4::Context->preference('authoritysep');
             }
             push @subfields_loop,
-              { code      => $subfieldcode,
+              { tag       => $field->tag(),
+                code      => $subfieldcode,
                 value     => $value,
                 link_loop => \@this_link_loop,
                 separator => $separator
               }
-              unless ( $authors_subfield->[0] eq '9' );
+              unless ( $authors_subfield->[0] eq '9' || $authors_subfield->[0] eq '0');
             $count_auth++;
         }
         push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
@@ -1688,7 +1886,7 @@ sub GetMarcUrls {
   $marcseriesarray = GetMarcSeries($record,$marcflavour);
 
 Get all series from the MARC record and returns them in an array.
-The series are stored in differents places depending on MARC flavour
+The series are stored in different fields depending on MARC flavour
 
 =cut
 
@@ -1830,17 +2028,31 @@ sub GetFrameworkCode {
 This function builds partial MARC::Record from a hash
 Hash entries can be from biblio or biblioitems.
 
-This function is called in acquisition module, to create a basic catalogue entry from user entry
+This function is called in acquisition module, to create a basic catalogue
+entry from user entry
 
 =cut
 
+
 sub TransformKohaToMarc {
-    my ($hash) = @_;
-    my $sth    = C4::Context->dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" );
+    my $hash = shift;
     my $record = MARC::Record->new();
     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
-    foreach ( keys %{$hash} ) {
-        &TransformKohaToMarcOneField( $sth, $record, $_, $hash->{$_}, '' );
+    my $db_to_marc = C4::Context->marcfromkohafield;
+    while ( my ($name, $value) = each %$hash ) {
+        next unless my $dtm = $db_to_marc->{''}->{$name};
+        next unless ( scalar( @$dtm ) );
+        my ($tag, $letter) = @$dtm;
+        foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
+            if ( my $field = $record->field($tag) ) {
+                $field->add_subfields( $letter => $value );
+            }
+            else {
+                $record->insert_fields_ordered( MARC::Field->new(
+                    $tag, " ", " ", $letter => $value ) );
+            }
+        }
+
     }
     return $record;
 }
@@ -1857,6 +2069,7 @@ sub PrepHostMarcField {
     my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
     $marcflavour ||="MARC21";
     
+    require C4::Items;
     my $hostrecord = GetMarcBiblio($hostbiblionumber);
        my $item = C4::Items::GetItem($hostitemnumber);
        
@@ -1924,42 +2137,6 @@ sub PrepHostMarcField {
     return $hostmarcfield;
 }
 
-
-=head2 TransformKohaToMarcOneField
-
-    $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
-
-=cut
-
-sub TransformKohaToMarcOneField {
-    my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
-    $frameworkcode = '' unless $frameworkcode;
-    my $tagfield;
-    my $tagsubfield;
-
-    if ( !defined $sth ) {
-        my $dbh = C4::Context->dbh;
-        $sth = $dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" );
-    }
-    $sth->execute( $frameworkcode, $kohafieldname );
-    if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
-        my @values = split(/\s?\|\s?/, $value, -1);
-        
-        foreach my $itemvalue (@values){
-        my $tag = $record->field($tagfield);
-        if ($tag) {
-                $tag->add_subfields( $tagsubfield => $itemvalue );
-            $record->delete_field($tag);
-            $record->insert_fields_ordered($tag);
-            }
-            else {
-                $record->add_fields( $tagfield, " ", " ", $tagsubfield => $itemvalue );
-            }
-        }
-    }
-    return $record;
-}
-
 =head2 TransformHtmlToXml
 
   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, 
@@ -2080,7 +2257,7 @@ sub TransformHtmlToXml {
         }
         $prevtag = @$tags[$i];
     }
-    $xml .= "</datafield>\n" if @$tags > 0;
+    $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
 
         #     warn "SETTING 100 for $auth_type";
@@ -2163,6 +2340,7 @@ sub TransformHtmlToMarc {
     my $record = MARC::Record->new();
     my $i      = 0;
     my @fields;
+#FIXME This code assumes that the CGI params will be in the same order as the fields in the template; this is no absolute guarantee!
     while ( $params[$i] ) {    # browse all CGI params
         my $param    = $params[$i];
         my $newfield = 0;
@@ -2202,19 +2380,23 @@ sub TransformHtmlToMarc {
 
                 # > 009, deal with subfields
             } else {
-                while ( defined $params[$j] && $params[$j] =~ /_code_/ ) {    # browse all it's subfield
-                    my $inner_param = $params[$j];
-                    if ($newfield) {
-                        if ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {         # only if there is a value (code => value)
-                            $newfield->add_subfields( $cgi->param($inner_param) => $cgi->param( $params[ $j + 1 ] ) );
-                        }
-                    } else {
-                        if ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {         # creating only if there is a value (code => value)
-                            $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($inner_param) => $cgi->param( $params[ $j + 1 ] ), );
-                        }
+                # browse subfields for this tag (reason for _code_ match)
+                while(defined $params[$j] && $params[$j] =~ /_code_/) {
+                    last unless defined $params[$j+1];
+                    #if next param ne subfield, then it was probably empty
+                    #try next param by incrementing j
+                    if($params[$j+1]!~/_subfield_/) {$j++; next; }
+                    my $fval= $cgi->param($params[$j+1]);
+                    #check if subfield value not empty and field exists
+                    if($fval ne '' && $newfield) {
+                        $newfield->add_subfields( $cgi->param($params[$j]) => $fval);
+                    }
+                    elsif($fval ne '') {
+                        $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($params[$j]) => $fval );
                     }
                     $j += 2;
-                }
+                } #end-of-while
+                $i= $j-1; #update i for outer loop accordingly
             }
             push @fields, $newfield if ($newfield);
         }
@@ -2466,232 +2648,6 @@ sub TransformMarcToKohaOneField {
     return $result;
 }
 
-=head1  OTHER FUNCTIONS
-
-
-=head2 PrepareItemrecordDisplay
-
-  PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber,$frameworkcode);
-
-Returns a hash with all the fields for Display a given item data in a template
-
-The $frameworkcode returns the item for the given frameworkcode, ONLY if bibnum is not provided
-
-=cut
-
-sub PrepareItemrecordDisplay {
-
-    my ( $bibnum, $itemnum, $defaultvalues, $frameworkcode ) = @_;
-
-    my $dbh = C4::Context->dbh;
-    $frameworkcode = &GetFrameworkCode($bibnum) if $bibnum;
-    my ( $itemtagfield, $itemtagsubfield ) = &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
-    my $tagslib = &GetMarcStructure( 1, $frameworkcode );
-
-    # return nothing if we don't have found an existing framework.
-    return q{} unless $tagslib;
-    my $itemrecord;
-    if ($itemnum) {
-        $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum );
-    }
-    my @loop_data;
-    my $authorised_values_sth = $dbh->prepare( "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib" );
-    foreach my $tag ( sort keys %{$tagslib} ) {
-        my $previous_tag = '';
-        if ( $tag ne '' ) {
-
-            # loop through each subfield
-            my $cntsubf;
-            foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
-                next if ( subfield_is_koha_internal_p($subfield) );
-                next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
-                my %subfield_data;
-                $subfield_data{tag}           = $tag;
-                $subfield_data{subfield}      = $subfield;
-                $subfield_data{countsubfield} = $cntsubf++;
-                $subfield_data{kohafield}     = $tagslib->{$tag}->{$subfield}->{'kohafield'};
-
-                #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
-                $subfield_data{marc_lib}   = $tagslib->{$tag}->{$subfield}->{lib};
-                $subfield_data{mandatory}  = $tagslib->{$tag}->{$subfield}->{mandatory};
-                $subfield_data{repeatable} = $tagslib->{$tag}->{$subfield}->{repeatable};
-                $subfield_data{hidden}     = "display:none"
-                  if $tagslib->{$tag}->{$subfield}->{hidden};
-                my ( $x, $defaultvalue );
-                if ($itemrecord) {
-                    ( $x, $defaultvalue ) = _find_value( $tag, $subfield, $itemrecord );
-                }
-                $defaultvalue = $tagslib->{$tag}->{$subfield}->{defaultvalue} unless $defaultvalue;
-                if ( !defined $defaultvalue ) {
-                    $defaultvalue = q||;
-                }
-                $defaultvalue =~ s/"/&quot;/g;
-
-                # search for itemcallnumber if applicable
-                if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
-                    && C4::Context->preference('itemcallnumber') ) {
-                    my $CNtag      = substr( C4::Context->preference('itemcallnumber'), 0, 3 );
-                    my $CNsubfield = substr( C4::Context->preference('itemcallnumber'), 3, 1 );
-                    if ($itemrecord) {
-                        my $temp = $itemrecord->field($CNtag);
-                        if ($temp) {
-                            $defaultvalue = $temp->subfield($CNsubfield);
-                        }
-                    }
-                }
-                if (   $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
-                    && $defaultvalues
-                    && $defaultvalues->{'callnumber'} ) {
-                    my $temp;
-                    if ($itemrecord) {
-                        $temp = $itemrecord->field($subfield);
-                    }
-                    unless ($temp) {
-                        $defaultvalue = $defaultvalues->{'callnumber'} if $defaultvalues;
-                    }
-                }
-                if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.holdingbranch' || $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.homebranch' )
-                    && $defaultvalues
-                    && $defaultvalues->{'branchcode'} ) {
-                    my $temp;
-                    if ($itemrecord) {
-                        $temp = $itemrecord->field($subfield);
-                    }
-                    unless ($temp) {
-                        $defaultvalue = $defaultvalues->{branchcode} if $defaultvalues;
-                    }
-                }
-                if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.location' )
-                    && $defaultvalues
-                    && $defaultvalues->{'location'} ) {
-                    my $temp = $itemrecord->field($subfield) if ($itemrecord);
-                    unless ($temp) {
-                        $defaultvalue = $defaultvalues->{location} if $defaultvalues;
-                    }
-                }
-                if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
-                    my @authorised_values;
-                    my %authorised_lib;
-
-                    # builds list, depending on authorised value...
-                    #---- branch
-                    if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
-                        if (   ( C4::Context->preference("IndependantBranches") )
-                            && ( C4::Context->userenv->{flags} % 2 != 1 ) ) {
-                            my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname" );
-                            $sth->execute( C4::Context->userenv->{branch} );
-                            push @authorised_values, ""
-                              unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
-                            while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
-                                push @authorised_values, $branchcode;
-                                $authorised_lib{$branchcode} = $branchname;
-                            }
-                        } else {
-                            my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches ORDER BY branchname" );
-                            $sth->execute;
-                            push @authorised_values, ""
-                              unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
-                            while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
-                                push @authorised_values, $branchcode;
-                                $authorised_lib{$branchcode} = $branchname;
-                            }
-                        }
-
-                        #----- itemtypes
-                    } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes" ) {
-                        my $sth = $dbh->prepare( "SELECT itemtype,description FROM itemtypes ORDER BY description" );
-                        $sth->execute;
-                        push @authorised_values, ""
-                          unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
-                        while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
-                            push @authorised_values, $itemtype;
-                            $authorised_lib{$itemtype} = $description;
-                        }
-                        #---- class_sources
-                    } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "cn_source" ) {
-                        push @authorised_values, "" unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
-
-                        my $class_sources = GetClassSources();
-                        my $default_source = C4::Context->preference("DefaultClassificationSource");
-
-                        foreach my $class_source (sort keys %$class_sources) {
-                            next unless $class_sources->{$class_source}->{'used'} or
-                                        ($class_source eq $default_source);
-                            push @authorised_values, $class_source;
-                            $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
-                        }
-
-                        #---- "true" authorised value
-                    } else {
-                        $authorised_values_sth->execute( $tagslib->{$tag}->{$subfield}->{authorised_value} );
-                        push @authorised_values, ""
-                          unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
-                        while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
-                            push @authorised_values, $value;
-                            $authorised_lib{$value} = $lib;
-                        }
-                    }
-                    $subfield_data{marc_value} = CGI::scrolling_list(
-                        -name     => 'field_value',
-                        -values   => \@authorised_values,
-                        -default  => "$defaultvalue",
-                        -labels   => \%authorised_lib,
-                        -size     => 1,
-                        -tabindex => '',
-                        -multiple => 0,
-                    );
-                } elsif ( $tagslib->{$tag}->{$subfield}->{value_builder} ) {
-                        # opening plugin
-                        my $plugin = C4::Context->intranetdir . "/cataloguing/value_builder/" . $tagslib->{$tag}->{$subfield}->{'value_builder'};
-                        if (do $plugin) {
-                            my $temp;
-                            my $extended_param = plugin_parameters( $dbh, $temp, $tagslib, $subfield_data{id}, undef );
-                            my ( $function_name, $javascript ) = plugin_javascript( $dbh, $temp, $tagslib, $subfield_data{id}, undef );
-                            $subfield_data{random}     = int(rand(1000000));    # why do we need 2 different randoms?
-                            my $index_subfield = int(rand(1000000));
-                            $subfield_data{id} = "tag_".$tag."_subfield_".$subfield."_".$index_subfield;
-                            $subfield_data{marc_value} = qq[<input tabindex="1" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="67" maxlength="255"
-                                onfocus="Focus$function_name($subfield_data{random}, '$subfield_data{id}');"
-                                 onblur=" Blur$function_name($subfield_data{random}, '$subfield_data{id}');" />
-                                <a href="#" class="buttonDot" onclick="Clic$function_name('$subfield_data{id}'); return false;" title="Tag Editor">...</a>
-                                $javascript];
-                        } else {
-                            warn "Plugin Failed: $plugin";
-                            $subfield_data{marc_value} = qq(<input tabindex="1" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="67" maxlength="255" />); # supply default input form
-                        }
-                }
-                elsif ( $tag eq '' ) {       # it's an hidden field
-                    $subfield_data{marc_value} = qq(<input type="hidden" tabindex="1" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="67" maxlength="255" value="$defaultvalue" />);
-                }
-                elsif ( $tagslib->{$tag}->{$subfield}->{'hidden'} ) {   # FIXME: shouldn't input type be "hidden" ?
-                    $subfield_data{marc_value} = qq(<input type="text" tabindex="1" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="67" maxlength="255" value="$defaultvalue" />);
-                }
-                elsif ( length($defaultvalue) > 100
-                            or (C4::Context->preference("marcflavour") eq "UNIMARC" and
-                                  300 <= $tag && $tag < 400 && $subfield eq 'a' )
-                            or (C4::Context->preference("marcflavour") eq "MARC21"  and
-                                  500 <= $tag && $tag < 600                     )
-                          ) {
-                    # oversize field (textarea)
-                    $subfield_data{marc_value} = qq(<textarea tabindex="1" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="67" maxlength="255">$defaultvalue</textarea>\n");
-                } else {
-                    $subfield_data{marc_value} = "<input type=\"text\" name=\"field_value\" value=\"$defaultvalue\" size=\"50\" maxlength=\"255\" />";
-                }
-                push( @loop_data, \%subfield_data );
-            }
-        }
-    }
-    my $itemnumber;
-    if ( $itemrecord && $itemrecord->field($itemtagfield) ) {
-        $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield );
-    }
-    return {
-        'itemtagfield'    => $itemtagfield,
-        'itemtagsubfield' => $itemtagsubfield,
-        'itemnumber'      => $itemnumber,
-        'iteminformation' => \@loop_data
-    };
-}
 
 #"
 
@@ -2855,6 +2811,7 @@ sub EmbedItemsInMarcBiblio {
     my @item_fields;
     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
     while (my ($itemnumber) = $sth->fetchrow_array) {
+        require C4::Items;
         my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
         push @item_fields, $item_marc->field($itemtag);
     }
@@ -3125,45 +3082,6 @@ sub _AddBiblioNoZebra {
     return %result;
 }
 
-=head2 _find_value
-
-  ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
-
-Find the given $subfield in the given $tag in the given
-MARC::Record $record.  If the subfield is found, returns
-the (indicators, value) pair; otherwise, (undef, undef) is
-returned.
-
-PROPOSITION :
-Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
-I suggest we export it from this module.
-
-=cut
-
-sub _find_value {
-    my ( $tagfield, $insubfield, $record, $encoding ) = @_;
-    my @result;
-    my $indicator;
-    if ( $tagfield < 10 ) {
-        if ( $record->field($tagfield) ) {
-            push @result, $record->field($tagfield)->data();
-        } else {
-            push @result, "";
-        }
-    } else {
-        foreach my $field ( $record->field($tagfield) ) {
-            my @subfields = $field->subfields();
-            foreach my $subfield (@subfields) {
-                if ( @$subfield[0] eq $insubfield ) {
-                    push @result, @$subfield[1];
-                    $indicator = $field->indicator(1) . $field->indicator(2);
-                }
-            }
-        }
-    }
-    return ( $indicator, @result );
-}
-
 =head2 _koha_marc_update_bib_ids
 
 
@@ -3182,9 +3100,24 @@ sub _koha_marc_update_bib_ids {
     # we drop the original field
     # we add the new builded field.
     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
+    die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
+    die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblio_tag;
+
+    if ( $biblio_tag == $biblioitem_tag ) {
 
-    if ( $biblio_tag != $biblioitem_tag ) {
+        # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
+        my $new_field = MARC::Field->new(
+            $biblio_tag, '', '',
+            "$biblio_subfield"     => $biblionumber,
+            "$biblioitem_subfield" => $biblioitemnumber
+        );
+
+        # drop old field and create new one...
+        my $old_field = $record->field($biblio_tag);
+        $record->delete_field($old_field) if $old_field;
+        $record->insert_fields_ordered($new_field);
+    } else {
 
         # biblionumber & biblioitemnumber are in different fields
 
@@ -3212,20 +3145,6 @@ sub _koha_marc_update_bib_ids {
         $old_field = $record->field($biblioitem_tag);
         $record->delete_field($old_field) if $old_field;
         $record->insert_fields_ordered($new_field);
-
-    } else {
-
-        # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
-        my $new_field = MARC::Field->new(
-            $biblio_tag, '', '',
-            "$biblio_subfield"     => $biblionumber,
-            "$biblioitem_subfield" => $biblioitemnumber
-        );
-
-        # drop old field and create new one...
-        my $old_field = $record->field($biblio_tag);
-        $record->delete_field($old_field) if $old_field;
-        $record->insert_fields_ordered($new_field);
     }
 }
 
@@ -3397,7 +3316,8 @@ sub _koha_modify_biblioitem_nonmarc {
         cn_item         = ?,
         cn_suffix       = ?,
         cn_sort         = ?,
-        totalissues     = ?
+        totalissues     = ?,
+    ean             = ?
         where biblioitemnumber = ?
         ";
     my $sth = $dbh->prepare($query);
@@ -3409,6 +3329,7 @@ sub _koha_modify_biblioitem_nonmarc {
         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
+    $biblioitem->{'ean'},
         $biblioitem->{'biblioitemnumber'}
     );
     if ( $dbh->errstr ) {
@@ -3460,7 +3381,8 @@ sub _koha_add_biblioitem {
         cn_item         = ?,
         cn_suffix       = ?,
         cn_sort         = ?,
-        totalissues     = ?
+        totalissues     = ?,
+    ean             = ?
         ";
     my $sth = $dbh->prepare($query);
     $sth->execute(
@@ -3471,7 +3393,7 @@ sub _koha_add_biblioitem {
         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
         $biblioitem->{'lccn'},             $biblioitem->{'marc'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
-        $biblioitem->{'totalissues'}
+        $biblioitem->{'totalissues'},      $biblioitem->{'ean'}
     );
     my $bibitemnum = $dbh->{'mysql_insertid'};
 
@@ -3522,9 +3444,12 @@ sub _koha_delete_biblio {
         $bkup_sth->finish;
 
         # delete the biblio
-        my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
-        $del_sth->execute($biblionumber);
-        $del_sth->finish;
+        my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
+        $sth2->execute($biblionumber);
+        # update the timestamp (Bugzilla 7146)
+        $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
+        $sth2->execute($biblionumber);
+        $sth2->finish;
     }
     $sth->finish;
     return undef;
@@ -3568,9 +3493,12 @@ sub _koha_delete_biblioitems {
         $bkup_sth->finish;
 
         # delete the biblioitem
-        my $del_sth = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
-        $del_sth->execute($biblioitemnumber);
-        $del_sth->finish;
+        my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
+        $sth2->execute($biblioitemnumber);
+        # update the timestamp (Bugzilla 7146)
+        $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
+        $sth2->execute($biblioitemnumber);
+        $sth2->finish;
     }
     $sth->finish;
     return undef;
@@ -3589,9 +3517,12 @@ Function exported, but should NOT be used, unless you really know what you're do
 =cut
 
 sub ModBiblioMarc {
-
-    # pass the MARC::Record to this function, and it will create the records in the marc field
+    # pass the MARC::Record to this function, and it will create the records in
+    # the marc field
     my ( $record, $biblionumber, $frameworkcode ) = @_;
+
+    # Clone record as it gets modified
+    $record = $record->clone();
     my $dbh    = C4::Context->dbh;
     my @fields = $record->fields();
     if ( !$frameworkcode ) {
@@ -3641,112 +3572,6 @@ sub ModBiblioMarc {
     return $biblionumber;
 }
 
-=head2 z3950_extended_services
-
-  z3950_extended_services($serviceType,$serviceOptions,$record);
-
-z3950_extended_services is used to handle all interactions with Zebra's extended serices package, which is employed to perform all management of the MARC data stored in Zebra.
-
-C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
-
-C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
-
- action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
-
-and maybe
-
-  recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
-  syntax => the record syntax (transfer syntax)
-  databaseName = Database from connection object
-
-To set serviceOptions, call set_service_options($serviceType)
-
-C<$record> the record, if one is needed for the service type
-
-A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
-
-=cut
-
-sub z3950_extended_services {
-    my ( $server, $serviceType, $action, $serviceOptions ) = @_;
-
-    # get our connection object
-    my $Zconn = C4::Context->Zconn( $server, 0, 1 );
-
-    # create a new package object
-    my $Zpackage = $Zconn->package();
-
-    # set our options
-    $Zpackage->option( action => $action );
-
-    if ( $serviceOptions->{'databaseName'} ) {
-        $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
-    }
-    if ( $serviceOptions->{'recordIdNumber'} ) {
-        $Zpackage->option( recordIdNumber => $serviceOptions->{'recordIdNumber'} );
-    }
-    if ( $serviceOptions->{'recordIdOpaque'} ) {
-        $Zpackage->option( recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
-    }
-
-    # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
-    #if ($serviceType eq 'itemorder') {
-    #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
-    #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
-    #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
-    #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
-    #}
-
-    if ( $serviceOptions->{record} ) {
-        $Zpackage->option( record => $serviceOptions->{record} );
-
-        # can be xml or marc
-        if ( $serviceOptions->{'syntax'} ) {
-            $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
-        }
-    }
-
-    # send the request, handle any exception encountered
-    eval { $Zpackage->send($serviceType) };
-    if ( $@ && $@->isa("ZOOM::Exception") ) {
-        return "error:  " . $@->code() . " " . $@->message() . "\n";
-    }
-
-    # free up package resources
-    $Zpackage->destroy();
-}
-
-=head2 set_service_options
-
-  my $serviceOptions = set_service_options($serviceType);
-
-C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
-
-Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
-
-=cut
-
-sub set_service_options {
-    my ($serviceType) = @_;
-    my $serviceOptions;
-
-    # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
-    #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
-
-    if ( $serviceType eq 'commit' ) {
-
-        # nothing to do
-    }
-    if ( $serviceType eq 'create' ) {
-
-        # nothing to do
-    }
-    if ( $serviceType eq 'drop' ) {
-        die "ERROR: 'drop' not currently supported (by Zebra)";
-    }
-    return $serviceOptions;
-}
-
 =head2 get_biblio_authorised_values
 
 find the types and values for all authorised values assigned to this biblio.
@@ -3878,9 +3703,134 @@ sub GetHolds {
     return ($holds);
 }
 
+=head2 prepare_host_field
+
+$marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
+Generate the host item entry for an analytic child entry
+
+=cut
+
+sub prepare_host_field {
+    my ( $hostbiblio, $marcflavour ) = @_;
+    $marcflavour ||= C4::Context->preference('marcflavour');
+    my $host = GetMarcBiblio($hostbiblio);
+    # unfortunately as_string does not 'do the right thing'
+    # if field returns undef
+    my %sfd;
+    my $field;
+    my $host_field;
+    if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
+        if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
+            my $s = $field->as_string('ab');
+            if ($s) {
+                $sfd{a} = $s;
+            }
+        }
+        if ( $field = $host->field('245') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{t} = $s;
+            }
+        }
+        if ( $field = $host->field('260') ) {
+            my $s = $field->as_string('abc');
+            if ($s) {
+                $sfd{d} = $s;
+            }
+        }
+        if ( $field = $host->field('240') ) {
+            my $s = $field->as_string();
+            if ($s) {
+                $sfd{b} = $s;
+            }
+        }
+        if ( $field = $host->field('022') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{x} = $s;
+            }
+        }
+        if ( $field = $host->field('020') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{z} = $s;
+            }
+        }
+        if ( $field = $host->field('001') ) {
+            $sfd{w} = $field->data(),;
+        }
+        $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
+        return $host_field;
+    }
+    elsif ( $marcflavour eq 'UNIMARC' ) {
+        #author
+        if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
+            my $s = $field->as_string('ab');
+            if ($s) {
+                $sfd{a} = $s;
+            }
+        }
+        #title
+        if ( $field = $host->field('200') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{t} = $s;
+            }
+        }
+        #place of publicaton
+        if ( $field = $host->field('210') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{c} = $s;
+            }
+        }
+        #date of publication
+        if ( $field = $host->field('210') ) {
+            my $s = $field->as_string('d');
+            if ($s) {
+                $sfd{d} = $s;
+            }
+        }
+        #edition statement
+        if ( $field = $host->field('205') ) {
+            my $s = $field->as_string();
+            if ($s) {
+                $sfd{a} = $s;
+            }
+        }
+        #URL
+        if ( $field = $host->field('856') ) {
+            my $s = $field->as_string('u');
+            if ($s) {
+                $sfd{u} = $s;
+            }
+        }
+        #ISSN
+        if ( $field = $host->field('011') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{x} = $s;
+            }
+        }
+        #ISBN
+        if ( $field = $host->field('010') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{y} = $s;
+            }
+        }
+        if ( $field = $host->field('001') ) {
+            $sfd{0} = $field->data(),;
+        }
+        $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
+        return $host_field;
+    }
+    return;
+}
 
 1;
 
+
 __END__
 
 =head1 AUTHOR