small (UNIMARC) fix, error in regexp writing
[koha.git] / C4 / Biblio.pm
index 3871b12..99996f5 100755 (executable)
@@ -18,90 +18,100 @@ package C4::Biblio;
 # Suite 330, Boston, MA  02111-1307 USA
 
 use strict;
-
-require Exporter;
 # use utf8;
-use C4::Context;
 use MARC::Record;
 use MARC::File::USMARC;
 use MARC::File::XML;
 use ZOOM;
+
+use C4::Context;
 use C4::Koha;
 use C4::Branch;
 use C4::Dates qw/format_date/;
 use C4::Log; # logaction
 use C4::ClassSource;
+use C4::Charset;
+
 use vars qw($VERSION @ISA @EXPORT);
 
-# TODO: fix version
-# $VERSION = ?;
+BEGIN {
+       $VERSION = 1.00;
 
-@ISA = qw( Exporter );
+       require Exporter;
+       @ISA = qw( Exporter );
 
+       # to add biblios
 # EXPORTED FUNCTIONS.
+       push @EXPORT, qw( 
+               &AddBiblio
+       );
+
+       # to get something
+       push @EXPORT, qw(
+               &GetBiblio
+               &GetBiblioData
+               &GetBiblioItemData
+               &GetBiblioItemInfosOf
+               &GetBiblioItemByBiblioNumber
+               &GetBiblioFromItemNumber
+
+               &GetMarcNotes
+               &GetMarcSubjects
+               &GetMarcBiblio
+               &GetMarcAuthors
+               &GetMarcSeries
+               GetMarcUrls
+               &GetUsedMarcStructure
+               &GetXmlBiblio
+
+               &GetAuthorisedValueDesc
+               &GetMarcStructure
+               &GetMarcFromKohaField
+               &GetFrameworkCode
+               &GetPublisherNameFromIsbn
+               &TransformKohaToMarc
+       );
+
+       # To modify something
+       push @EXPORT, qw(
+               &ModBiblio
+               &ModBiblioframework
+               &ModZebra
+       );
+       # To delete something
+       push @EXPORT, qw(
+               &DelBiblio
+       );
+
+    # To link headings in a bib record
+    # to authority records.
+    push @EXPORT, qw(
+        &LinkBibHeadingsToAuthorities
+    );
+
+       # Internal functions
+       # those functions are exported but should not be used
+       # they are usefull is few circumstances, so are exported.
+       # but don't use them unless you're a core developer ;-)
+       push @EXPORT, qw(
+               &ModBiblioMarc
+       );
+       # Others functions
+       push @EXPORT, qw(
+               &TransformMarcToKoha
+               &TransformHtmlToMarc2
+               &TransformHtmlToMarc
+               &TransformHtmlToXml
+               &PrepareItemrecordDisplay
+               &GetNoZebraIndexes
+       );
+}
 
-# to add biblios
-push @EXPORT, qw( 
-  &AddBiblio
-);
-
-# to get something
-push @EXPORT, qw(
-  &GetBiblio
-  &GetBiblioData
-  &GetBiblioItemData
-  &GetBiblioItemInfosOf
-  &GetBiblioItemByBiblioNumber
-  &GetBiblioFromItemNumber
-  
-  &GetMarcNotes
-  &GetMarcSubjects
-  &GetMarcBiblio
-  &GetMarcAuthors
-  &GetMarcSeries
-  GetMarcUrls
-  &GetUsedMarcStructure
-
-  &GetXmlBiblio
-
-  &GetAuthorisedValueDesc
-  &GetMarcStructure
-  &GetMarcFromKohaField
-  &GetFrameworkCode
-  &GetPublisherNameFromIsbn
-  &TransformKohaToMarc
-);
-
-# To modify something
-push @EXPORT, qw(
-  &ModBiblio
-  &ModBiblioframework
-  &ModZebra
-);
-
-# To delete something
-push @EXPORT, qw(
-  &DelBiblio
-);
-
-# Internal functions
-# those functions are exported but should not be used
-# they are usefull is few circumstances, so are exported.
-# but don't use them unless you're a core developer ;-)
-push @EXPORT, qw(
-  &ModBiblioMarc
-);
-
-# Others functions
-push @EXPORT, qw(
-  &TransformMarcToKoha
-  &TransformHtmlToMarc2
-  &TransformHtmlToMarc
-  &TransformHtmlToXml
-  &PrepareItemrecordDisplay
-  &char_decode
-  &GetNoZebraIndexes
-);
+# because of interdependencies between
+# C4::Search, C4::Heading, and C4::Biblio,
+# 'use C4::Heading' must occur after
+# the exports have been defined.
+use C4::Heading;
 
 =head1 NAME
 
@@ -223,11 +233,13 @@ sub AddBiblio {
 
     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 
+    # update MARC subfield that stores biblioitems.cn_sort
+    _koha_marc_update_biblioitem_cn_sort($record, $olddata, $frameworkcode);
+    
     # now add the record
     $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
       
-    &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio") 
-        if C4::Context->preference("CataloguingLog");
+    logaction("CATALOGUING", "ADD", $biblionumber, "biblio") if C4::Context->preference("CataloguingLog");
 
     return ( $biblionumber, $biblioitemnumber );
 }
@@ -243,7 +255,7 @@ sub ModBiblio {
     my ( $record, $biblionumber, $frameworkcode ) = @_;
     if (C4::Context->preference("CataloguingLog")) {
         my $newrecord = GetMarcBiblio($biblionumber);
-        &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$biblionumber,"BEFORE=>".$newrecord->as_formatted);
+        logaction("CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>".$newrecord->as_formatted);
     }
     
     my $dbh = C4::Context->dbh;
@@ -281,12 +293,15 @@ sub ModBiblio {
     $sth->finish();
     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 
-    # update the MARC record (that now contains biblio and items) with the new record data
-    &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
-    
     # load the koha-table data object
     my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 
+    # update MARC subfield that stores biblioitems.cn_sort
+    _koha_marc_update_biblioitem_cn_sort($record, $oldbiblio, $frameworkcode);
+
+    # update the MARC record (that now contains biblio and items) with the new record data
+    &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
+    
     # modify the other koha tables
     _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
     _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
@@ -346,7 +361,13 @@ sub DelBiblio {
     # - we need to read the biblio if NoZebra is set (to remove it from the indexes
     # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
     #   and we would have no way to remove it (except manually in zebra, but I bet it would be very hard to handle the problem)
-    ModZebra($biblionumber, "recordDelete", "biblioserver", undef);
+    my $oldRecord;
+    if (C4::Context->preference("NoZebra")) {
+        # only NoZebra indexing needs to have
+        # the previous version of the record
+        $oldRecord = GetMarcBiblio($biblionumber);
+    }
+    ModZebra($biblionumber, "recordDelete", "biblioserver", $oldRecord, undef);
 
     # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
     $sth =
@@ -366,11 +387,68 @@ sub DelBiblio {
     # from being generated by _koha_delete_biblioitems
     $error = _koha_delete_biblio( $dbh, $biblionumber );
 
-    &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$biblionumber,"") 
-        if C4::Context->preference("CataloguingLog");
+    logaction("CATALOGUING", "DELETE", $biblionumber, "") if C4::Context->preference("CataloguingLog");
+
     return;
 }
 
+=head2 LinkBibHeadingsToAuthorities
+
+=over 4
+
+my $headings_linked = LinkBibHeadingsToAuthorities($marc);
+
+=back
+
+Links bib headings to authority records by checking
+each authority-controlled field in the C<MARC::Record>
+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.
+
+Returns the number of heading links changed in the
+MARC record.
+
+=cut
+
+sub LinkBibHeadingsToAuthorities {
+    my $bib = shift;
+
+    my $num_headings_changed = 0;
+    foreach my $field ($bib->fields()) {
+        my $heading = C4::Heading->new_from_bib_field($field);    
+        next unless defined $heading;
+
+        # check existing $9
+        my $current_link = $field->subfield('9');
+
+        # look for matching authorities
+        my $authorities = $heading->authorities();
+
+        # 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;
+
+            $field->delete_subfield(code => '9') if defined $current_link;
+            $field->add_subfields('9', $authid);
+            $num_headings_changed++;
+        } else {
+            if (defined $current_link) {
+                $field->delete_subfield(code => '9');
+                $num_headings_changed++;
+            }
+        }
+
+    }
+    return $num_headings_changed;
+}
+
 =head2 GetBiblioData
 
 =over 4
@@ -437,12 +515,11 @@ sub GetBiblioItemData {
     my ($biblioitemnumber) = @_;
     my $dbh       = C4::Context->dbh;
     my $query = "SELECT *,biblioitems.notes AS bnotes
-        FROM biblio, biblioitems ";
+        FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblioitemnumber ";
     unless(C4::Context->preference('item-level_itypes')) { 
         $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
     }    
-    $query .= " WHERE biblio.biblionumber = biblioitems.biblionumber 
-        AND biblioitemnumber = ? ";
+    $query .= " WHERE biblioitemnumber = ? ";
     my $sth       =  $dbh->prepare($query);
     my $data;
     $sth->execute($biblioitemnumber);
@@ -581,10 +658,19 @@ $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};
+    }
+
     my $sth;
     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
 
@@ -610,7 +696,7 @@ sub GetMarcStructure {
     {
         $res->{$tag}->{lib} =
           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
-        $res->{$tab}->{tab}        = "";
+        $res->{$tag}->{tab}        = "";
         $res->{$tag}->{mandatory}  = $mandatory;
         $res->{$tag}->{repeatable} = $repeatable;
     }
@@ -664,6 +750,9 @@ sub GetMarcStructure {
         $res->{$tag}->{$subfield}->{'link'}           = $link;
         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
     }
+
+    $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
+
     return $res;
 }
 
@@ -725,11 +814,14 @@ sub GetMarcFromKohaField {
 
 =over 4
 
-Returns MARC::Record of the biblionumber passed in parameter.
-the marc record contains both biblio & item datas
+my $record = GetMarcBiblio($biblionumber);
 
 =back
 
+Returns MARC::Record representing bib identified by
+C<$biblionumber>.  If no bib exists, returns undef.
+The MARC record contains both biblio & item data.
+
 =cut
 
 sub GetMarcBiblio {
@@ -738,18 +830,13 @@ sub GetMarcBiblio {
     my $sth          =
       $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
     $sth->execute($biblionumber);
-     my ($marcxml) = $sth->fetchrow;
+    my $row = $sth->fetchrow_hashref;
+    my $marcxml = StripNonXmlChars($row->{'marcxml'});
      MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
-     $marcxml =~ s/\x1e//g;
-     $marcxml =~ s/\x1f//g;
-     $marcxml =~ s/\x1d//g;
-     $marcxml =~ s/\x0f//g;
-     $marcxml =~ s/\x0c//g;  
-#   warn $marcxml;
     my $record = MARC::Record->new();
     if ($marcxml) {
         $record = eval {MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour'))};
-        if ($@) {warn $@;}
+        if ($@) {warn " problem with :$biblionumber : $@ \n$marcxml";}
 #      $record = MARC::Record::new_from_usmarc( $marc) if $marc;
         return $record;
     } else {
@@ -912,7 +999,7 @@ sub GetMarcSubjects {
         my $subfield9 = $field->subfield('9');
         for my $subject_subfield (@subfields ) {
             # don't load unimarc subfields 3,4,5
-            next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ (3|4|5) ) );
+            next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ /3|4|5/ ) );
             my $code = $subject_subfield->[0];
             my $value = $subject_subfield->[1];
             my $linkvalue = $value;
@@ -926,7 +1013,7 @@ sub GetMarcSubjects {
             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
             # 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] == 9 );
+            push @subfields_loop, {code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($subject_subfield->[0] eq 9 );
             $counter++;
         }
                 
@@ -976,7 +1063,7 @@ sub GetMarcAuthors {
         my $subfield9 = $field->subfield('9');
         for my $authors_subfield (@subfields) {
             # don't load unimarc subfields 3, 5
-            next if ($marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~ (3|5) ) );
+            next if ($marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~ /3|5/ ) );
             my $subfieldcode = $authors_subfield->[0];
             my $value = $authors_subfield->[1];
             my $linkvalue = $value;
@@ -984,15 +1071,16 @@ sub GetMarcAuthors {
             my $operator = " and " unless $count_auth==0;
             # if we have an authority link, use that as the link, otherwise use standard searching
             if ($subfield9) {
-                @link_loop = ({'limit' => 'Koha-Auth-Number' ,link => "$subfield9" });
+                @link_loop = ({'limit' => 'an' ,link => "$subfield9" });
             }
             else {
                 # reset $linkvalue if UNIMARC author responsibility
-                if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] eq '4')) {
+                if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] eq "4")) {
                     $linkvalue = "(".GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ).")";
                 }
                 push @link_loop, {'limit' => 'au', link => $linkvalue, operator => $operator };
             }
+            $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] == 9 );
@@ -1025,17 +1113,31 @@ sub GetMarcUrls {
         for my $note ( $field->subfield('z')) {
             push @notes , {note => $note};
         }        
-        $marcurl = {  MARCURL => $url,
-                      notes => \@notes,
-                    };
         if($marcflavour eq 'MARC21') {
             my $s3 = $field->subfield('3');
             my $link = $field->subfield('y');
-            $marcurl->{'linktext'} = $link || $s3 || $url ;;
+                       warn $url;
+                       unless($url =~ /^\w+:/) {
+                       warn $field->indicator(1);
+                               if($field->indicator(1) eq '7') {
+                                       $url = $field->subfield('2') . "://" . $url;
+                               } elsif ($field->indicator(1) eq '1') {
+                                       $url = 'ftp://' . $url;
+                               } else {  
+                                       #  properly, this should be if ind1=4,
+                                       #  however we will assume http protocol since we're building a link.
+                                       $url = 'http://' . $url;
+                               }
+                       }
+                       # TODO handle ind 2 (relationship)
+               $marcurl = {  MARCURL => $url,
+                      notes => \@notes,
+            };
+            $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url ;;
             $marcurl->{'part'} = $s3 if($link);
             $marcurl->{'toc'} = 1 if($s3 =~ /^[Tt]able/) ;
         } else {
-            $marcurl->{'linktext'} = $url;
+            $marcurl->{'linktext'} = $url || C4::Context->preference('URLLinkText') ;
         }
         push @marcurls, $marcurl;    
     }
@@ -1725,202 +1827,6 @@ sub TransformMarcToKohaOneField {
 
 =head1  OTHER FUNCTIONS
 
-=head2 char_decode
-
-=over 4
-
-my $string = char_decode( $string, $encoding );
-
-converts ISO 5426 coded string to UTF-8
-sloppy code : should be improved in next issue
-
-=back
-
-=cut
-
-sub char_decode {
-    my ( $string, $encoding ) = @_;
-    $_ = $string;
-
-    $encoding = C4::Context->preference("marcflavour") unless $encoding;
-    if ( $encoding eq "UNIMARC" ) {
-
-        #         s/\xe1/Æ/gm;
-        s/\xe2/Ğ/gm;
-        s/\xe9/Ø/gm;
-        s/\xec/ş/gm;
-        s/\xf1/æ/gm;
-        s/\xf3/ğ/gm;
-        s/\xf9/ø/gm;
-        s/\xfb/ß/gm;
-        s/\xc1\x61/à/gm;
-        s/\xc1\x65/è/gm;
-        s/\xc1\x69/ì/gm;
-        s/\xc1\x6f/ò/gm;
-        s/\xc1\x75/ù/gm;
-        s/\xc1\x41/À/gm;
-        s/\xc1\x45/È/gm;
-        s/\xc1\x49/Ì/gm;
-        s/\xc1\x4f/Ò/gm;
-        s/\xc1\x55/Ù/gm;
-        s/\xc2\x41/Á/gm;
-        s/\xc2\x45/É/gm;
-        s/\xc2\x49/Í/gm;
-        s/\xc2\x4f/Ó/gm;
-        s/\xc2\x55/Ú/gm;
-        s/\xc2\x59/İ/gm;
-        s/\xc2\x61/á/gm;
-        s/\xc2\x65/é/gm;
-        s/\xc2\x69/í/gm;
-        s/\xc2\x6f/ó/gm;
-        s/\xc2\x75/ú/gm;
-        s/\xc2\x79/ı/gm;
-        s/\xc3\x41/Â/gm;
-        s/\xc3\x45/Ê/gm;
-        s/\xc3\x49/Î/gm;
-        s/\xc3\x4f/Ô/gm;
-        s/\xc3\x55/Û/gm;
-        s/\xc3\x61/â/gm;
-        s/\xc3\x65/ê/gm;
-        s/\xc3\x69/î/gm;
-        s/\xc3\x6f/ô/gm;
-        s/\xc3\x75/û/gm;
-        s/\xc4\x41/Ã/gm;
-        s/\xc4\x4e/Ñ/gm;
-        s/\xc4\x4f/Õ/gm;
-        s/\xc4\x61/ã/gm;
-        s/\xc4\x6e/ñ/gm;
-        s/\xc4\x6f/õ/gm;
-        s/\xc8\x41/Ä/gm;
-        s/\xc8\x45/Ë/gm;
-        s/\xc8\x49/Ï/gm;
-        s/\xc8\x61/ä/gm;
-        s/\xc8\x65/ë/gm;
-        s/\xc8\x69/ï/gm;
-        s/\xc8\x6F/ö/gm;
-        s/\xc8\x75/ü/gm;
-        s/\xc8\x76/ÿ/gm;
-        s/\xc9\x41/Ä/gm;
-        s/\xc9\x45/Ë/gm;
-        s/\xc9\x49/Ï/gm;
-        s/\xc9\x4f/Ö/gm;
-        s/\xc9\x55/Ü/gm;
-        s/\xc9\x61/ä/gm;
-        s/\xc9\x6f/ö/gm;
-        s/\xc9\x75/ü/gm;
-        s/\xca\x41/Å/gm;
-        s/\xca\x61/å/gm;
-        s/\xd0\x43/Ç/gm;
-        s/\xd0\x63/ç/gm;
-
-        # this handles non-sorting blocks (if implementation requires this)
-        $string = nsb_clean($_);
-    }
-    elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
-        ##MARC-8 to UTF-8
-
-        s/\xe1\x61/à/gm;
-        s/\xe1\x65/è/gm;
-        s/\xe1\x69/ì/gm;
-        s/\xe1\x6f/ò/gm;
-        s/\xe1\x75/ù/gm;
-        s/\xe1\x41/À/gm;
-        s/\xe1\x45/È/gm;
-        s/\xe1\x49/Ì/gm;
-        s/\xe1\x4f/Ò/gm;
-        s/\xe1\x55/Ù/gm;
-        s/\xe2\x41/Á/gm;
-        s/\xe2\x45/É/gm;
-        s/\xe2\x49/Í/gm;
-        s/\xe2\x4f/Ó/gm;
-        s/\xe2\x55/Ú/gm;
-        s/\xe2\x59/İ/gm;
-        s/\xe2\x61/á/gm;
-        s/\xe2\x65/é/gm;
-        s/\xe2\x69/í/gm;
-        s/\xe2\x6f/ó/gm;
-        s/\xe2\x75/ú/gm;
-        s/\xe2\x79/ı/gm;
-        s/\xe3\x41/Â/gm;
-        s/\xe3\x45/Ê/gm;
-        s/\xe3\x49/Î/gm;
-        s/\xe3\x4f/Ô/gm;
-        s/\xe3\x55/Û/gm;
-        s/\xe3\x61/â/gm;
-        s/\xe3\x65/ê/gm;
-        s/\xe3\x69/î/gm;
-        s/\xe3\x6f/ô/gm;
-        s/\xe3\x75/û/gm;
-        s/\xe4\x41/Ã/gm;
-        s/\xe4\x4e/Ñ/gm;
-        s/\xe4\x4f/Õ/gm;
-        s/\xe4\x61/ã/gm;
-        s/\xe4\x6e/ñ/gm;
-        s/\xe4\x6f/õ/gm;
-        s/\xe6\x41/Ă/gm;
-        s/\xe6\x45/Ĕ/gm;
-        s/\xe6\x65/ĕ/gm;
-        s/\xe6\x61/ă/gm;
-        s/\xe8\x45/Ë/gm;
-        s/\xe8\x49/Ï/gm;
-        s/\xe8\x65/ë/gm;
-        s/\xe8\x69/ï/gm;
-        s/\xe8\x76/ÿ/gm;
-        s/\xe9\x41/A/gm;
-        s/\xe9\x4f/O/gm;
-        s/\xe9\x55/U/gm;
-        s/\xe9\x61/a/gm;
-        s/\xe9\x6f/o/gm;
-        s/\xe9\x75/u/gm;
-        s/\xea\x41/A/gm;
-        s/\xea\x61/a/gm;
-
-        #Additional Turkish characters
-        s/\x1b//gm;
-        s/\x1e//gm;
-        s/(\xf0)s/\xc5\x9f/gm;
-        s/(\xf0)S/\xc5\x9e/gm;
-        s/(\xf0)c/ç/gm;
-        s/(\xf0)C/Ç/gm;
-        s/\xe7\x49/\\xc4\xb0/gm;
-        s/(\xe6)G/\xc4\x9e/gm;
-        s/(\xe6)g/ğ\xc4\x9f/gm;
-        s/\xB8/ı/gm;
-        s/\xB9/£/gm;
-        s/(\xe8|\xc8)o/ö/gm;
-        s/(\xe8|\xc8)O/Ö/gm;
-        s/(\xe8|\xc8)u/ü/gm;
-        s/(\xe8|\xc8)U/Ü/gm;
-        s/\xc2\xb8/\xc4\xb1/gm;
-        s/¸/\xc4\xb1/gm;
-
-        # this handles non-sorting blocks (if implementation requires this)
-        $string = nsb_clean($_);
-    }
-    return ($string);
-}
-
-=head2 nsb_clean
-
-=over 4
-
-my $string = nsb_clean( $string, $encoding );
-
-=back
-
-=cut
-
-sub nsb_clean {
-    my $NSB      = '\x88';    # NSB : begin Non Sorting Block
-    my $NSE      = '\x89';    # NSE : Non Sorting Block end
-                              # handles non sorting blocks
-    my ($string) = @_;
-    $_ = $string;
-    s/$NSB/(/gm;
-    s/[ ]{0,1}$NSE/) /gm;
-    $string = $_;
-    return ($string);
-}
 
 =head2 PrepareItemrecordDisplay
 
@@ -1943,7 +1849,7 @@ sub PrepareItemrecordDisplay {
     my ( $itemtagfield, $itemtagsubfield ) =
       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
-    my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
+    my $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum) if ($itemnum);
     my @loop_data;
     my $authorised_values_sth =
       $dbh->prepare(
@@ -2152,11 +2058,14 @@ sub PrepareItemrecordDisplay {
 
 =over 4
 
-ModZebra( $biblionumber, $op, $server, $newRecord );
+ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
 
     $biblionumber is the biblionumber we want to index
     $op is specialUpdate or delete, and is used to know what we want to do
     $server is the server that we want to update
+    $oldRecord is the MARC::Record containing the previous version of the record.  This is used only when 
+      NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
+      do an update.
     $newRecord is the MARC::Record containing the new record. It is usefull only when NoZebra=1, and is used to know what to add to the nozebra database. (the record in mySQL being, if it exist, the previous record, the one just before the modif. We need both : the previous and the new one.
     
 =back
@@ -2165,7 +2074,7 @@ ModZebra( $biblionumber, $op, $server, $newRecord );
 
 sub ModZebra {
 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
-    my ( $biblionumber, $op, $server, $newRecord ) = @_;
+    my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
     my $dbh=C4::Context->dbh;
 
     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
@@ -2179,24 +2088,18 @@ sub ModZebra {
         # lock the table to avoid someone else overwriting what we are doing
         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
         my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
-        my $record;
-        if ($server eq 'biblioserver') {
-            $record= GetMarcBiblio($biblionumber);
-        } else {
-            $record= C4::AuthoritiesMarc::GetAuthority($biblionumber);
-        }
         if ($op eq 'specialUpdate') {
             # OK, we have to add or update the record
             # 1st delete (virtually, in indexes), if record actually exists
-            if ($record) { 
-                %result = _DelBiblioNoZebra($biblionumber,$record,$server);
+            if ($oldRecord) { 
+                %result = _DelBiblioNoZebra($biblionumber,$oldRecord,$server);
             }
             # ... add the record
             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
         } else {
             # it's a deletion, delete the record...
             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
-            %result=_DelBiblioNoZebra($biblionumber,$record,$server);
+            %result=_DelBiblioNoZebra($biblionumber,$oldRecord,$server);
         }
         # ok, now update the database...
         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
@@ -2211,9 +2114,20 @@ sub ModZebra {
         #
         # we use zebra, just fill zebraqueue table
         #
-        my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
-        $sth->execute($biblionumber,$server,$op);
-        $sth->finish;
+        my $check_sql = "SELECT COUNT(*) FROM zebraqueue 
+                         WHERE server = ?
+                         AND   biblio_auth_number = ?
+                         AND   operation = ?
+                         AND   done = 0";
+        my $check_sth = $dbh->prepare_cached($check_sql);
+        $check_sth->execute($server, $biblionumber, $op);
+        my ($count) = $check_sth->fetchrow_array;
+        $check_sth->finish();
+        if ($count == 0) {
+            my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
+            $sth->execute($biblionumber,$server,$op);
+            $sth->finish;
+        }
     }
 }
 
@@ -2271,12 +2185,13 @@ sub _DelBiblioNoZebra {
         $title = lc($record->subfield($titletag,$titlesubfield));
     } else {
         # for authorities, the "title" is the $a mainentry
-        my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
+        my ($auth_type_tag, $auth_type_sf) = C4::AuthoritiesMarc::get_auth_type_location();
+        my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield($auth_type_tag, $auth_type_sf));
         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
         $title = $record->subfield($authref->{auth_tag_to_report},'a');
         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
-        $index{'auth_type'}    = '152b';
+        $index{'auth_type'}    = "${auth_type_tag}${auth_type_sf}";
     }
     
     my %result;
@@ -2365,16 +2280,17 @@ sub _AddBiblioNoZebra {
     } else {
         # warn "server : $server";
         # for authorities, the "title" is the $a mainentry
-        my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
+        my ($auth_type_tag, $auth_type_sf) = C4::AuthoritiesMarc::get_auth_type_location();
+        my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield($auth_type_tag, $auth_type_sf));
         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
         $title = $record->subfield($authref->{auth_tag_to_report},'a');
         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
-        $index{'auth_type'}     = '152b';
+        $index{'auth_type'}    = "${auth_type_tag}${auth_type_sf}";
     }
 
     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
-    $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
+    $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
     # limit to 10 char, should be enough, and limit the DB size
     $title = substr($title,0,10);
     #parse each field
@@ -2386,6 +2302,7 @@ sub _AddBiblioNoZebra {
             my $tag = $field->tag();
             my $subfieldcode = $subfield->[0];
             my $indexed=0;
+            warn "INDEXING :".$subfield->[1];
             # check each index to see if the subfield is stored somewhere
             # otherwise, store it in __RAW__ index
             foreach my $key (keys %index) {
@@ -2394,15 +2311,15 @@ sub _AddBiblioNoZebra {
                     $indexed=1;
                     my $line= lc $subfield->[1];
                     # remove meaningless value in the field...
-                    $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
+                    $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
                     # ... and split in words
                     foreach (split / /,$line) {
                         next unless $_; # skip  empty values (multiple spaces)
                         # if the entry is already here, improve weight
 #                         warn "managing $_";
-                        if ($result{$key}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
+                        if ($result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) { 
                             my $weight=$1+1;
-                            $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
+                            $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
                         } else {
                             # get the value if it exist in the nozebra table, otherwise, create it
@@ -2412,7 +2329,7 @@ sub _AddBiblioNoZebra {
                             if ($existing_biblionumbers) {
                                 $result{$key}->{"$_"} =$existing_biblionumbers;
                                 my $weight=$1+1;
-                                $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
+                                $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
                             # create a new ligne for this entry
                             } else {
@@ -2427,14 +2344,14 @@ sub _AddBiblioNoZebra {
             # the subfield is not indexed, store it in __RAW__ index anyway
             unless ($indexed) {
                 my $line= lc $subfield->[1];
-                $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
+                $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
                 # ... and split in words
                 foreach (split / /,$line) {
                     next unless $_; # skip  empty values (multiple spaces)
                     # if the entry is already here, improve weight
-                    if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
+                    if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) { 
                         my $weight=$1+1;
-                        $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
+                        $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
                     } else {
                         # get the value if it exist in the nozebra table, otherwise, create it
@@ -2444,7 +2361,7 @@ sub _AddBiblioNoZebra {
                         if ($existing_biblionumbers) {
                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
                             my $weight=$1+1;
-                            $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
+                            $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
                         # create a new ligne for this entry
                         } else {
@@ -2543,7 +2460,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);
+        $record->delete_field($old_field) if $old_field;
         $record->append_fields($new_field);
 
         # deal with biblioitemnumber
@@ -2556,7 +2473,7 @@ sub _koha_marc_update_bib_ids {
         }
         # drop old field and create new one...
         $old_field = $record->field($biblioitem_tag);
-        $record->delete_field($old_field);
+        $record->delete_field($old_field) if $old_field;
         $record->insert_fields_ordered($new_field);
 
     } else {
@@ -2569,11 +2486,49 @@ sub _koha_marc_update_bib_ids {
 
         # drop old field and create new one...
         my $old_field = $record->field($biblio_tag);
-        $record->delete_field($old_field);
+        $record->delete_field($old_field) if $old_field;
         $record->insert_fields_ordered($new_field);
     }
 }
 
+=head2 _koha_marc_update_biblioitem_cn_sort
+
+=over 4
+
+_koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
+
+=back
+
+Given a MARC bib record and the biblioitem hash, update the
+subfield that contains a copy of the value of biblioitems.cn_sort.
+
+=cut
+
+sub _koha_marc_update_biblioitem_cn_sort {
+    my $marc = shift;
+    my $biblioitem = shift;
+    my $frameworkcode= shift;
+
+    my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.cn_sort",$frameworkcode);
+    return unless $biblioitem_tag;
+
+    my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
+
+    if (my $field = $marc->field($biblioitem_tag)) {
+        $field->delete_subfield(code => $biblioitem_subfield);
+        if ($cn_sort ne '') {
+            $field->add_subfields($biblioitem_subfield => $cn_sort);
+        }
+    } else {
+        # if we get here, no biblioitem tag is present in the MARC record, so
+        # we'll create it if $cn_sort is not empty -- this would be
+        # an odd combination of events, however
+        if ($cn_sort) {
+            $marc->insert_grouped_field(MARC::Field->new($biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort));
+        }
+    }
+}
+
 =head2 _koha_add_biblio
 
 =over 4
@@ -3013,13 +2968,19 @@ sub ModBiblioMarc {
                 MARC::Field->new( 100, "", "", "a" => $string ) );
         }
     }
-    ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
+    my $oldRecord;
+    if (C4::Context->preference("NoZebra")) {
+        # only NoZebra indexing needs to have
+        # the previous version of the record
+        $oldRecord = GetMarcBiblio($biblionumber);
+    }
     $sth =
       $dbh->prepare(
         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
         $biblionumber );
     $sth->finish;
+    ModZebra($biblionumber,"specialUpdate","biblioserver",$oldRecord,$record);
     return $biblionumber;
 }
 
@@ -3131,7 +3092,67 @@ sub set_service_options {
     return $serviceOptions;
 }
 
-END { }    # module clean-up code here (global destructor)
+=head3 get_biblio_authorised_values
+
+  find the types and values for all authorised values assigned to this biblio.
+
+  parameters:
+    biblionumber
+
+  returns: a hashref malling the authorised value to the value set for this biblionumber
+
+      $authorised_values = {
+                             'Scent'     => 'flowery',
+                             'Audience'  => 'Young Adult',
+                             'itemtypes' => 'SER',
+                           };
+
+  Notes: forlibrarian should probably be passed in, and called something different.
+
+
+=cut
+
+sub get_biblio_authorised_values {
+    my $biblionumber = shift;
+    
+    my $forlibrarian = 1; # are we in staff or opac?
+    my $frameworkcode = GetFrameworkCode( $biblionumber );
+
+    my $authorised_values;
+
+    my $record  = GetMarcBiblio( $biblionumber )
+      or return $authorised_values;
+    my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
+      or return $authorised_values;
+
+    # assume that these entries in the authorised_value table are bibliolevel.
+    # ones that start with 'item%' are item level.
+    my $query = q(SELECT distinct authorised_value, kohafield
+                    FROM marc_subfield_structure
+                    WHERE authorised_value !=''
+                      AND (kohafield like 'biblio%'
+                       OR  kohafield like '') );
+    my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
+    
+    foreach my $tag ( keys( %$tagslib ) ) {
+        foreach my $subfield ( keys( %{$tagslib->{ $tag }} ) ) {
+            # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
+            if ( 'HASH' eq ref $tagslib->{ $tag }{ $subfield } ) {
+                if ( exists $tagslib->{ $tag }{ $subfield }{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } ) {
+                    if ( defined $record->field( $tag ) ) {
+                        my $this_subfield_value = $record->field( $tag )->subfield( $subfield );
+                        if ( defined $this_subfield_value ) {
+                            $authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } = $this_subfield_value;
+                        }
+                    }
+                }
+            }
+        }
+    }
+    # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
+    return $authorised_values;
+}
+
 
 1;