(bug #1578) fix a little error in code
[koha_fer] / C4 / Biblio.pm
old mode 100755 (executable)
new mode 100644 (file)
index 0613e42..684fed5
@@ -24,6 +24,7 @@ use MARC::Record;
 use MARC::File::USMARC;
 use MARC::File::XML;
 use ZOOM;
+use POSIX qw(strftime);
 
 use C4::Koha;
 use C4::Dates qw/format_date/;
@@ -31,6 +32,7 @@ use C4::Log; # logaction
 use C4::ClassSource;
 use C4::Charset;
 require C4::Heading;
+require C4::Serials;
 
 use vars qw($VERSION @ISA @EXPORT);
 
@@ -54,6 +56,8 @@ BEGIN {
                &GetBiblioItemInfosOf
                &GetBiblioItemByBiblioNumber
                &GetBiblioFromItemNumber
+               
+               &GetISBDView
 
                &GetMarcNotes
                &GetMarcSubjects
@@ -63,6 +67,7 @@ BEGIN {
                GetMarcUrls
                &GetUsedMarcStructure
                &GetXmlBiblio
+        &GetCOinSBiblio
 
                &GetAuthorisedValueDesc
                &GetMarcStructure
@@ -374,6 +379,12 @@ sub DelBiblio {
 
     return $error if $error;
 
+    # We delete attached subscriptions
+    my $subscriptions = &C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
+    foreach my $subscription (@$subscriptions){
+        &C4::Serials::DelSubscription($subscription->{subscriptionid});
+    }
+    
     # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
     # for at least 2 reasons :
     # - we need to read the biblio if NoZebra is set (to remove it from the indexes
@@ -612,6 +623,138 @@ sub GetBiblioFromItemNumber {
     return ($data);
 }
 
+=head2 GetISBDView 
+
+=over 4
+
+$isbd = &GetISBDView($biblionumber);
+
+Return the ISBD view which can be included in opac and intranet
+
+=back
+
+=cut
+
+sub GetISBDView {
+    my $biblionumber    = shift;
+    my $record          = GetMarcBiblio($biblionumber);
+    my $itemtype        = &GetFrameworkCode($biblionumber);
+    my ($holdingbrtagf,$holdingbrtagsubf) = &GetMarcFromKohaField("items.holdingbranch",$itemtype);
+    my $tagslib      = &GetMarcStructure( 1, $itemtype );
+    
+    my $ISBD = C4::Context->preference('ISBD');
+    my $bloc = $ISBD;
+    my $res;
+    my $blocres;
+    
+    foreach my $isbdfield ( split (/#/, $bloc) ) {
+
+        #         $isbdfield= /(.?.?.?)/;
+        $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
+        my $fieldvalue    = $1 || 0;
+        my $subfvalue     = $2 || "";
+        my $textbefore    = $3;
+        my $analysestring = $4;
+        my $textafter     = $5;
+    
+        #         warn "==> $1 / $2 / $3 / $4";
+        #         my $fieldvalue=substr($isbdfield,0,3);
+        if ( $fieldvalue > 0 ) {
+            my $hasputtextbefore = 0;
+            my @fieldslist = $record->field($fieldvalue);
+            @fieldslist = sort {$a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf)} @fieldslist if ($fieldvalue eq $holdingbrtagf);
+    
+            #         warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
+            #             warn "FV : $fieldvalue";
+            if ($subfvalue ne ""){
+              foreach my $field ( @fieldslist ) {
+                foreach my $subfield ($field->subfield($subfvalue)){ 
+                  my $calculated = $analysestring;
+                  my $tag        = $field->tag();
+                  if ( $tag < 10 ) {
+                  }
+                  else {
+                    my $subfieldvalue =
+                    GetAuthorisedValueDesc( $tag, $subfvalue,
+                      $subfield, '', $tagslib );
+                    my $tagsubf = $tag . $subfvalue;
+                    $calculated =~
+                          s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
+                    $calculated =~s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g;
+                
+                    # field builded, store the result
+                    if ( $calculated && !$hasputtextbefore )
+                    {    # put textbefore if not done
+                    $blocres .= $textbefore;
+                    $hasputtextbefore = 1;
+                    }
+                
+                    # remove punctuation at start
+                    $calculated =~ s/^( |;|:|\.|-)*//g;
+                    $blocres .= $calculated;
+                                
+                  }
+                }
+              }
+              $blocres .= $textafter if $hasputtextbefore;
+            } else {    
+            foreach my $field ( @fieldslist ) {
+              my $calculated = $analysestring;
+              my $tag        = $field->tag();
+              if ( $tag < 10 ) {
+              }
+              else {
+                my @subf = $field->subfields;
+                for my $i ( 0 .. $#subf ) {
+                my $valuecode   = $subf[$i][1];
+                my $subfieldcode  = $subf[$i][0];
+                my $subfieldvalue =
+                GetAuthorisedValueDesc( $tag, $subf[$i][0],
+                  $subf[$i][1], '', $tagslib );
+                my $tagsubf = $tag . $subfieldcode;
+    
+                $calculated =~ s/                  # replace all {{}} codes by the value code.
+                                  \{\{$tagsubf\}\} # catch the {{actualcode}}
+                                /
+                                  $valuecode     # replace by the value code
+                               /gx;
+    
+                $calculated =~
+            s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
+            $calculated =~s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g;
+                }
+    
+                # field builded, store the result
+                if ( $calculated && !$hasputtextbefore )
+                {    # put textbefore if not done
+                $blocres .= $textbefore;
+                $hasputtextbefore = 1;
+                }
+    
+                # remove punctuation at start
+                $calculated =~ s/^( |;|:|\.|-)*//g;
+                $blocres .= $calculated;
+              }
+            }
+            $blocres .= $textafter if $hasputtextbefore;
+            }       
+        }
+        else {
+            $blocres .= $isbdfield;
+        }
+    }
+    $res .= $blocres;
+    
+    $res =~ s/\{(.*?)\}//g;
+    $res =~ s/\\n/\n/g;
+    $res =~ s/\n/<br\/>/g;
+    
+    # remove empty ()
+    $res =~ s/\(\)//g;
+   
+    return $res;
+}
+
 =head2 GetBiblio
 
 =over 4
@@ -885,6 +1028,123 @@ sub GetXmlBiblio {
     return $marcxml;
 }
 
+=head2 GetCOinSBiblio
+
+=over 4
+
+my $coins = GetCOinSBiblio($biblionumber);
+
+Returns the COinS(a span) which can be included in a biblio record
+
+=back
+
+=cut
+
+sub GetCOinSBiblio {
+    my ( $biblionumber ) = @_;
+    my $record = GetMarcBiblio($biblionumber);
+
+    # get the coin format
+    my $pos7 = substr $record->leader(), 7,1;
+    my $pos6 = substr $record->leader(), 6,1;
+    my $mtx;
+    my $genre;
+    my ($aulast, $aufirst) = ('','');
+    my $oauthors;
+    my $title;
+    my $pubyear;
+    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' ){
+            $genre =  $fmts7->{$pos7} if $fmts7->{$pos7};
+        }
+
+        ##### We must transform mtx to a valable mtx and document type ####
+        if( $genre eq 'book' ){
+            $mtx = 'book';
+        }elsif( $genre eq 'journal' ){
+            $mtx = 'journal';
+        }elsif( $genre eq 'journalArticle' ){
+            $mtx = 'journal';
+            $genre = 'article';
+        }else{
+            $mtx = 'dc';
+        }
+
+        $genre = ($mtx eq 'dc') ? "&amp;rft.type=$genre" : "&amp;rft.genre=$genre";
+
+        # Setting datas
+        $aulast     = $record->subfield('700','a');
+        $aufirst    = $record->subfield('700','b');
+        $oauthors   = "&amp;rft.au=$aufirst $aulast";
+        # others authors
+        if($record->field('200')){
+            for my $au ($record->field('200')->subfield('g')){
+                $oauthors .= "&amp;rft.au=$au";
+            }
+        }
+        $title      = ( $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');
+    }else{
+        # MARC21 need some improve
+        my $fmts;
+        $mtx = 'book';
+        $genre = "&amp;rft.genre=book";
+
+        # Setting datas
+        $oauthors .= "&amp;rft.au=".$record->subfield('100','a');
+        # others authors
+        if($record->field('700')){
+            for my $au ($record->field('700')->subfield('a')){
+                $oauthors .= "&amp;rft.au=$au";
+            }
+        }
+        $title      = "&amp;rft.btitle=".$record->subfield('245','a');
+        $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";
+    $coins_value =~ s/(\ |&[^a])/\+/g;
+    #<!-- TMPL_VAR NAME="ocoins_format" -->&amp;rft.au=<!-- TMPL_VAR NAME="author" -->&amp;rft.btitle=<!-- TMPL_VAR NAME="title" -->&amp;rft.date=<!-- TMPL_VAR NAME="publicationyear" -->&amp;rft.pages=<!-- TMPL_VAR NAME="pages" -->&amp;rft.isbn=<!-- TMPL_VAR NAME=amazonisbn -->&amp;rft.aucorp=&amp;rft.place=<!-- TMPL_VAR NAME="place" -->&amp;rft.pub=<!-- TMPL_VAR NAME="publishercode" -->&amp;rft.edition=<!-- TMPL_VAR NAME="edition" -->&amp;rft.series=<!-- TMPL_VAR NAME="series" -->&amp;rft.genre="
+
+    return $coins_value;
+}
+
 =head2 GetAuthorisedValueDesc
 
 =over 4
@@ -1159,7 +1419,7 @@ sub GetMarcUrls {
                 };
                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
                 $marcurl->{'part'} = $s3 if ($link);
-                $marcurl->{'toc'} = 1 if ( $s3 =~ /^[Tt]able/ );
+                $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
             } else {
                 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
                 $marcurl->{'MARCURL'} = $url;
@@ -1302,18 +1562,15 @@ sub GetPublisherNameFromIsbn($){
 =cut
 
 sub TransformKohaToMarc {
-
     my ( $hash ) = @_;
-    my $dbh = C4::Context->dbh;
-    my $sth =
-    $dbh->prepare(
+    my $sth = C4::Context->dbh->prepare(
         "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
     );
     my $record = MARC::Record->new();
+    SetMarcUnicodeFlag($record, C4::Context->preference("marcflavour"));
     foreach (keys %{$hash}) {
-        &TransformKohaToMarcOneField( $sth, $record, $_,
-            $hash->{$_}, '' );
-        }
+        &TransformKohaToMarcOneField( $sth, $record, $_, $hash->{$_}, '' );
+    }
     return $record;
 }
 
@@ -1475,7 +1732,6 @@ sub TransformHtmlToXml {
     $xml .= "</datafield>\n" if @$tags > 0;
     if (C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist) {
 #     warn "SETTING 100 for $auth_type";
-        use POSIX qw(strftime);
         my $string = strftime( "%Y%m%d", localtime(time) );
         # set 50 to position 26 is biblios, 13 if authorities
         my $pos=26;