memoize GetMarcStructure
[koha.git] / C4 / Biblio.pm
index 0905b8f..a24079d 100644 (file)
@@ -1,6 +1,8 @@
 package C4::Biblio;
 
 # Copyright 2000-2002 Katipo Communications
+# Copyright 2010 BibLibre
+# Copyright 2011 Equinox Software, Inc.
 #
 # This file is part of Koha.
 #
@@ -19,6 +21,7 @@ package C4::Biblio;
 
 use strict;
 use warnings;
+use Carp;
 
 # use utf8;
 use MARC::Record;
@@ -34,6 +37,7 @@ use C4::ClassSource;
 use C4::Charset;
 require C4::Heading;
 require C4::Serials;
+require C4::Items;
 
 use vars qw($VERSION @ISA @EXPORT);
 
@@ -74,18 +78,25 @@ BEGIN {
       &GetMarcBiblio
       &GetMarcAuthors
       &GetMarcSeries
+      &GetMarcHosts
       GetMarcUrls
       &GetUsedMarcStructure
       &GetXmlBiblio
       &GetCOinSBiblio
+      &GetMarcPrice
+      &GetMarcQuantity
 
       &GetAuthorisedValueDesc
       &GetMarcStructure
       &GetMarcFromKohaField
       &GetFrameworkCode
       &TransformKohaToMarc
+      &PrepHostMarcField
 
       &CountItemsIssued
+      &CountBiblioInOrders
+      &GetSubscriptionsId
+      &GetHolds
     );
 
     # To modify something
@@ -139,6 +150,9 @@ eval {
     }
 };
 
+use Memoize;
+memoize('GetMarcStructure');
+
 =head1 NAME
 
 C4::Biblio - cataloging management functions
@@ -249,6 +263,7 @@ sub AddBiblio {
     my $dbh = C4::Context->dbh;
 
     # transform the data into koha-table style data
+    SetUTF8Flag($record);
     my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
     ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
     $olddata->{'biblionumber'} = $biblionumber;
@@ -288,52 +303,30 @@ and biblionumber data for indexing.
 
 sub ModBiblio {
     my ( $record, $biblionumber, $frameworkcode ) = @_;
+    croak "No record" unless $record;
+
     if ( C4::Context->preference("CataloguingLog") ) {
         my $newrecord = GetMarcBiblio($biblionumber);
         logaction( "CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>" . $newrecord->as_formatted );
     }
 
-    my $dbh = C4::Context->dbh;
-
-    $frameworkcode = "" unless $frameworkcode;
-
-    # get the items before and append them to the biblio before updating the record, atm we just have the biblio
-    my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
-    my $oldRecord = GetMarcBiblio($biblionumber);
-
-    # delete any item fields from incoming record to avoid
-    # duplication or incorrect data - use AddItem() or ModItem()
-    # to change items
-    foreach my $field ( $record->field($itemtag) ) {
-        $record->delete_field($field);
-    }
-
-    # parse each item, and, for an unknown reason, re-encode each subfield
-    # if you don't do that, the record will have encoding mixed
-    # and the biblio will be re-encoded.
-    # strange, I (Paul P.) searched more than 1 day to understand what happends
-    # but could only solve the problem this way...
-    my @fields = $oldRecord->field($itemtag);
-    foreach my $fielditem (@fields) {
-        my $field;
-        foreach ( $fielditem->subfields() ) {
-            if ($field) {
-                $field->add_subfields( Encode::encode( 'utf-8', $_->[0] ) => Encode::encode( 'utf-8', $_->[1] ) );
-            } else {
-                $field = MARC::Field->new( "$itemtag", '', '', Encode::encode( 'utf-8', $_->[0] ) => Encode::encode( 'utf-8', $_->[1] ) );
-            }
-        }
-        $record->append_fields($field);
-    }
-
+    # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
+    # throw an exception which probably won't be handled.
     foreach my $field ($record->fields()) {
         if (! $field->is_control_field()) {
-            if (scalar($field->subfields()) == 0) {
-                $record->delete_fields($field);
+            if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
+                $record->delete_field($field);
             }
         }
     }
 
+    SetUTF8Flag($record);
+    my $dbh = C4::Context->dbh;
+
+    $frameworkcode = "" unless $frameworkcode;
+
+    _strip_item_fields($record, $frameworkcode);
+
     # update biblionumber and biblioitemnumber in MARC
     # FIXME - this is assuming a 1 to 1 relationship between
     # biblios and biblioitems
@@ -358,6 +351,29 @@ sub ModBiblio {
     return 1;
 }
 
+=head2 _strip_item_fields
+
+  _strip_item_fields($record, $frameworkcode)
+
+Utility routine to remove item tags from a
+MARC bib.
+
+=cut
+
+sub _strip_item_fields {
+    my $record = shift;
+    my $frameworkcode = shift;
+    # get the items before and append them to the biblio before updating the record, atm we just have the biblio
+    my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
+
+    # delete any item fields from incoming record to avoid
+    # duplication or incorrect data - use AddItem() or ModItem()
+    # to change items
+    foreach my $field ( $record->field($itemtag) ) {
+        $record->delete_field($field);
+    }
+}
+
 =head2 ModBiblioframework
 
    ModBiblioframework($biblionumber,$frameworkcode);
@@ -750,7 +766,8 @@ Return the ISBD view which can be included in opac and intranet
 
 sub GetISBDView {
     my ( $biblionumber, $template ) = @_;
-    my $record   = GetMarcBiblio($biblionumber);
+    my $record   = GetMarcBiblio($biblionumber, 1);
+    return undef unless defined $record;
     my $itemtype = &GetFrameworkCode($biblionumber);
     my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
     my $tagslib = &GetMarcStructure( 1, $itemtype );
@@ -1036,16 +1053,18 @@ sub GetMarcFromKohaField {
 
 =head2 GetMarcBiblio
 
-  my $record = GetMarcBiblio($biblionumber);
+  my $record = GetMarcBiblio($biblionumber, [$embeditems]);
 
 Returns MARC::Record representing bib identified by
 C<$biblionumber>.  If no bib exists, returns undef.
-The MARC record contains both biblio & item data.
+C<$embeditems>.  If set to true, items data are included.
+The MARC record contains biblio data, and items data if $embeditems is set to true.
 
 =cut
 
 sub GetMarcBiblio {
     my $biblionumber = shift;
+    my $embeditems   = shift || 0;
     my $dbh          = C4::Context->dbh;
     my $sth          = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
     $sth->execute($biblionumber);
@@ -1057,8 +1076,11 @@ sub GetMarcBiblio {
     if ($marcxml) {
         $record = eval { MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour') ) };
         if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
+        return unless $record;
+
+        C4::Biblio::_koha_marc_update_bib_ids($record, '', $biblionumber, $biblionumber);
+       C4::Biblio::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems);
 
-        #      $record = MARC::Record::new_from_usmarc( $marc) if $marc;
         return $record;
     } else {
         return undef;
@@ -1113,54 +1135,61 @@ sub GetCOinSBiblio {
     my $isbn      = '';
     my $issn      = '';
     my $publisher = '';
-
-    if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
-        my $fmts6;
-        my $fmts7;
-        %$fmts6 = (
-            'a' => 'book',
-            'b' => 'manuscript',
-            'c' => 'book',
-            'd' => 'manuscript',
-            'e' => 'map',
-            'f' => 'map',
-            'g' => 'film',
-            'i' => 'audioRecording',
-            'j' => 'audioRecording',
-            'k' => 'artwork',
-            'l' => 'document',
-            'm' => 'computerProgram',
-            'r' => 'document',
-
-        );
-        %$fmts7 = (
-            'a' => 'journalArticle',
-            's' => 'journal',
-        );
-
-        $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
-
-        if ( $genre eq 'book' ) {
+    my $pages     = '';
+    my $titletype = 'b';
+
+    # For the purposes of generating COinS metadata, LDR/06-07 can be
+    # considered the same for UNIMARC and MARC21
+    my $fmts6;
+    my $fmts7;
+    %$fmts6 = (
+                'a' => 'book',
+                'b' => 'manuscript',
+                'c' => 'book',
+                'd' => 'manuscript',
+                'e' => 'map',
+                'f' => 'map',
+                'g' => 'film',
+                'i' => 'audioRecording',
+                'j' => 'audioRecording',
+                'k' => 'artwork',
+                'l' => 'document',
+                'm' => 'computerProgram',
+                'o' => 'document',
+                'r' => 'document',
+            );
+    %$fmts7 = (
+                    'a' => 'journalArticle',
+                    's' => 'journal',
+              );
+
+    $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
+
+    if ( $genre eq 'book' ) {
             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
-        }
+    }
 
-        ##### We must transform mtx to a valable mtx and document type ####
-        if ( $genre eq 'book' ) {
+    ##### We must transform mtx to a valable mtx and document type ####
+    if ( $genre eq 'book' ) {
             $mtx = 'book';
-        } elsif ( $genre eq 'journal' ) {
+    } elsif ( $genre eq 'journal' ) {
             $mtx = 'journal';
-        } elsif ( $genre eq 'journalArticle' ) {
+            $titletype = 'j';
+    } elsif ( $genre eq 'journalArticle' ) {
             $mtx   = 'journal';
             $genre = 'article';
-        } else {
+            $titletype = 'a';
+    } else {
             $mtx = 'dc';
-        }
+    }
 
-        $genre = ( $mtx eq 'dc' ) ? "&amp;rft.type=$genre" : "&amp;rft.genre=$genre";
+    $genre = ( $mtx eq 'dc' ) ? "&amp;rft.type=$genre" : "&amp;rft.genre=$genre";
+
+    if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
 
         # Setting datas
-        $aulast  = $record->subfield( '700', 'a' );
-        $aufirst = $record->subfield( '700', 'b' );
+        $aulast  = $record->subfield( '700', 'a' ) || '';
+        $aufirst = $record->subfield( '700', 'b' ) || '';
         $oauthors = "&amp;rft.au=$aufirst $aulast";
 
         # others authors
@@ -1173,16 +1202,13 @@ sub GetCOinSBiblio {
           ( $mtx eq 'dc' )
           ? "&amp;rft.title=" . $record->subfield( '200', 'a' )
           : "&amp;rft.title=" . $record->subfield( '200', 'a' ) . "&amp;rft.btitle=" . $record->subfield( '200', 'a' );
-        $pubyear   = $record->subfield( '210', 'd' );
-        $publisher = $record->subfield( '210', 'c' );
-        $isbn      = $record->subfield( '010', 'a' );
-        $issn      = $record->subfield( '011', 'a' );
+        $pubyear   = $record->subfield( '210', 'd' ) || '';
+        $publisher = $record->subfield( '210', 'c' ) || '';
+        $isbn      = $record->subfield( '010', 'a' ) || '';
+        $issn      = $record->subfield( '011', 'a' ) || '';
     } else {
 
         # MARC21 need some improve
-        my $fmts;
-        $mtx   = 'book';
-        $genre = "&amp;rft.genre=book";
 
         # Setting datas
         if ( $record->field('100') ) {
@@ -1195,17 +1221,35 @@ sub GetCOinSBiblio {
                 $oauthors .= "&amp;rft.au=$au";
             }
         }
-        $title = "&amp;rft.btitle=" . $record->subfield( '245', 'a' );
+        $title = "&amp;rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
         $subtitle = $record->subfield( '245', 'b' ) || '';
         $title .= $subtitle;
-        $pubyear   = $record->subfield( '260', 'c' ) || '';
-        $publisher = $record->subfield( '260', 'b' ) || '';
-        $isbn      = $record->subfield( '020', 'a' ) || '';
-        $issn      = $record->subfield( '022', 'a' ) || '';
+        if ($titletype eq 'a') {
+            $pubyear   = $record->field('008') || '';
+            $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
+            $isbn      = $record->subfield( '773', 'z' ) || '';
+            $issn      = $record->subfield( '773', 'x' ) || '';
+            if ($mtx eq 'journal') {
+                $title    .= "&amp;rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
+            } else {
+                $title    .= "&amp;rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
+            }
+            foreach my $rel ($record->subfield( '773', 'g' )) {
+                if ($pages) {
+                    $pages .= ', ';
+                }
+                $pages .= $rel;
+            }
+        } else {
+            $pubyear   = $record->subfield( '260', 'c' ) || '';
+            $publisher = $record->subfield( '260', 'b' ) || '';
+            $isbn      = $record->subfield( '020', 'a' ) || '';
+            $issn      = $record->subfield( '022', 'a' ) || '';
+        }
 
     }
     my $coins_value =
-"ctx_ver=Z39.88-2004&amp;rft_val_fmt=info%3Aofi%2Ffmt%3Akev%3Amtx%3A$mtx$genre$title&amp;rft.isbn=$isbn&amp;rft.issn=$issn&amp;rft.aulast=$aulast&amp;rft.aufirst=$aufirst$oauthors&amp;rft.pub=$publisher&amp;rft.date=$pubyear";
+"ctx_ver=Z39.88-2004&amp;rft_val_fmt=info%3Aofi%2Ffmt%3Akev%3Amtx%3A$mtx$genre$title&amp;rft.isbn=$isbn&amp;rft.issn=$issn&amp;rft.aulast=$aulast&amp;rft.aufirst=$aufirst$oauthors&amp;rft.pub=$publisher&amp;rft.date=$pubyear&amp;rft.pages=$pages";
     $coins_value =~ s/(\ |&[^a])/\+/g;
     $coins_value =~ s/\"/\&quot\;/g;
 
@@ -1214,6 +1258,72 @@ sub GetCOinSBiblio {
     return $coins_value;
 }
 
+
+=head2 GetMarcPrice
+
+return the prices in accordance with the Marc format.
+=cut
+
+sub GetMarcPrice {
+    my ( $record, $marcflavour ) = @_;
+    my @listtags;
+    my $subfield;
+    
+    if ( $marcflavour eq "MARC21" ) {
+        @listtags = ('345', '020');
+        $subfield="c";
+    } elsif ( $marcflavour eq "UNIMARC" ) {
+        @listtags = ('345', '010');
+        $subfield="d";
+    } else {
+        return;
+    }
+    
+    for my $field ( $record->field(@listtags) ) {
+        for my $subfield_value  ($field->subfield($subfield)){
+            #check value
+            return $subfield_value if ($subfield_value);
+        }
+    }
+    return 0; # no price found
+}
+
+=head2 GetMarcQuantity
+
+return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
+Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
+
+=cut
+
+sub GetMarcQuantity {
+    my ( $record, $marcflavour ) = @_;
+    my @listtags;
+    my $subfield;
+    
+    if ( $marcflavour eq "MARC21" ) {
+        return 0
+    } elsif ( $marcflavour eq "UNIMARC" ) {
+        @listtags = ('969');
+        $subfield="a";
+    } else {
+        return;
+    }
+    
+    for my $field ( $record->field(@listtags) ) {
+        for my $subfield_value  ($field->subfield($subfield)){
+            #check value
+            if ($subfield_value) {
+                 # in France, the cents separator is the , but sometimes, ppl use a .
+                 # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
+                $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
+                return $subfield_value;
+            }
+        }
+    }
+    return 0; # no price found
+}
+
+
 =head2 GetAuthorisedValueDesc
 
   my $subfieldvalue =get_authorised_value_desc(
@@ -1231,6 +1341,8 @@ descriptions rather than normal ones when they exist.
 
 =cut
 
+my $_auth_val;
+
 sub GetAuthorisedValueDesc {
     my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
     my $dbh = C4::Context->dbh;
@@ -1254,9 +1366,16 @@ sub GetAuthorisedValueDesc {
     }
 
     if ( $category ne "" ) {
-        my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
-        $sth->execute( $category, $value );
-        my $data = $sth->fetchrow_hashref;
+
+       my $data;
+
+       if ( $data = $_auth_val->{$category}->{$value} ) {
+warn "XXX auth_val hit: $category $value\n";
+       } else {
+               my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
+               $sth->execute( $category, $value );
+               $_auth_val->{$category}->{$value} = $data = $sth->fetchrow_hashref;
+       }
         return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
     } else {
         return $value;    # if nothing is found return the original value
@@ -1297,10 +1416,10 @@ ISBNs stored in differents places depending on MARC flavour
 sub GetMarcISBN {
     my ( $record, $marcflavour ) = @_;
     my $scope;
-    if ( $marcflavour eq "MARC21" ) {
-        $scope = '020';
-    } else {    # assume unimarc if not marc21
+    if ( $marcflavour eq "UNIMARC" ) {
         $scope = '010';
+    } else {    # assume marc21 if not unimarc
+        $scope = '020';
     }
     my @marcisbns;
     my $isbn = "";
@@ -1337,10 +1456,10 @@ The note are stored in differents places depending on MARC flavour
 sub GetMarcNotes {
     my ( $record, $marcflavour ) = @_;
     my $scope;
-    if ( $marcflavour eq "MARC21" ) {
-        $scope = '5..';
-    } else {    # assume unimarc if not marc21
+    if ( $marcflavour eq "UNIMARC" ) {
         $scope = '3..';
+    } else {    # assume marc21 if not unimarc
+        $scope = '5..';
     }
     my @marcnotes;
     my $note = "";
@@ -1377,12 +1496,12 @@ The subjects are stored in differents places depending on MARC flavour
 sub GetMarcSubjects {
     my ( $record, $marcflavour ) = @_;
     my ( $mintag, $maxtag );
-    if ( $marcflavour eq "MARC21" ) {
-        $mintag = "600";
-        $maxtag = "699";
-    } else {    # assume unimarc if not marc21
+    if ( $marcflavour eq "UNIMARC" ) {
         $mintag = "600";
         $maxtag = "611";
+    } else {    # assume marc21 if not unimarc
+        $mintag = "600";
+        $maxtag = "699";
     }
 
     my @marcsubjects;
@@ -1412,7 +1531,10 @@ sub GetMarcSubjects {
             my $value     = $subject_subfield->[1];
             my $linkvalue = $value;
             $linkvalue =~ s/(\(|\))//g;
-            my $operator = " and " unless $counter == 0;
+            my $operator;
+            if ( $counter != 0 ) {
+                $operator = ' and ';
+            }
             if ( $code eq 9 ) {
                 $found9 = 1;
                 @link_loop = ( { 'limit' => 'an', link => "$linkvalue" } );
@@ -1420,7 +1542,10 @@ sub GetMarcSubjects {
             if ( not $found9 ) {
                 push @link_loop, { 'limit' => $subject_limit, link => $linkvalue, operator => $operator };
             }
-            my $separator = C4::Context->preference("authoritysep") unless $counter == 0;
+            my $separator;
+            if ( $counter != 0 ) {
+                $separator = C4::Context->preference('authoritysep');
+            }
 
             # ignore $9
             my @this_link_loop = @link_loop;
@@ -1450,12 +1575,12 @@ sub GetMarcAuthors {
     # tagslib useful for UNIMARC author reponsabilities
     my $tagslib =
       &GetMarcStructure( 1, '' );    # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
-    if ( $marcflavour eq "MARC21" ) {
-        $mintag = "700";
-        $maxtag = "720";
-    } elsif ( $marcflavour eq "UNIMARC" ) {    # assume unimarc if not marc21
+    if ( $marcflavour eq "UNIMARC" ) {
         $mintag = "700";
         $maxtag = "712";
+    } elsif ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) { # assume marc21 or normarc if not unimarc
+        $mintag = "700";
+        $maxtag = "720";
     } else {
         return;
     }
@@ -1478,7 +1603,10 @@ sub GetMarcAuthors {
             my $value        = $authors_subfield->[1];
             my $linkvalue    = $value;
             $linkvalue =~ s/(\(|\))//g;
-            my $operator = " and " unless $count_auth == 0;
+            my $operator;
+            if ( $count_auth != 0 ) {
+                $operator = ' and ';
+            }
 
             # if we have an authority link, use that as the link, otherwise use standard searching
             if ($subfield9) {
@@ -1494,8 +1622,17 @@ sub GetMarcAuthors {
             $value = GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib )
               if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /4/ ) );
             my @this_link_loop = @link_loop;
-            my $separator = C4::Context->preference("authoritysep") unless $count_auth == 0;
-            push @subfields_loop, { code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $authors_subfield->[0] eq '9' );
+            my $separator;
+            if ( $count_auth != 0 ) {
+                $separator = C4::Context->preference('authoritysep');
+            }
+            push @subfields_loop,
+              { code      => $subfieldcode,
+                value     => $value,
+                link_loop => \@this_link_loop,
+                separator => $separator
+              }
+              unless ( $authors_subfield->[0] eq '9' );
             $count_auth++;
         }
         push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
@@ -1570,12 +1707,12 @@ The series are stored in differents places depending on MARC flavour
 sub GetMarcSeries {
     my ( $record, $marcflavour ) = @_;
     my ( $mintag, $maxtag );
-    if ( $marcflavour eq "MARC21" ) {
-        $mintag = "440";
-        $maxtag = "490";
-    } else {    # assume unimarc if not marc21
+    if ( $marcflavour eq "UNIMARC" ) {
         $mintag = "600";
         $maxtag = "619";
+    } else {    # assume marc21 if not unimarc
+        $mintag = "440";
+        $maxtag = "490";
     }
 
     my @marcseries;
@@ -1606,13 +1743,27 @@ sub GetMarcSeries {
             my $value     = $series_subfield->[1];
             my $linkvalue = $value;
             $linkvalue =~ s/(\(|\))//g;
-            my $operator = " and " unless $counter == 0;
-            push @link_loop, { link => $linkvalue, operator => $operator };
-            my $separator = C4::Context->preference("authoritysep") unless $counter == 0;
+            if ( $counter != 0 ) {
+                push @link_loop, { link => $linkvalue, operator => ' and ', };
+            } else {
+                push @link_loop, { link => $linkvalue, operator => undef, };
+            }
+            my $separator;
+            if ( $counter != 0 ) {
+                $separator = C4::Context->preference('authoritysep');
+            }
             if ($volume_number) {
                 push @subfields_loop, { volumenum => $value };
             } else {
-                push @subfields_loop, { code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number } unless ( $series_subfield->[0] eq '9' );
+                if ( $series_subfield->[0] ne '9' ) {
+                    push @subfields_loop, {
+                        code      => $code,
+                        value     => $value,
+                        link_loop => \@link_loop,
+                        separator => $separator,
+                        volumenum => $volume_number,
+                    };
+                }
             }
             $counter++;
         }
@@ -1627,19 +1778,70 @@ sub GetMarcSeries {
     return $marcseriessarray;
 }    #end getMARCseriess
 
+=head2 GetMarcHosts
+
+  $marchostsarray = GetMarcHosts($record,$marcflavour);
+
+Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
+
+=cut
+
+sub GetMarcHosts {
+    my ( $record, $marcflavour ) = @_;
+    my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
+    $marcflavour ||="MARC21";
+    if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
+        $tag = "773";
+        $title_subf = "t";
+        $bibnumber_subf ="0";
+        $itemnumber_subf='9';
+    }
+    elsif ($marcflavour eq "UNIMARC") {
+        $tag = "461";
+        $title_subf = "t";
+        $bibnumber_subf ="0";
+        $itemnumber_subf='9';
+    };
+
+    my @marchosts;
+
+    foreach my $field ( $record->field($tag)) {
+
+        my @fields_loop;
+
+        my $hostbiblionumber = $field->subfield("$bibnumber_subf");
+        my $hosttitle = $field->subfield($title_subf);
+        my $hostitemnumber=$field->subfield($itemnumber_subf);
+        push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
+        push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
+
+        }
+    my $marchostsarray = \@marchosts;
+    return $marchostsarray;
+}
+
 =head2 GetFrameworkCode
 
   $frameworkcode = GetFrameworkCode( $biblionumber )
 
 =cut
 
+our $_frameworkcode;
+
 sub GetFrameworkCode {
     my ($biblionumber) = @_;
+
+    my $frameworkcode;
+    if ( $frameworkcode = $_frameworkcode->{$biblionumber} ) {
+warn "# _frameworkcode hit $biblionumber\n";
+       return $frameworkcode;
+    }
+
     my $dbh            = C4::Context->dbh;
     my $sth            = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
     $sth->execute($biblionumber);
     my ($frameworkcode) = $sth->fetchrow;
-    return $frameworkcode;
+    return $_frameworkcode->{$biblionumber} = $frameworkcode;
 }
 
 =head2 TransformKohaToMarc
@@ -1664,6 +1866,86 @@ sub TransformKohaToMarc {
     return $record;
 }
 
+=head2 PrepHostMarcField
+
+    $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
+
+This function returns a host field populated with data from the host record, the field can then be added to an analytical record
+
+=cut
+
+sub PrepHostMarcField {
+    my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
+    $marcflavour ||="MARC21";
+    
+    my $hostrecord = GetMarcBiblio($hostbiblionumber);
+       my $item = C4::Items::GetItem($hostitemnumber);
+       
+       my $hostmarcfield;
+    if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
+       
+        #main entry
+        my $mainentry;
+        if ($hostrecord->subfield('100','a')){
+            $mainentry = $hostrecord->subfield('100','a');
+        } elsif ($hostrecord->subfield('110','a')){
+            $mainentry = $hostrecord->subfield('110','a');
+        } else {
+            $mainentry = $hostrecord->subfield('111','a');
+        }
+       
+        # qualification info
+        my $qualinfo;
+        if (my $field260 = $hostrecord->field('260')){
+            $qualinfo =  $field260->as_string( 'abc' );
+        }
+       
+
+       #other fields
+        my $ed = $hostrecord->subfield('250','a');
+        my $barcode = $item->{'barcode'};
+        my $title = $hostrecord->subfield('245','a');
+
+        # record control number, 001 with 003 and prefix
+        my $recctrlno;
+        if ($hostrecord->field('001')){
+            $recctrlno = $hostrecord->field('001')->data();
+            if ($hostrecord->field('003')){
+                $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
+            }
+        }
+
+        # issn/isbn
+        my $issn = $hostrecord->subfield('022','a');
+        my $isbn = $hostrecord->subfield('020','a');
+
+
+        $hostmarcfield = MARC::Field->new(
+                773, '0', '',
+                '0' => $hostbiblionumber,
+                '9' => $hostitemnumber,
+                'a' => $mainentry,
+                'b' => $ed,
+                'd' => $qualinfo,
+                'o' => $barcode,
+                't' => $title,
+                'w' => $recctrlno,
+                'x' => $issn,
+                'z' => $isbn
+                );
+    } elsif ($marcflavour eq "UNIMARC") {
+        $hostmarcfield = MARC::Field->new(
+            461, '', '',
+            '0' => $hostbiblionumber,
+            't' => $hostrecord->subfield('200','a'), 
+            '9' => $hostitemnumber
+        );     
+    };
+
+    return $hostmarcfield;
+}
+
+
 =head2 TransformKohaToMarcOneField
 
     $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
@@ -1856,8 +2138,8 @@ sub _default_ind_to_space {
 
 =head2 TransformHtmlToMarc
 
-    L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
-    L<$params> is a ref to an array as below:
+    L<$record> = TransformHtmlToMarc(L<$cgi>)
+    L<$cgi> is the CGI object which containts the values for subfields
     {
         'tag_010_indicator1_531951' ,
         'tag_010_indicator2_531951' ,
@@ -1874,15 +2156,15 @@ sub _default_ind_to_space {
         'tag_200_code_f_873510_110730' ,
         'tag_200_subfield_f_873510_110730' ,
     }
-    L<$cgi> is the CGI object which containts the value.
     L<$record> is the MARC::Record object.
 
 =cut
 
 sub TransformHtmlToMarc {
-    my $params = shift;
     my $cgi    = shift;
 
+    my @params = $cgi->param();
+
     # explicitly turn on the UTF-8 flag for all
     # 'tag_' parameters to avoid incorrect character
     # conversion later on
@@ -1902,8 +2184,8 @@ sub TransformHtmlToMarc {
     my $record = MARC::Record->new();
     my $i      = 0;
     my @fields;
-    while ( $params->[$i] ) {    # browse all CGI params
-        my $param    = $params->[$i];
+    while ( $params[$i] ) {    # browse all CGI params
+        my $param    = $params[$i];
         my $newfield = 0;
 
         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
@@ -1919,7 +2201,7 @@ sub TransformHtmlToMarc {
             my $tag = $1;
 
             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
-            my $ind2 = _default_ind_to_space( substr( $cgi->param( $params->[ $i + 1 ] ), 0, 1 ) );
+            my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
             $newfield = 0;
             my $j = $i + 2;
 
@@ -1929,27 +2211,27 @@ sub TransformHtmlToMarc {
                     # Force a fake leader even if not provided to avoid crashing
                     # during decoding MARC record containing UTF-8 characters
                     $record->leader(
-                        length( $cgi->param($params->[$j+1]) ) == 24
-                        ? $cgi->param( $params->[ $j + 1 ] )
+                        length( $cgi->param($params[$j+1]) ) == 24
+                        ? $cgi->param( $params[ $j + 1 ] )
                         : '     nam a22        4500'
                        )
                     ;
                     # between 001 and 009 (included)
-                } elsif ( $cgi->param( $params->[ $j + 1 ] ) ne '' ) {
-                    $newfield = MARC::Field->new( $tag, $cgi->param( $params->[ $j + 1 ] ), );
+                } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
+                    $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
                 }
 
                 # > 009, deal with subfields
             } else {
-                while ( defined $params->[$j] && $params->[$j] =~ /_code_/ ) {    # browse all it's subfield
-                    my $inner_param = $params->[$j];
+                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 ] ) );
+                        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 ] ), );
+                        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 ] ), );
                         }
                     }
                     $j += 2;
@@ -2228,8 +2510,11 @@ sub PrepareItemrecordDisplay {
     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
 
     # return nothing if we don't have found an existing framework.
-    return "" unless $tagslib;
-    my $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum ) if ($itemnum);
+    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} ) {
@@ -2268,15 +2553,20 @@ sub PrepareItemrecordDisplay {
                     && C4::Context->preference('itemcallnumber') ) {
                     my $CNtag      = substr( C4::Context->preference('itemcallnumber'), 0, 3 );
                     my $CNsubfield = substr( C4::Context->preference('itemcallnumber'), 3, 1 );
-                    my $temp = $itemrecord->field($CNtag) if ($itemrecord);
-                    if ($temp) {
-                        $defaultvalue = $temp->subfield($CNsubfield);
+                    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 = $itemrecord->field($subfield) if ($itemrecord);
+                    my $temp;
+                    if ($itemrecord) {
+                        $temp = $itemrecord->field($subfield);
+                    }
                     unless ($temp) {
                         $defaultvalue = $defaultvalues->{'callnumber'} if $defaultvalues;
                     }
@@ -2284,7 +2574,10 @@ sub PrepareItemrecordDisplay {
                 if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.holdingbranch' || $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.homebranch' )
                     && $defaultvalues
                     && $defaultvalues->{'branchcode'} ) {
-                    my $temp = $itemrecord->field($subfield) if ($itemrecord);
+                    my $temp;
+                    if ($itemrecord) {
+                        $temp = $itemrecord->field($subfield);
+                    }
                     unless ($temp) {
                         $defaultvalue = $defaultvalues->{branchcode} if $defaultvalues;
                     }
@@ -2368,6 +2661,40 @@ sub PrepareItemrecordDisplay {
                         -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\" />";
                 }
@@ -2375,8 +2702,10 @@ sub PrepareItemrecordDisplay {
             }
         }
     }
-    my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
-      if ( $itemrecord && $itemrecord->field($itemtagfield) );
+    my $itemnumber;
+    if ( $itemrecord && $itemrecord->field($itemtagfield) ) {
+        $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield );
+    }
     return {
         'itemtagfield'    => $itemtagfield,
         'itemtagsubfield' => $itemtagsubfield,
@@ -2523,6 +2852,36 @@ sub GetNoZebraIndexes {
     return %indexes;
 }
 
+=head2 EmbedItemsInMarcBiblio
+
+    EmbedItemsInMarcBiblio($marc, $biblionumber);
+
+Given a MARC::Record object containing a bib record,
+modify it to include the items attached to it as 9XX
+per the bib's MARC framework.
+
+=cut
+
+sub EmbedItemsInMarcBiblio {
+    my ($marc, $biblionumber) = @_;
+    croak "No MARC record" unless $marc;
+
+    my $frameworkcode = GetFrameworkCode($biblionumber);
+    _strip_item_fields($marc, $frameworkcode);
+
+    # ... and embed the current items
+    my $dbh = C4::Context->dbh;
+    my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
+    $sth->execute($biblionumber);
+    my @item_fields;
+    my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
+    while (my ($itemnumber) = $sth->fetchrow_array) {
+        my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
+        push @item_fields, $item_marc->field($itemtag);
+    }
+    $marc->append_fields(@item_fields);
+}
+
 =head1 INTERNAL FUNCTIONS
 
 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
@@ -2861,7 +3220,7 @@ sub _koha_marc_update_bib_ids {
         # drop old field and create new one...
         $old_field = $record->field($biblio_tag);
         $record->delete_field($old_field) if $old_field;
-        $record->append_fields($new_field);
+        $record->insert_fields_ordered($new_field);
 
         # deal with biblioitemnumber
         if ( $biblioitem_tag < 10 ) {
@@ -3277,7 +3636,7 @@ sub ModBiblioMarc {
         }
         substr( $string, 22, 6, "frey50" );
         unless ( $record->subfield( 100, "a" ) ) {
-            $record->insert_grouped_field( MARC::Field->new( 100, "", "", "a" => $string ) );
+            $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
         }
     }
 
@@ -3471,6 +3830,76 @@ sub get_biblio_authorised_values {
     return $authorised_values;
 }
 
+=head2 CountBiblioInOrders
+
+=over 4
+$count = &CountBiblioInOrders( $biblionumber);
+
+=back
+
+This function return count of biblios in orders with $biblionumber 
+
+=cut
+
+sub CountBiblioInOrders {
+ my ($biblionumber) = @_;
+    my $dbh            = C4::Context->dbh;
+    my $query          = "SELECT count(*)
+          FROM  aqorders 
+          WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
+    my $sth = $dbh->prepare($query);
+    $sth->execute($biblionumber);
+    my $count = $sth->fetchrow;
+    return ($count);
+}
+
+=head2 GetSubscriptionsId
+
+=over 4
+$subscriptions = &GetSubscriptionsId($biblionumber);
+
+=back
+
+This function return an array of subscriptionid with $biblionumber
+
+=cut
+
+sub GetSubscriptionsId {
+ my ($biblionumber) = @_;
+    my $dbh            = C4::Context->dbh;
+    my $query          = "SELECT subscriptionid
+          FROM  subscription
+          WHERE biblionumber=?";
+    my $sth = $dbh->prepare($query);
+    $sth->execute($biblionumber);
+    my @subscriptions = $sth->fetchrow_array;
+    return (@subscriptions);
+}
+
+=head2 GetHolds
+
+=over 4
+$holds = &GetHolds($biblionumber);
+
+=back
+
+This function return the count of holds with $biblionumber
+
+=cut
+
+sub GetHolds {
+ my ($biblionumber) = @_;
+    my $dbh            = C4::Context->dbh;
+    my $query          = "SELECT count(*)
+          FROM  reserves
+          WHERE biblionumber=?";
+    my $sth = $dbh->prepare($query);
+    $sth->execute($biblionumber);
+    my $holds = $sth->fetchrow;
+    return ($holds);
+}
+
+
 1;
 
 __END__