Bug 14346: (folowup) Fix previously existing POD
[koha.git] / C4 / Biblio.pm
index add0f74..d3d2bf9 100644 (file)
@@ -6,24 +6,24 @@ package C4::Biblio;
 #
 # This file is part of Koha.
 #
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
 #
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
 
 use strict;
 use warnings;
 use Carp;
 
-# use utf8;
+use Encode qw( decode is_utf8 );
 use MARC::Record;
 use MARC::File::USMARC;
 use MARC::File::XML;
@@ -33,11 +33,14 @@ use Module::Load::Conditional qw(can_load);
 use C4::Koha;
 use C4::Dates qw/format_date/;
 use C4::Log;    # logaction
+use C4::Budgets;
 use C4::ClassSource;
 use C4::Charset;
 use C4::Linker;
 use C4::OAI::Sets;
 
+use Koha::Cache;
+
 use vars qw($VERSION @ISA @EXPORT);
 
 BEGIN {
@@ -138,16 +141,6 @@ BEGIN {
     );
 }
 
-eval {
-    if (C4::Context->ismemcached) {
-        require Memoize::Memcached;
-        import Memoize::Memcached qw(memoize_memcached);
-
-        memoize_memcached( 'GetMarcStructure',
-                            memcached => C4::Context->memcached);
-    }
-};
-
 =head1 NAME
 
 C4::Biblio - cataloging management functions
@@ -250,6 +243,10 @@ sub AddBiblio {
     my $frameworkcode   = shift;
     my $options         = @_ ? shift : undef;
     my $defer_marc_save = 0;
+    if (!$record) {
+        carp('AddBiblio called with undefined record');
+        return;
+    }
     if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
         $defer_marc_save = 1;
     }
@@ -299,15 +296,20 @@ in the C<biblio> and C<biblioitems> tables, as well as
 which fields are used to store embedded item, biblioitem,
 and biblionumber data for indexing.
 
+Returns 1 on success 0 on failure
+
 =cut
 
 sub ModBiblio {
     my ( $record, $biblionumber, $frameworkcode ) = @_;
-    croak "No record" unless $record;
+    if (!$record) {
+        carp 'No record passed to ModBiblio';
+        return 0;
+    }
 
     if ( C4::Context->preference("CataloguingLog") ) {
         my $newrecord = GetMarcBiblio($biblionumber);
-        logaction( "CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>" . $newrecord->as_formatted );
+        logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
     }
 
     # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
@@ -401,9 +403,9 @@ sub ModBiblioframework {
   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)
-Also backs it up to deleted* tables
-Checks to make sure there are not issues on any of the items
+Deletes biblio record from Zebra and Koha tables (biblio & biblioitems)
+Also backs it up to deleted* tables.
+Checks to make sure that the biblio has no items attached.
 return:
 C<$error> : undef unless an error occurs
 
@@ -434,7 +436,7 @@ sub DelBiblio {
 
     # We delete any existing holds
     require C4::Reserves;
-    my ($count, $reserves) = C4::Reserves::GetReservesFromBiblionumber($biblionumber);
+    my $reserves = C4::Reserves::GetReservesFromBiblionumber({ biblionumber => $biblionumber });
     foreach my $res ( @$reserves ) {
         C4::Reserves::CancelReserve({ reserve_id => $res->{'reserve_id'} });
     }
@@ -461,7 +463,7 @@ sub DelBiblio {
     # from being generated by _koha_delete_biblioitems
     $error = _koha_delete_biblio( $dbh, $biblionumber );
 
-    logaction( "CATALOGUING", "DELETE", $biblionumber, "" ) if C4::Context->preference("CataloguingLog");
+    logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
 
     return;
 }
@@ -473,11 +475,17 @@ sub DelBiblio {
 
 Automatically links headings in a bib record to authorities.
 
+Returns the number of headings changed
+
 =cut
 
 sub BiblioAutoLink {
     my $record        = shift;
     my $frameworkcode = shift;
+    if (!$record) {
+        carp('Undefined record passed to BiblioAutoLink');
+        return 0;
+    }
     my ( $num_headings_changed, %results );
 
     my $linker_module =
@@ -485,7 +493,7 @@ sub BiblioAutoLink {
     unless ( can_load( modules => { $linker_module => undef } ) ) {
         $linker_module = 'C4::Linker::Default';
         unless ( can_load( modules => { $linker_module => undef } ) ) {
-            return 0, 0;
+            return 0;
         }
     }
 
@@ -522,6 +530,10 @@ sub LinkBibHeadingsToAuthorities {
     my $frameworkcode = shift;
     my $allowrelink = shift;
     my %results;
+    if (!$bib) {
+        carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
+        return ( 0, {});
+    }
     require C4::Heading;
     require C4::AuthoritiesMarc;
 
@@ -615,6 +627,7 @@ sub LinkBibHeadingsToAuthorities {
                         $heading->auth_type() );
                     $field->add_subfields( '9', $authid );
                     $num_headings_changed++;
+                    $linker->update_cache($heading, $authid);
                     $results{'added'}->{ $heading->display_form() }++;
                 }
             }
@@ -644,7 +657,7 @@ sub LinkBibHeadingsToAuthorities {
     }
 
 Check whether the specified heading-auth link is valid without reference
-to Zebra/Solr. Ideally this code would be in C4::Heading, but that won't be
+to Zebra. Ideally this code would be in C4::Heading, but that won't be
 possible until we have de-cycled C4::AuthoritiesMarc, so this is the
 safest place.
 
@@ -671,6 +684,11 @@ Get MARC fields from a keyword defined in fieldmapping table.
 
 sub GetRecordValue {
     my ( $field, $record, $frameworkcode ) = @_;
+
+    if (!$record) {
+        carp 'GetRecordValue called with undefined record';
+        return;
+    }
     my $dbh = C4::Context->dbh;
 
     my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
@@ -1049,13 +1067,15 @@ sub GetBiblio {
 sub GetBiblioItemInfosOf {
     my @biblioitemnumbers = @_;
 
-    my $query = '
+    my $biblioitemnumber_values = @biblioitemnumbers ? join( ',', @biblioitemnumbers ) : "''";
+
+    my $query = "
         SELECT biblioitemnumber,
             publicationyear,
             itemtype
         FROM biblioitems
-        WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
-    ';
+        WHERE biblioitemnumber IN ($biblioitemnumber_values)
+    ";
     return get_infos_of( $query, 'biblioitemnumber' );
 }
 
@@ -1071,24 +1091,17 @@ $frameworkcode : the framework code to read
 
 =cut
 
-# cache for results of GetMarcStructure -- needed
-# for batch jobs
-our $marc_structure_cache;
-
 sub GetMarcStructure {
     my ( $forlibrarian, $frameworkcode ) = @_;
     my $dbh = C4::Context->dbh;
     $frameworkcode = "" unless $frameworkcode;
 
-    if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) {
-        return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
-    }
+    $forlibrarian = $forlibrarian ? 1 : 0;
+    my $cache = Koha::Cache->get_instance();
+    my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
+    my $cached = $cache->get_from_cache($cache_key);
+    return $cached if $cached;
 
-    #     my $sth = $dbh->prepare(
-    #         "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
-    #     $sth->execute($frameworkcode);
-    #     my ($total) = $sth->fetchrow;
-    #     $frameworkcode = "" unless ( $total > 0 );
     my $sth = $dbh->prepare(
         "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable 
         FROM marc_tag_structure 
@@ -1150,8 +1163,7 @@ sub GetMarcStructure {
         $res->{$tag}->{$subfield}->{maxlength}        = $maxlength;
     }
 
-    $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
-
+    $cache->set_in_cache($cache_key, $res);
     return $res;
 }
 
@@ -1249,6 +1261,12 @@ The MARC record contains biblio data, and items data if $embeditems is set to tr
 sub GetMarcBiblio {
     my $biblionumber = shift;
     my $embeditems   = shift || 0;
+
+    if (not defined $biblionumber) {
+        carp 'GetMarcBiblio called with undefined biblionumber';
+        return;
+    }
+
     my $dbh          = C4::Context->dbh;
     my $sth          = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
     $sth->execute($biblionumber);
@@ -1302,7 +1320,8 @@ sub GetCOinSBiblio {
 
     # get the coin format
     if ( ! $record ) {
-       return;
+        carp 'GetCOinSBiblio called with undefined record';
+        return;
     }
     my $pos7 = substr $record->leader(), 7, 1;
     my $pos6 = substr $record->leader(), 6, 1;
@@ -1443,14 +1462,24 @@ sub GetCOinSBiblio {
 =head2 GetMarcPrice
 
 return the prices in accordance with the Marc format.
+
+returns 0 if no price found
+returns undef if called without a marc record or with
+an unrecognized marc format
+
 =cut
 
 sub GetMarcPrice {
     my ( $record, $marcflavour ) = @_;
+    if (!$record) {
+        carp 'GetMarcPrice called on undefined record';
+        return;
+    }
+
     my @listtags;
     my $subfield;
     
-    if ( $marcflavour eq "MARC21" ) {
+    if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
         @listtags = ('345', '020');
         $subfield="c";
     } elsif ( $marcflavour eq "UNIMARC" ) {
@@ -1477,38 +1506,54 @@ Return the best guess at what the actual price is from a price field.
 
 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";
+    # Look for the currency symbol and the normalized code of the active currency, if it's there,
+    my $active_currency = C4::Budgets->GetCurrency();
+    my $symbol = $active_currency->{'symbol'};
+    my $isocode = $active_currency->{'isocode'};
+    $isocode = $active_currency->{'currency'} unless defined $isocode;
+    my $localprice;
+    if ( $symbol ) {
+        my @matches =($price=~ /
+            \s?
+            (                          # start of capturing parenthesis
+            (?:
+            (?:[\p{Sc}\p{L}\/.]){1,4}  # any character from Currency signs or Letter Unicode categories or slash or dot                                              within 1 to 4 occurrences : call this whole block 'symbol block'
+            |(?:\d+[\p{P}\s]?){1,4}    # or else at least one digit followed or not by a punctuation sign or whitespace,                                             all theese within 1 to 4 occurrences : call this whole block 'digits block'
+            )
+            \s?\p{Sc}?\s?              # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
+            (?:
+            (?:[\p{Sc}\p{L}\/.]){1,4}  # followed by same block as symbol block
+            |(?:\d+[\p{P}\s]?){1,4}    # or by same block as digits block
+            )
+            \s?\p{L}{0,4}\s?           # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
+            )                          # end of capturing parenthesis
+            (?:\p{P}|\z)               # followed by a punctuation sign or by the end of the string
+            /gx);
+
+        if ( @matches ) {
+            foreach ( @matches ) {
+                $localprice = $_ and last if index($_, $isocode)>=0;
+            }
+            if ( !$localprice ) {
+                foreach ( @matches ) {
+                    $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
+                }
+            }
+        }
     }
-
+    if ( $localprice ) {
+        $price = $localprice;
+    } else {
+        ## 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]?)/;
+    }
+    # eliminate symbol/isocode, space and any final dot from the string
+    $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
+    # remove comma,dot when used as separators from hundreds
+    $price =~s/[\,\.](\d{3})/$1/g;
+    # convert comma to dot to ensure correct display of decimals if existing
+    $price =~s/,/./;
     return $price;
 }
 
@@ -1518,10 +1563,19 @@ sub MungeMarcPrice {
 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
 
+returns 0 if no quantity found
+returns undef if called without a marc record or with
+an unrecognized marc format
+
 =cut
 
 sub GetMarcQuantity {
     my ( $record, $marcflavour ) = @_;
+    if (!$record) {
+        carp 'GetMarcQuantity called on undefined record';
+        return;
+    }
+
     my @listtags;
     my $subfield;
     
@@ -1608,6 +1662,10 @@ Get the control number / record Identifier from the MARC record and return it.
 
 sub GetMarcControlnumber {
     my ( $record, $marcflavour ) = @_;
+    if (!$record) {
+        carp 'GetMarcControlnumber called on undefined record';
+        return;
+    }
     my $controlnumber = "";
     # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
     # Keep $marcflavour for possible later use
@@ -1631,32 +1689,25 @@ ISBNs stored in different fields depending on MARC flavour
 
 sub GetMarcISBN {
     my ( $record, $marcflavour ) = @_;
+    if (!$record) {
+        carp 'GetMarcISBN called on undefined record';
+        return;
+    }
     my $scope;
     if ( $marcflavour eq "UNIMARC" ) {
         $scope = '010';
     } else {    # assume marc21 if not unimarc
         $scope = '020';
     }
+
     my @marcisbns;
-    my $isbn = "";
-    my $tag  = "";
-    my $marcisbn;
     foreach my $field ( $record->field($scope) ) {
-        my $value = $field->as_string();
+        my $isbn = $field->subfield( 'a' );
         if ( $isbn ne "" ) {
-            $marcisbn = { marcisbn => $isbn, };
-            push @marcisbns, $marcisbn;
-            $isbn = $value;
-        }
-        if ( $isbn ne $value ) {
-            $isbn = $isbn . " " . $value;
+            push @marcisbns, $isbn;
         }
     }
 
-    if ($isbn) {
-        $marcisbn = { marcisbn => $isbn };
-        push @marcisbns, $marcisbn;    #load last tag into array
-    }
     return \@marcisbns;
 }    # end GetMarcISBN
 
@@ -1672,6 +1723,10 @@ ISSNs are stored in different fields depending on MARC flavour
 
 sub GetMarcISSN {
     my ( $record, $marcflavour ) = @_;
+    if (!$record) {
+        carp 'GetMarcISSN called on undefined record';
+        return;
+    }
     my $scope;
     if ( $marcflavour eq "UNIMARC" ) {
         $scope = '011';
@@ -1681,7 +1736,8 @@ sub GetMarcISSN {
     }
     my @marcissns;
     foreach my $field ( $record->field($scope) ) {
-        push @marcissns, $field->subfield( 'a' );
+        push @marcissns, $field->subfield( 'a' )
+            if ( $field->subfield( 'a' ) ne "" );
     }
     return \@marcissns;
 }    # end GetMarcISSN
@@ -1697,6 +1753,10 @@ The note are stored in different fields depending on MARC flavour
 
 sub GetMarcNotes {
     my ( $record, $marcflavour ) = @_;
+    if (!$record) {
+        carp 'GetMarcNotes called on undefined record';
+        return;
+    }
     my $scope;
     if ( $marcflavour eq "UNIMARC" ) {
         $scope = '3..';
@@ -1741,6 +1801,10 @@ The subjects are stored in different fields depending on MARC flavour
 
 sub GetMarcSubjects {
     my ( $record, $marcflavour ) = @_;
+    if (!$record) {
+        carp 'GetMarcSubjects called on undefined record';
+        return;
+    }
     my ( $mintag, $maxtag, $fields_filter );
     if ( $marcflavour eq "UNIMARC" ) {
         $mintag = "600";
@@ -1755,7 +1819,7 @@ sub GetMarcSubjects {
     my @marcsubjects;
 
     my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
-    my $authoritysep = C4::Context->preference('authoritysep');
+    my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
 
     foreach my $field ( $record->field($fields_filter) ) {
         next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
@@ -1801,7 +1865,7 @@ sub GetMarcSubjects {
                     code      => $code,
                     value     => $value,
                     link_loop => \@this_link_loop,
-                    separator => (scalar @subfields_loop) ? $authoritysep : ''
+                    separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
                 };
             }
         }
@@ -1826,6 +1890,10 @@ The authors are stored in different fields depending on MARC flavour
 
 sub GetMarcAuthors {
     my ( $record, $marcflavour ) = @_;
+    if (!$record) {
+        carp 'GetMarcAuthors called on undefined record';
+        return;
+    }
     my ( $mintag, $maxtag, $fields_filter );
 
     # tagslib useful for UNIMARC author reponsabilities
@@ -1842,7 +1910,7 @@ sub GetMarcAuthors {
     }
 
     my @marcauthors;
-    my $authoritysep = C4::Context->preference('authoritysep');
+    my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
 
     foreach my $field ( $record->field($fields_filter) ) {
         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
@@ -1860,9 +1928,14 @@ sub GetMarcAuthors {
         }
 
         # other subfields
+        my $unimarc3;
         for my $authors_subfield (@subfields) {
             next if ( $authors_subfield->[0] eq '9' );
 
+            # unimarc3 contains the $3 of the author for UNIMARC.
+            # For french academic libraries, it's the "ppn", and it's required for idref webservice
+            $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
+
             # don't load unimarc subfields 3, 5
             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
 
@@ -1891,13 +1964,14 @@ sub GetMarcAuthors {
                     code      => $code,
                     value     => $value,
                     link_loop => \@this_link_loop,
-                    separator => (scalar @subfields_loop) ? $authoritysep : ''
+                    separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
                 };
             }
         }
         push @marcauthors, {
             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
             authoritylink => $subfield9,
+            unimarc3 => $unimarc3
         };
     }
     return \@marcauthors;
@@ -1914,6 +1988,10 @@ Assumes web resources (not uncommon in MARC21 to omit resource type ind)
 
 sub GetMarcUrls {
     my ( $record, $marcflavour ) = @_;
+    if (!$record) {
+        carp 'GetMarcUrls called on undefined record';
+        return;
+    }
 
     my @marcurls;
     for my $field ( $record->field('856') ) {
@@ -1969,6 +2047,11 @@ The series are stored in different fields depending on MARC flavour
 
 sub GetMarcSeries {
     my ( $record, $marcflavour ) = @_;
+    if (!$record) {
+        carp 'GetMarcSeries called on undefined record';
+        return;
+    }
+
     my ( $mintag, $maxtag, $fields_filter );
     if ( $marcflavour eq "UNIMARC" ) {
         $mintag = "225";
@@ -1981,7 +2064,7 @@ sub GetMarcSeries {
     }
 
     my @marcseries;
-    my $authoritysep = C4::Context->preference('authoritysep');
+    my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
 
     foreach my $field ( $record->field($fields_filter) ) {
         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
@@ -2017,7 +2100,7 @@ sub GetMarcSeries {
                     code      => $code,
                     value     => $value,
                     link_loop => \@link_loop,
-                    separator => (scalar @subfields_loop) ? $authoritysep : '',
+                    separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
                     volumenum => $volume_number,
                 }
             }
@@ -2038,6 +2121,11 @@ Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns
 
 sub GetMarcHosts {
     my ( $record, $marcflavour ) = @_;
+    if (!$record) {
+        carp 'GetMarcHosts called on undefined record';
+        return;
+    }
+
     my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
     $marcflavour ||="MARC21";
     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
@@ -2103,20 +2191,25 @@ sub TransformKohaToMarc {
     my $record = MARC::Record->new();
     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
     my $db_to_marc = C4::Context->marcfromkohafield;
+    my $tag_hr = {};
     while ( my ($name, $value) = each %$hash ) {
         next unless my $dtm = $db_to_marc->{''}->{$name};
         next unless ( scalar( @$dtm ) );
         my ($tag, $letter) = @$dtm;
+        $tag .= '';
         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 ) );
-            }
+            next if $value eq '';
+            $tag_hr->{$tag} //= [];
+            push @{$tag_hr->{$tag}}, [($letter, $value)];
         }
-
+    }
+    foreach my $tag (sort keys %$tag_hr) {
+        my @sfl = @{$tag_hr->{$tag}};
+        @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
+        @sfl = map { @{$_}; } @sfl;
+        $record->insert_fields_ordered(
+            MARC::Field->new($tag, " ", " ", @sfl)
+        );
     }
     return $record;
 }
@@ -2255,9 +2348,6 @@ sub TransformHtmlToXml {
         @$values[$i] =~ s/"/&quot;/g;
         @$values[$i] =~ s/'/&apos;/g;
 
-        #         if ( !utf8::is_utf8( @$values[$i] ) ) {
-        #             utf8::decode( @$values[$i] );
-        #         }
         if ( ( @$tags[$i] ne $prevtag ) ) {
             $j++ unless ( @$tags[$i] eq "" );
             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
@@ -2392,11 +2482,9 @@ sub TransformHtmlToMarc {
     foreach my $param_name ( keys %$cgi_params ) {
         if ( $param_name =~ /^tag_/ ) {
             my $param_value = $cgi_params->{$param_name};
-            if ( utf8::decode($param_value) ) {
-                $cgi_params->{$param_name} = $param_value;
+            unless ( Encode::is_utf8( $param_value ) ) {
+                $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
             }
-
-            # FIXME - need to do something if string is not valid UTF-8
         }
     }
 
@@ -2481,12 +2569,19 @@ our $inverted_field_map;
 Extract data from a MARC bib record into a hashref representing
 Koha biblio, biblioitems, and items fields. 
 
+If passed an undefined record will log the error and return an empty
+hash_ref
+
 =cut
 
 sub TransformMarcToKoha {
     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
 
-    my $result;
+    my $result = {};
+    if (!defined $record) {
+        carp('TransformMarcToKoha called with undefined record');
+        return $result;
+    }
     $limit_table = $limit_table || 0;
     $frameworkcode = '' unless defined $frameworkcode;
 
@@ -2799,7 +2894,10 @@ if $itemnumbers is defined, only specified itemnumbers are embedded
 
 sub EmbedItemsInMarcBiblio {
     my ($marc, $biblionumber, $itemnumbers) = @_;
-    croak "No MARC record" unless $marc;
+    if ( !$marc ) {
+        carp 'EmbedItemsInMarcBiblio: No MARC record passed';
+        return;
+    }
 
     $itemnumbers = [] unless defined $itemnumbers;
 
@@ -3262,6 +3360,10 @@ sub ModBiblioMarc {
     # pass the MARC::Record to this function, and it will create the records in
     # the marc field
     my ( $record, $biblionumber, $frameworkcode ) = @_;
+    if ( !$record ) {
+        carp 'ModBiblioMarc passed an undefined record';
+        return;
+    }
 
     # Clone record as it gets modified
     $record = $record->clone();
@@ -3374,10 +3476,7 @@ sub get_biblio_authorised_values {
 
 =head2 CountBiblioInOrders
 
-=over 4
-$count = &CountBiblioInOrders( $biblionumber);
-
-=back
+    $count = &CountBiblioInOrders( $biblionumber);
 
 This function return count of biblios in orders with $biblionumber 
 
@@ -3397,10 +3496,7 @@ sub CountBiblioInOrders {
 
 =head2 GetSubscriptionsId
 
-=over 4
-$subscriptions = &GetSubscriptionsId($biblionumber);
-
-=back
+    $subscriptions = &GetSubscriptionsId($biblionumber);
 
 This function return an array of subscriptionid with $biblionumber
 
@@ -3420,10 +3516,7 @@ sub GetSubscriptionsId {
 
 =head2 GetHolds
 
-=over 4
-$holds = &GetHolds($biblionumber);
-
-=back
+    $holds = &GetHolds($biblionumber);
 
 This function return the count of holds with $biblionumber
 
@@ -3589,16 +3682,26 @@ sub UpdateTotalIssues {
     my ($biblionumber, $increase, $value) = @_;
     my $totalissues;
 
+    my $record = GetMarcBiblio($biblionumber);
+    unless ($record) {
+        carp "UpdateTotalIssues could not get biblio record";
+        return;
+    }
     my $data = GetBiblioData($biblionumber);
+    unless ($data) {
+        carp "UpdateTotalIssues could not get datas of biblio";
+        return;
+    }
+    my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
+    unless ($totalissuestag) {
+        return 1; # There is nothing to do
+    }
 
     if (defined $value) {
         $totalissues = $value;
     } else {
         $totalissues = $data->{'totalissues'} + $increase;
     }
-     my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
-
-     my $record = GetMarcBiblio($biblionumber);
 
      my $field = $record->field($totalissuestag);
      if (defined $field) {
@@ -3609,8 +3712,7 @@ sub UpdateTotalIssues {
          $record->insert_grouped_field($field);
      }
 
-     ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
-     return;
+     return ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
 }
 
 =head2 RemoveAllNsb
@@ -3623,6 +3725,10 @@ Removes all nsb/nse chars from a record
 
 sub RemoveAllNsb {
     my $record = shift;
+    if (!$record) {
+        carp 'RemoveAllNsb called with undefined record';
+        return;
+    }
 
     SetUTF8Flag($record);