telling the user what stopwords have been removed from the
[koha_fer] / C4 / AuthoritiesMarc.pm
index bbde916..d0af4e6 100644 (file)
@@ -27,7 +27,7 @@ use C4::Search;
 use vars qw($VERSION @ISA @EXPORT);
 
 # set the version for version checking
-$VERSION = 0.01;
+$VERSION = 3.00;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(
@@ -203,7 +203,7 @@ sub SearchAuthorities {
             $n++;
         }
         if ($n>1){
-            $query= "\@or ".$query;
+            while ($n>1){$query= "\@or ".$query;$n--;}
         }
         
         my $dosearch;
@@ -227,7 +227,7 @@ sub SearchAuthorities {
                 }elsif (@$operator[$i] eq "start"){
                     $attr.=" \@attr 4=1 \@attr 5=1 ";#Phrase, Right truncated
                 } else {
-                    $attr .=" \@attr 5=1  ";## Word list, right truncated, anywhere
+                    $attr .=" \@attr 5=1 \@attr 4=6 ";## Word list, right truncated, anywhere
                 }
                 $and .=" \@and " ;
                 $attr =$attr."\"".@$value[$i]."\"";
@@ -236,7 +236,11 @@ sub SearchAuthorities {
             }#if value
         }
         ##Add how many queries generated
-        $query= $and.$query.$q2;
+        if ($query=~/\S+/){    
+          $query= $and.$query.$q2 
+        } else {
+          $query=$q2;    
+        }         
         ## Adding order
         $query=' @or  @attr 7=1 @attr 1=Heading 0 @or  @attr 7=1 @attr 1=Heading-Entity 1'.$query if ($sortby eq "HeadingAsc");
         $query=' @or  @attr 7=2 @attr 1=Heading 0 @or  @attr 7=1 @attr 1=Heading-Entity 1'.$query if ($sortby eq "HeadingDsc");
@@ -319,12 +323,14 @@ counts Usage of Authid in bibliorecords.
 =back
 
 =cut
+
 sub CountUsage {
     my ($authid) = @_;
     if (C4::Context->preference('NoZebra')) {
         # Read the index Koha-Auth-Number for this authid and count the lines
         my $result = C4::Search::NZanalyse("an=$authid");
-        return scalar split /;/,$result;
+        my @tab = split /;/,$result;
+        return scalar @tab;
     } else {
         ### ZOOM search here
         my $oConnection=C4::Context->Zconn("biblioserver",1);
@@ -411,12 +417,12 @@ sub GetTagsLabels {
 
 
   # check that authority exists
-  $sth=$dbh->prepare("select count(*) from auth_tag_structure where authtypecode=?");
+  $sth=$dbh->prepare("SELECT count(*) FROM auth_tag_structure WHERE authtypecode=?");
   $sth->execute($authtypecode);
   my ($total) = $sth->fetchrow;
   $authtypecode="" unless ($total >0);
   $sth= $dbh->prepare(
-"SELECT tagfield,liblibrarian,libopac,mandatory,repeatable 
+"SELECT auth_tag_structure.tagfield,auth_tag_structure.liblibrarian,auth_tag_structure.libopac,auth_tag_structure.mandatory,auth_tag_structure.repeatable 
  FROM auth_tag_structure 
  WHERE authtypecode=? 
  ORDER BY tagfield"
@@ -432,7 +438,7 @@ sub GetTagsLabels {
         $res->{$tag}->{repeatable} = $repeatable;
   }
   $sth=      $dbh->prepare(
-"SELECT tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl 
+"SELECT tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,frameworkcode as authtypecode,value_builder,kohafield,seealso,hidden,isurl 
 FROM auth_subfield_structure 
 WHERE authtypecode=? 
 ORDER BY tagfield,tagsubfield"
@@ -491,27 +497,42 @@ sub AddAuthority {
   my $leader='         a              ';##Fixme correct leader as this one just adds utf8 to MARC21
 
 # if authid empty => true add, find a new authid number
+  my $format= 'UNIMARCAUTH' if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC');
+  $format= 'MARC21' if (uc(C4::Context->preference('marcflavour')) ne 'UNIMARC');
   if (!$authid) {
     my $sth=$dbh->prepare("select max(authid) from auth_header");
     $sth->execute;
     ($authid)=$sth->fetchrow;
     $authid=$authid+1;
   ##Insert the recordID in MARC record 
-  ##Both authid and authtypecode is expected to be in the same field. Modify if other requirements arise
-    $record->add_fields('001',$authid) unless $record->field('001');
+    unless ($record->field('001') && $record->field('001')->data() eq $authid){
+        $record->delete_field($record->field('001'));
+        $record->insert_fields_ordered(MARC::Field->new('001',$authid));
+    }
     $record->add_fields('152','','','b'=>$authtypecode) unless $record->field('152');
 #     warn $record->as_formatted;
     $dbh->do("lock tables auth_header WRITE");
-    $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc) values (?,now(),?,?)");
-    $sth->execute($authid,$authtypecode,$record->as_usmarc);    
+    $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)");
+    $sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record($format));
     $sth->finish;
   }else{
       $record->add_fields('001',$authid) unless ($record->field('001'));
-      $record->add_fields('100',$authid) unless ($record->field('100'));
+      if (($format eq "UNIMARCAUTH") && (!$record->subfield('100','a'))){
+            $record->leader("     nx  j22             ");
+            my $date=POSIX::strftime("%Y%m%d",localtime);    
+            if ($record->field('100')){
+              $record->field('100')->update('a'=>$date."afrey50      ba0");
+            } else {      
+              $record->append_fields(
+                MARC::Field->new('100',' ',' '
+                  ,'a'=>$date."afrey50      ba0")
+              );
+            }      
+      }    
       $record->add_fields('152','','','b'=>$authtypecode) unless ($record->field('152'));
       $dbh->do("lock tables auth_header WRITE");
-      my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
-      $sth->execute($record->as_usmarc,$authid);
+      my $sth=$dbh->prepare("update auth_header set marc=?,marcxml=? where authid=?");
+      $sth->execute($record->as_usmarc,$record->as_xml_record($format),$authid);
       $sth->finish;
   }
   $dbh->do("unlock tables");
@@ -544,31 +565,30 @@ sub DelAuthority {
 sub ModAuthority {
   my ($authid,$record,$authtypecode,$merge)=@_;
   my $dbh=C4::Context->dbh;
-  my ($oldrecord)=&GetAuthority($authid);
-  if ($oldrecord eq $record) {
-      return;
-  }
-  my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
+  my ($oldrecord)=&GetAuthority($authid);
+  if ($oldrecord eq $record) {
+      return;
+  }
+#   my $sth=$dbh->prepare("update auth_header set marc=?,marcxml=? where authid=?");
   #Now rewrite the $record to table with an add
   $authid=AddAuthority($record,$authid,$authtypecode);
 
-
 ### If a library thinks that updating all biblios is a long process and wishes to leave that to a cron job to use merge_authotities.p
 ### they should have a system preference "dontmerge=1" otherwise by default biblios will be updated
 ### the $merge flag is now depreceated and will be removed at code cleaning
   if (C4::Context->preference('dontmerge') ){
-  # save the file in localfile/modified_authorities
+  # save the file in tmp/modified_authorities
       my $cgidir = C4::Context->intranetdir ."/cgi-bin";
       unless (opendir(DIR,"$cgidir")) {
               $cgidir = C4::Context->intranetdir."/";
       }
   
-      my $filename = $cgidir."/localfile/modified_authorities/$authid.authid";
+      my $filename = $cgidir."/tmp/modified_authorities/$authid.authid";
       open AUTH, "> $filename";
       print AUTH $authid;
       close AUTH;
   } else {
-      &merge($authid,$record,$authid,$record);
+#        &merge($authid,$record,$authid,$record);
   }
   return $authid;
 }
@@ -588,11 +608,9 @@ sub GetAuthorityXML {
   my ( $authid ) = @_;
   my $dbh=C4::Context->dbh;
   my $sth =
-      $dbh->prepare("select marc from auth_header where authid=? "  );
+      $dbh->prepare("select marcxml from auth_header where authid=? "  );
   $sth->execute($authid);
-  my ($marc)=$sth->fetchrow;
-  $marc=MARC::File::USMARC::decode($marc);
-  my $marcxml=$marc->as_xml_record();
+  my ($marcxml)=$sth->fetchrow;
   return $marcxml;
 
 }
@@ -608,13 +626,14 @@ Returns MARC::Record of the authority passed in parameter.
 
 =cut
 sub GetAuthority {
-  my ($authid)=@_;
-  my $dbh=C4::Context->dbh;
-  my $sth=$dbh->prepare("select marc from auth_header where authid=?");
-  $sth->execute($authid);
-  my ($marc) = $sth->fetchrow;
-  my $record=MARC::File::USMARC::decode($marc);
-  return ($record);
+    my ($authid)=@_;
+    my $dbh=C4::Context->dbh;
+    my $sth=$dbh->prepare("select marcxml from auth_header where authid=?");
+    $sth->execute($authid);
+    my ($marcxml) = $sth->fetchrow;
+    my $record=MARC::Record->new_from_xml($marcxml,'UTF-8',(C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")));
+    $record->encoding('UTF-8');
+    return ($record);
 }
 
 =head2 GetAuthType 
@@ -634,7 +653,8 @@ sub GetAuthType {
     my ($authtypecode) = @_;
     my $dbh=C4::Context->dbh;
     my $sth;
-    if ($authtypecode){
+    if (defined $authtypecode){ # NOTE - in MARC21 framework, '' is a valid authority 
+                                # type
       $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
       $sth->execute($authtypecode);
     } else {
@@ -755,10 +775,29 @@ sub BuildSummary{
   my $dbh=C4::Context->dbh;
   my $authref = GetAuthType($authtypecode);
   my $summary = $authref->{summary};
+  my %language;
+  $language{'fre'}="Français";
+  $language{'eng'}="Anglais";
+  $language{'ger'}="Allemand";
+  $language{'ita'}="Italien";
+  $language{'spa'}="Espagnol";
+  my %thesaurus;
+  $thesaurus{'1'}="Peuples";
+  $thesaurus{'2'}="Anthroponymes";
+  $thesaurus{'3'}="Oeuvres";
+  $thesaurus{'4'}="Chronologie";
+  $thesaurus{'5'}="Lieux";
+  $thesaurus{'6'}="Sujets";
+  #thesaurus a remplir
   my @fields = $record->fields();
   my $reported_tag;
   # if the library has a summary defined, use it. Otherwise, build a standard one
-  if ($summary) {
+  # FIXME - it appears that the summary field in the authority frameworks
+  #         can work as a display template.  However, this doesn't
+  #         suit the MARC21 version, so for now the "templating"
+  #         feature will be enabled only for UNIMARC for backwards
+  #         compatibility.
+  if ($summary and C4::Context->preference('marcflavour') eq 'UNIMARC') {
     my @fields = $record->fields();
     #             $reported_tag = '$9'.$result[$counter];
     foreach my $field (@fields) {
@@ -781,38 +820,66 @@ sub BuildSummary{
     }
     $summary =~ s/\[(.*?)]//g;
     $summary =~ s/\n/<br>/g;
-    } else {
-      my $heading; # = $authref->{summary};
-      my $altheading;
-      my $seeheading;
-      my $see;
-      my @fields = $record->fields();
-      if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
-      # construct UNIMARC summary, that is quite different from MARC21 one
-          # accepted form
-          foreach my $field ($record->field('2..')) {
-              $heading.= $field->as_string();
-          }
-          # rejected form(s)
-          foreach my $field ($record->field('4..')) {
-              $summary.= "&nbsp;&nbsp;&nbsp;<i>".$field->as_string()."</i><br/>";
-              $summary.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see:</i> ".$heading."<br/>";
-          }
-          # see :
-          foreach my $field ($record->field('5..')) {
-              $summary.= "&nbsp;&nbsp;&nbsp;<i>".$field->as_string()."</i><br/>";
-              $summary.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see:</i> ".$heading."<br/>";
-          }
-          # // form
-          foreach my $field ($record->field('7..')) {
-              $seeheading.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see also:</i> ".$field->as_string()."<br />";
-              $altheading.= "&nbsp;&nbsp;&nbsp;".$field->as_string()."<br />";
-              $altheading.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see also:</i> ".$heading."<br />";
-          }
-          $summary = "<b>".$heading."</b><br />".$seeheading.$altheading.$summary;
+  } else {
+    my $heading; 
+    my $authid; 
+    my $altheading;
+    my $seealso;
+    my $broaderterms;
+    my $narrowerterms;
+    my $see;
+    my $seeheading;
+        my $notes;
+    my @fields = $record->fields();
+    if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
+    # construct UNIMARC summary, that is quite different from MARC21 one
+      # accepted form
+      foreach my $field ($record->field('2..')) {
+        $heading.= $field->subfield('a');
+                $authid=$field->subfield('3');
+      }
+      # rejected form(s)
+      foreach my $field ($record->field('3..')) {
+        $notes.= '<span class="note">'.$field->subfield('a')."</span>\n";
+      }
+      foreach my $field ($record->field('4..')) {
+        my $thesaurus = "thes. : ".$thesaurus{"$field->subfield('2')"}." : " if ($field->subfield('2'));
+        $see.= '<span class="UF">'.$thesaurus.$field->subfield('a')."</span> -- \n";
+      }
+      # see :
+      foreach my $field ($record->field('5..')) {
+            
+        if (($field->subfield('5')) && ($field->subfield('a')) && ($field->subfield('5') eq 'g')) {
+          $broaderterms.= '<span class="BT"> <a href="detail.pl?authid='.$field->subfield('3').'">'.$field->subfield('a')."</a></span> -- \n";
+        } elsif (($field->subfield('5')) && ($field->subfield('a')) && ($field->subfield('5') eq 'h')){
+          $narrowerterms.= '<span class="NT"><a href="detail.pl?authid='.$field->subfield('3').'">'.$field->subfield('a')."</a></span> -- \n";
+        } elsif ($field->subfield('a')) {
+          $seealso.= '<span class="RT"><a href="detail.pl?authid='.$field->subfield('3').'">'.$field->subfield('a')."</a></span> -- \n";
+        }
+      }
+      # // form
+      foreach my $field ($record->field('7..')) {
+        my $lang = substr($field->subfield('8'),3,3);
+        $seeheading.= '<span class="langue"> En '.$language{$lang}.' : </span><span class="OT"> '.$field->subfield('a')."</span><br />\n";  
+      }
+            $broaderterms =~s/-- \n$//;
+            $narrowerterms =~s/-- \n$//;
+            $seealso =~s/-- \n$//;
+            $see =~s/-- \n$//;
+      $summary = "<b><a href=\"detail.pl?authid=$authid\">".$heading."</a></b><br />".($notes?"$notes <br />":"");
+      $summary.= '<p><div class="label">TG : '.$broaderterms.'</div></p>' if ($broaderterms);
+      $summary.= '<p><div class="label">TS : '.$narrowerterms.'</div></p>' if ($narrowerterms);
+      $summary.= '<p><div class="label">TA : '.$seealso.'</div></p>' if ($seealso);
+      $summary.= '<p><div class="label">EP : '.$see.'</div></p>' if ($see);
+      $summary.= '<p><div class="label">'.$seeheading.'</div></p>' if ($seeheading);
       } else {
       # construct MARC21 summary
+          # FIXME - looping over 1XX is questionable
+          # since MARC21 authority should have only one 1XX
           foreach my $field ($record->field('1..')) {
+              next if "152" eq $field->tag(); # FIXME - 152 is not a good tag to use
+                                              # in MARC21 -- purely local tags really ought to be
+                                              # 9XX
               if ($record->field('100')) {
                   $heading.= $field->as_string('abcdefghjklmnopqrstvxyz68');
               } elsif ($record->field('110')) {
@@ -846,18 +913,16 @@ sub BuildSummary{
               }
           } #See From
           foreach my $field ($record->field('4..')) {
-              $seeheading.= "&nbsp;&nbsp;&nbsp;".$field->as_string()."<br />";
-              $seeheading.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see:</i> ".$seeheading."<br />";
+              $seeheading.= "<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>used for/see from:</i> ".$field->as_string();
           } #See Also
           foreach my $field ($record->field('5..')) {
-              $altheading.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see also:</i> ".$field->as_string()."<br />";
-              $altheading.= "&nbsp;&nbsp;&nbsp;".$field->as_string()."<br />";
-              $altheading.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see also:</i> ".$altheading."<br />";
+              $altheading.= "<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see also:</i> ".$field->as_string();
           }
+          $summary .= ": " if $summary;
           $summary.=$heading.$seeheading.$altheading;
       }
-    }
-return $summary;
+  }
+  return $summary;
 }
 
 =head2 BuildUnimarcHierarchies
@@ -1155,8 +1220,18 @@ Paul POULAIN paul.poulain@free.fr
 
 =cut
 
-# $Id$
-# $Log$
+# Revision 1.50  2007/07/26 15:14:05  toins
+# removing warn compilation.
+#
+# Revision 1.49  2007/07/16 15:45:28  hdl
+# Adding Summary for UNIMARC authorities
+#
+# Revision 1.48  2007/06/25 15:01:45  tipaul
+# bugfixes on unimarc 100 handling (the field used for encoding)
+#
+# Revision 1.47  2007/06/06 13:08:35  tipaul
+# bugfixes (various), handling utf-8 without guessencoding (as suggested by joshua, fixing some zebra config files -for french but should be interesting for other languages-
+#
 # Revision 1.46  2007/05/10 14:45:15  tipaul
 # Koha NoZebra :
 # - support for authorities