C4/Record.pm

   1 package C4::Record;
   2 #
   3 # Copyright 2006 (C) LibLime
   4 # Joshua Ferraro <jmf@liblime.com>
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along with
  18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  19 # Suite 330, Boston, MA  02111-1307 USA
  20 #
  21 # $Id$
  22 #
  23 use strict; use warnings; #FIXME: turn off warnings before release
  24
  25 # please specify in which methods a given module is used
  26 use MARC::Record; #marc2marcxml, marcxml2marc, html2marc, changeEncoding
  27 use MARC::File::XML; #marc2marcxml, marcxml2marc, html2marcxml, changeEncoding
  28
  29 use vars qw($VERSION @ISA @EXPORT);
  30
  31 # set the version for version checking
  32 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  33                 shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  34
  35 @ISA = qw(Exporter);
  36
  37 # only export API methods
  38
  39 @EXPORT = qw(
  40   &marc2marcxml
  41   &marcxml2marc
  42   &html2marcxml
  43   &html2marc
  44   &changeEncoding
  45 );
  46
  47 =head1 NAME
  48
  49 C4::Record - MARC, MARCXML, XML, etc. Record Management Functions and API
  50
  51 =head1 SYNOPSIS
  52
  53 New in Koha 3.x. This module handles all record-related management functions.
  54
  55 =head1 API
  56
  57 =head2 marc2marcxml
  58
  59 my $marcxml = marc2marcxml($marc,$encoding,$flavour);
  60
  61 returns an XML scalar variable
  62
  63 C<$marc> a MARC::Record object or binary MARC record
  64
  65 C<$encoding> UTF-8 or MARC-8 [UTF-8}
  66
  67 C<$flavour> MARC21 or UNIMARC
  68
  69 =cut
  70
  71 sub marc2marcxml {
  72         my ($marc,$encoding,$flavour) = @_;
  73         unless($encoding) {$encoding = "UTF-8"};
  74         unless($flavour) {$flavour = C4::Context->preference("TemplateEncoding")};
  75         #FIXME: add error handling
  76         my $marcxml = $record->as_xml_record($marc,$encoding,$flavour);
  77         return $marcxml;
  78 }
  79
  80 =head2 marcxml2marc
  81
  82 my $marc = marcxml2marc($marcxml,$encoding,$flavour);
  83
  84 returns a binary MARC scalar variable
  85
  86 C<$marcxml> a MARCXML record
  87
  88 C<$encoding> UTF-8 or MARC-8 [UTF-8]
  89
  90 C<$flavour> MARC21 or UNIMARC
  91
  92 =cut
  93
  94 sub marcxml2marc {
  95     my ($marcxml,$encoding,$flavour) = @_;
  96         unless($encoding) {$encoding = "UTF-8"};
  97         unless($flavour) {$flavour = C4::Context->preference("TemplateEncoding")};
  98         #FIXME: add error handling
  99         my $marc = $marcxml->new_from_xml($record,$encoding,$flavour);
 100         return $marc;
 101 }
 102
 103 =head2 html2marcxml
 104
 105 my $marcxml = html2marcxml($tags,$subfields,$values,$indicator,$ind_tag);
 106
 107 returns a MARCXML scalar variable
 108
 109 this is used in addbiblio.pl and additem.pl to build the MARCXML record from
 110 the form submission.
 111
 112 FIXME: this could use some better code documentation
 113
 114 =cut
 115
 116 sub html2marcxml {
 117     my ($tags,$subfields,$values,$indicator,$ind_tag) = @_;
 118         # add the header info
 119     my $marcxml= MARC::File::XML::header(C4::Context->preference('TemplateEncoding'),C4::Context->preference('marcflavour'));
 120
 121         # some flags used to figure out where in the record we are
 122     my $prevvalue;
 123     my $prevtag=-1;
 124     my $first=1;
 125     my $j = -1;
 126
 127         # handle characters that would cause the parser to choke FIXME: is there a more elegant solution?
 128     for (my $i=0;$i<=@$tags;$i++){
 129                 @$values[$i] =~ s/&/&amp;/g;
 130                 @$values[$i] =~ s/</&lt;/g;
 131                 @$values[$i] =~ s/>/&gt;/g;
 132                 @$values[$i] =~ s/"/&quot;/g;
 133                 @$values[$i] =~ s/'/&apos;/g;
 134
 135                 if ((@$tags[$i] ne $prevtag)){
 136                         $j++ unless (@$tags[$i] eq "");
 137                         #warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i];
 138                         if (!$first){
 139                                 $marcxml.="</datafield>\n";
 140                                 if ((@$tags[$i] > 10) && (@$values[$i] ne "")){
 141                         my $ind1 = substr(@$indicator[$j],0,1);
 142                                         my $ind2 = substr(@$indicator[$j],1,1);
 143                                         $marcxml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
 144                                         $marcxml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
 145                                         $first=0;
 146                                 } else {
 147                                         $first=1;
 148                                 }
 149                         } else {
 150                                 if (@$values[$i] ne "") {
 151                                         # handle the leader
 152                                         if (@$tags[$i] eq "000") {
 153                                                 $marcxml.="<leader>@$values[$i]</leader>\n";
 154                                                 $first=1;
 155                                         # rest of the fixed fields
 156                                         } elsif (@$tags[$i] < 010) { #FIXME: <10 was the way it was, there might even be a better way
 157                                                 $marcxml.="<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
 158                                                 $first=1;
 159                                         } else {
 160                                                 my $ind1 = substr(@$indicator[$j],0,1);
 161                                                 my $ind2 = substr(@$indicator[$j],1,1);
 162                                                 $marcxml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
 163                                                 $marcxml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
 164                                                 $first=0;
 165                                         }
 166                                 }
 167                         }
 168                 } else { # @$tags[$i] eq $prevtag
 169                         if (@$values[$i] eq "") {
 170                         } else {
 171                                 if ($first){
 172                                         my $ind1 = substr(@$indicator[$j],0,1);
 173                                         my $ind2 = substr(@$indicator[$j],1,1);
 174                                         $marcxml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
 175                                         $first=0;
 176                                 }
 177                                 $marcxml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
 178                         }
 179                 }
 180                 $prevtag = @$tags[$i];
 181         }
 182         $marcxml.= MARC::File::XML::footer();
 183         #warn $marcxml;
 184         return $marcxml;
 185 }
 186
 187 =head2 html2marc
 188
 189 Probably best to avoid using this ... it has some rather striking problems:
 190
 191 * saves blank subfields
 192 * subfield order is hardcoded to always start
 193  with 'a' for repeatable tags (because it is hardcoded in the
 194  addfield routine).
 195 * only possible to specify one set of indicators for each set of
 196  tags (ie, one for all the 650s). (because they were stored in a
 197  hash with the tag as the key).
 198 * the underlying routines didn't support subfield
 199  reordering or subfield repeatability.
 200
 201 I've left it in here because it could be useful if someone took the time to
 202 fix it.
 203
 204 =cut
 205
 206 sub html2marc {
 207     my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
 208     my $prevtag = -1;
 209     my $record = MARC::Record->new();
 210 #   my %subfieldlist=();
 211     my $prevvalue; # if tag <10
 212     my $field; # if tag >=10
 213     for (my $i=0; $i< @$rtags; $i++) {
 214         # rebuild MARC::Record
 215 #           warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
 216         if (@$rtags[$i] ne $prevtag) {
 217             if ($prevtag < 10) {
 218                 if ($prevvalue) {
 219                     if (($prevtag ne '000') && ($prevvalue ne "")) {
 220                         $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
 221                     } elsif ($prevvalue ne ""){
 222                         $record->leader($prevvalue);
 223                     }
 224                 }
 225             } else {
 226                 if (($field) && ($field ne "")) {
 227                     $record->add_fields($field);
 228                 }
 229             }
 230             $indicators{@$rtags[$i]}.='  ';
 231                 # skip blank tags, I hope this works
 232                 if (@$rtags[$i] eq ''){
 233                 $prevtag = @$rtags[$i];
 234                 undef $field;
 235                 next;
 236             }
 237             if (@$rtags[$i] <10) {
 238                 $prevvalue= @$rvalues[$i];
 239                 undef $field;
 240             } else {
 241                 undef $prevvalue;
 242                 if (@$rvalues[$i] eq "") {
 243                 undef $field;
 244                 } else {
 245                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
 246                 }
 247 #           warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 248             }
 249             $prevtag = @$rtags[$i];
 250         } else {
 251             if (@$rtags[$i] <10) {
 252                 $prevvalue=@$rvalues[$i];
 253             } else {
 254                 if (length(@$rvalues[$i])>0) {
 255                     $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
 256 #           warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 257                 }
 258             }
 259             $prevtag= @$rtags[$i];
 260         }
 261     }
 262     #}
 263     # the last has not been included inside the loop... do it now !
 264     #use Data::Dumper;
 265     #warn Dumper($field->{_subfields});
 266     $record->add_fields($field) if (($field) && $field ne "");
 267     #warn "HTML2MARC=".$record->as_formatted;
 268     return $record;
 269 }
 270
 271 =head2 changeEncoding
 272
 273 $newrecord = changeEncoding($record,$format,$flavour,$toencoding,$fromencoding);
 274
 275 changes the encoding of a record
 276
 277 <C$record the record itself can be in ISO2709, a MARC::Record object, or MARCXML for now (required)
 278
 279 <C$format MARC or MARCXML (required for now, eventually it will attempt to guess)
 280
 281 <C$flavour MARC21 or UNIMARC, if MARC21, it will change the leader (optional) [defaults to system preference]
 282
 283 <C$toencoding the encoding you want the record to end up in (optional) [UTF-8]
 284
 285 <C$fromencoding the encoding the record is currently in (optional, it will probably be able to tell unless there's a problem with the record)
 286
 287 FIXME: the fromencoding doesn't work yet
 288 FIXME: better handling for UNIMARC, it should allow management of 100 field
 289 FIXME: shouldn't have to convert to and from xml/marc just to change encoding,
 290         someone needs to re-write MARC::Record's 'encoding' method to actually
 291         alter the encoding rather than just changing the leader
 292
 293 =cut
 294
 295 sub changeEncoding {
 296         my ($record,$format,$flavour,$toencoding,$fromencoding) = @_;
 297         my $newrecord;
 298         unless($flavour) {$flavour = C4::Context->preference("marcflavour")};
 299         unless($toencoding) {$toencoding = "UTF-8"};
 300         if (lc($format) =~ /^MARC$/o) { # ISO2790 Record
 301                 my $marcxml = marc2marcxml($record,$encoding,$flavour);
 302                 $newrecord = marcxml2marc($marcxml,$encoding,$flavour);
 303         } elsif (lc($format) =~ /^MARCXML$/o) { # MARCXML Record
 304                 my $marc = marcxml2marc($record,$encoding,$flavour);
 305                 $newrecord = marc2marcxml($record,$encoding,$flavour);
 306         } else {
 307         #FIXME: handle other record formats, and finally, handle errors
 308         }
 309         return $newrecord;
 310 }
 311
 312 END { }       # module clean-up code here (global destructor)
 313 1;
 314 __END__
 315
 316 =back
 317
 318 =head1 AUTHOR
 319
 320 Joshua Ferraro <jmf@liblime.com>
 321
 322 =cut
 323 =head MODIFICATIONS
 324 # $Id$
 325 =cut