removed duplicate call to C4::Context->marcfromkohafield
[koha_gimpoz] / C4 / AuthoritiesMarc.pm
index eb2e604..b353d15 100644 (file)
@@ -27,7 +27,7 @@ use C4::Search;
 use vars qw($VERSION @ISA @EXPORT);
 
 # set the version for version checking
-$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = 3.00;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(
@@ -146,30 +146,31 @@ sub SearchAuthorities {
                 $result{$title.$authid}=$authid;
             }
             # sort the hash and return the same structure as GetRecords (Zebra querying)
-            my @finalresult = ();
+            my @listresult = ();
             my $numbers=0;
             if ($sortby eq 'HeadingDsc') { # sort by mainmainentry desc
                 foreach my $key (sort {$b cmp $a} (keys %result)) {
-                    push @finalresult, $result{$key};
+                    push @listresult, $result{$key};
 #                     warn "push..."$#finalresult;
                     $numbers++;
                 }
             } else { # sort by mainmainentry ASC
                 foreach my $key (sort (keys %result)) {
-                    push @finalresult, $result{$key};
+                    push @listresult, $result{$key};
 #                     warn "push..."$#finalresult;
                     $numbers++;
                 }
             }
             # limit the $results_per_page to result size if it's more
-            $length = $numbers-1 if $numbers < $length;
+            $length = $numbers-$offset if $numbers < ($offset+$length);
             # for the requested page, replace authid by the complete record
             # speed improvement : avoid reading too much things
-            for (my $counter=$offset;$counter<=$offset+$length;$counter++) {
+            my @finalresult;      
+            for (my $counter=$offset;$counter<=$offset+$length-1;$counter++) {
 #                 $finalresult[$counter] = GetAuthority($finalresult[$counter])->as_usmarc;
                 my $separator=C4::Context->preference('authoritysep');
-                my $authrecord = MARC::File::USMARC::decode(GetAuthority($finalresult[$counter])->as_usmarc);
-                my $authid=$authrecord->field('001')->data()
+                my $authrecord =GetAuthority($listresult[$counter]);
+                my $authid=$listresult[$counter]
                 my $summary=BuildSummary($authrecord,$authid,$authtypecode);
                 my $query_auth_tag = "SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?";
                 my $sth = $dbh->prepare($query_auth_tag);
@@ -180,7 +181,7 @@ sub SearchAuthorities {
                 $newline{summary} = $summary;
                 $newline{authid} = $authid;
                 $newline{even} = $counter % 2;
-                $finalresult[$counter]= \%newline;
+                push @finalresult, \%newline;
             }
             return (\@finalresult, $numbers);
         } else {
@@ -198,12 +199,12 @@ sub SearchAuthorities {
         my @authtypecode;
         my @auths=split / /,$authtypecode ;
         foreach my  $auth (@auths){
-            $query .=" \@attr 1=Authority/format-id \@attr 5=100 ".$auth; ##No truncation on authtype
+            $query .=" \@attr 1=authtype \@attr 5=100 ".$auth; ##No truncation on authtype
             push @authtypecode ,$auth;
             $n++;
         }
         if ($n>1){
-            $query= "\@or ".$query;
+            while ($n>1){$query= "\@or ".$query;$n--;}
         }
         
         my $dosearch;
@@ -216,7 +217,7 @@ sub SearchAuthorities {
                 if (@$tags[$i] eq "mainmainentry") {
                 $attr =" \@attr 1=Heading ";
                 }elsif (@$tags[$i] eq "mainentry") {
-                $attr =" \@attr 1=Heading-Entity ";
+                $attr =" \@attr 1=Heading ";
                 }else{
                 $attr =" \@attr 1=Any ";
                 }
@@ -236,10 +237,15 @@ 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");
+        #$query=' @or  @attr 7=2 @attr 1=Heading 0 @or  @attr 7=1 @attr 1=Heading 1'.$query if ($sortby eq "HeadingDsc");
+       $query=' @or  @attr 7=1 @attr 1=Heading 0'.$query if ($sortby eq "HeadingAsc");
+       $query=' @or  @attr 7=2 @attr 1=Heading 0'.$query if ($sortby eq "HeadingDsc");
         
         $offset=0 unless $offset;
         my $counter = $offset;
@@ -287,10 +293,18 @@ sub SearchAuthorities {
             my $sth = $dbh->prepare($query_auth_tag);
             $sth->execute($authtypecode);
             my $auth_tag_to_report = $sth->fetchrow;
+            my $reported_tag;
+            my $mainentry = $authrecord->field($auth_tag_to_report);
+            if ($mainentry) {
+                foreach ($mainentry->subfields()) {
+                    $reported_tag .='$'.$_->[0].$_->[1];
+                }
+            }
             my %newline;
             $newline{summary} = $summary;
             $newline{authid} = $authid;
             $newline{even} = $counter % 2;
+            $newline{reported_tag} = $reported_tag;
             $counter++;
             push @finalresult, \%newline;
             }## while counter
@@ -413,12 +427,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"
@@ -434,7 +448,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"
@@ -493,27 +507,41 @@ 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 (($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') && $record->subfield('152','b'));
   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');
-    $record->add_fields('152','','','b'=>$authtypecode) unless $record->field('152');
+    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));
+    }
 #     warn $record->as_formatted;
     $dbh->do("lock tables auth_header WRITE");
     $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);
+    $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'));
-      $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=?,marcxml=? where authid=?");
-      $sth->execute($record->as_usmarc,$record->as_xml_record,$authid);
+      $sth->execute($record->as_usmarc,$record->as_xml_record($format),$authid);
       $sth->finish;
   }
   $dbh->do("unlock tables");
@@ -558,13 +586,13 @@ sub ModAuthority {
 ### 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;
@@ -634,7 +662,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 {
@@ -753,8 +782,13 @@ sub BuildSummary{
 ## give this a Marc record to return summary
   my ($record,$authid,$authtypecode)=@_;
   my $dbh=C4::Context->dbh;
-  my $authref = GetAuthType($authtypecode);
-  my $summary = $authref->{summary};
+  my $summary;
+  # handle $authtypecode is NULL or eq ""
+  if ($authtypecode) {
+       my $authref = GetAuthType($authtypecode);
+       $summary = $authref->{summary};
+  }
+  # FIXME: should use I18N.pm
   my %language;
   $language{'fre'}="Français";
   $language{'eng'}="Anglais";
@@ -772,7 +806,12 @@ sub BuildSummary{
   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) {
@@ -849,7 +888,12 @@ sub BuildSummary{
       $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')) {
@@ -883,14 +927,12 @@ 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;
       }
   }
@@ -1191,156 +1233,3 @@ Koha Developement team <info@koha.org>
 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
-# - some bugfixes in ordering and "CCL" parsing
-# - support for authorities <=> biblios walking
-#
-# Seems I can do what I want now, so I consider its done, except for bugfixes that will be needed i m sure !
-#
-# Revision 1.45  2007/04/06 14:48:45  hdl
-# Code Cleaning : AuthoritiesMARC.
-#
-# Revision 1.44  2007/04/05 12:17:55  btoumi
-# add "sort by" with heading-entity in authorities search
-#
-# Revision 1.43  2007/03/30 11:59:16  tipaul
-# some cleaning (minor, the main one will come later) : removing some unused subs
-#
-# Revision 1.42  2007/03/29 16:45:53  tipaul
-# Code cleaning of Biblio.pm (continued)
-#
-# All subs have be cleaned :
-# - removed useless
-# - merged some
-# - reordering Biblio.pm completly
-# - using only naming conventions
-#
-# Seems to have broken nothing, but it still has to be heavily tested.
-# Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
-#
-# Revision 1.41  2007/03/29 13:30:31  tipaul
-# Code cleaning :
-# == Biblio.pm cleaning (useless) ==
-# * some sub declaration dropped
-# * removed modbiblio sub
-# * removed moditem sub
-# * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
-# * removed MARCkoha2marcItem
-# * removed MARCdelsubfield declaration
-# * removed MARCkoha2marcBiblio
-#
-# == Biblio.pm cleaning (naming conventions) ==
-# * MARCgettagslib renamed to GetMarcStructure
-# * MARCgetitems renamed to GetMarcItem
-# * MARCfind_frameworkcode renamed to GetFrameworkCode
-# * MARCmarc2koha renamed to TransformMarcToKoha
-# * MARChtml2marc renamed to TransformHtmlToMarc
-# * MARChtml2xml renamed to TranformeHtmlToXml
-# * zebraop renamed to ModZebra
-#
-# == MARC=OFF ==
-# * removing MARC=OFF related scripts (in cataloguing directory)
-# * removed checkitems (function related to MARC=off feature, that is completly broken in head. If someone want to reintroduce it, hard work coming...)
-# * removed getitemsbybiblioitem (used only by MARC=OFF scripts, that is removed as well)
-#
-# Revision 1.40  2007/03/28 10:39:16  hdl
-# removing $dbh as a parameter in AuthoritiesMarc functions
-# And reporting all differences into the scripts taht relies on those functions.
-#
-# Revision 1.39  2007/03/16 01:25:08  kados
-# Using my precrash CVS copy I did the following:
-#
-# cvs -z3 -d:ext:kados@cvs.savannah.nongnu.org:/sources/koha co -P koha
-# find koha.precrash -type d -name "CVS" -exec rm -v {} \;
-# cp -r koha.precrash/* koha/
-# cd koha/
-# cvs commit
-#
-# This should in theory put us right back where we were before the crash
-#
-# Revision 1.39  2007/03/12 22:16:31  kados
-# chcking for field before calling subfields
-#
-# Revision 1.38  2007/03/09 14:31:47  tipaul
-# rel_3_0 moved to HEAD
-#
-# Revision 1.28.2.17  2007/02/05 13:16:08  hdl
-# Removing Link from AuthoritiesMARC summary (caused a problem owed to the API differences between opac and intranet)
-# + removing $dbh in SearchAuthorities
-# + adding links in templates on summaries to go to full view.
-# (no more links in popup authorities. or should we add it ?)
-#
-# Revision 1.28.2.16  2007/02/02 18:07:42  hdl
-# Sorting and searching for exact term now works.
-#
-# Revision 1.28.2.15  2007/01/24 10:17:47  hdl
-# FindDuplicate Now works.
-# Be AWARE that it needs a change ccl.properties.
-#
-# Revision 1.28.2.14  2007/01/10 14:40:11  hdl
-# Adding Authorities tree.
-#
-# Revision 1.28.2.13  2007/01/09 15:18:09  hdl
-# Adding an to ccl.properties to allow ccl search for authority-numbers.
-# Fixing Some problems with the previous modification to allow pqf search to work for more than one page.
-# Using search for an= for an authority-Number.
-#
-# Revision 1.28.2.12  2007/01/09 13:51:31  hdl
-# Bug Fixing : CountUsage used *synchronous* connection where biblio used ****asynchronous**** one.
-# First try to get it work.
-#
-# Revision 1.28.2.11  2007/01/05 14:37:26  btoumi
-# bug fix : remove wrong field in sql syntaxe from auth_subfield_structure table
-#
-# Revision 1.28.2.10  2007/01/04 13:11:08  tipaul
-# commenting 2 zconn destroy
-#
-# Revision 1.28.2.9  2006/12/22 15:09:53  toins
-# removing C4::Database;
-#
-# Revision 1.28.2.8  2006/12/20 17:13:19  hdl
-# modifying use of GILS into use of @attr 1=Koha-Auth-Number
-#
-# Revision 1.28.2.7  2006/12/18 16:45:38  tipaul
-# FIXME upcased
-#
-# Revision 1.28.2.6  2006/12/07 16:45:43  toins
-# removing warn compilation. (perl -wc)
-#
-# Revision 1.28.2.5  2006/12/06 14:19:59  hdl
-# ABugFixing : Authority count  Management.
-#
-# Revision 1.28.2.4  2006/11/17 13:18:58  tipaul
-# code cleaning : removing use of "bib", and replacing with "biblionumber"
-#
-# WARNING : I tried to do carefully, but there are probably some mistakes.
-# So if you encounter a problem you didn't have before, look for this change !!!
-# anyway, I urge everybody to use only "biblionumber", instead of "bib", "bi", "biblio" or anything else. will be easier to maintain !!!
-#
-# Revision 1.28.2.3  2006/11/17 11:17:30  tipaul
-# code cleaning : removing use of "bib", and replacing with "biblionumber"
-#
-# WARNING : I tried to do carefully, but there are probably some mistakes.
-# So if you encounter a problem you didn't have before, look for this change !!!
-# anyway, I urge everybody to use only "biblionumber", instead of "bib", "bi", "biblio" or anything else. will be easier to maintain !!!
-#
-# Revision 1.28.2.2  2006/10/12 22:04:47  hdl
-# Authorities working with zebra.
-# zebra Configuration files are comitted next.