Koha/SimpleMARC.pm

   1 package Koha::SimpleMARC;
   2
   3 # Copyright 2009 Kyle M. Hall <kyle.m.hall@gmail.com>
   4
   5 use strict;
   6 use warnings;
   7
   8 #use MARC::Record;
   9
  10 require Exporter;
  11
  12 our @ISA = qw(Exporter);
  13 our %EXPORT_TAGS = ( 'all' => [ qw(
  14
  15 ) ] );
  16
  17 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
  18
  19 our @EXPORT = qw(
  20   read_field
  21   update_field
  22   copy_field
  23   move_field
  24   delete_field
  25   field_exists
  26   field_equals
  27 );
  28
  29 our $VERSION = '0.01';
  30
  31 our $debug = 0;
  32
  33 =head1 NAME
  34
  35 SimpleMARC - Perl modle for making simple MARC record alterations.
  36
  37 =head1 SYNOPSIS
  38
  39   use SimpleMARC;
  40
  41 =head1 DESCRIPTION
  42
  43 SimpleMARC is designed to make writing scripts
  44 to modify MARC records simple and easy.
  45
  46 Every function in the modules requires a
  47 MARC::Record object as its first parameter.
  48
  49 =head1 AUTHOR
  50
  51 Kyle Hall <lt>kyle.m.hall@gmail.com<gt>
  52
  53 =head1 COPYRIGHT AND LICENSE
  54
  55 Copyright (C) 2009 by Kyle Hall
  56
  57 This library is free software; you can redistribute it and/or modify
  58 it under the same terms as Perl itself, either Perl version 5.8.7 or,
  59 at your option, any later version of Perl 5 you may have available.
  60
  61 =head1 FUNCTIONS
  62
  63 =head2
  64
  65   copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex[, $n ] ] );
  66
  67   Copies a value from one field to another. If a regular expression ( $regex ) is supplied,
  68   the value will be transformed by the given regex before being copied into the new field.
  69   Example: $regex = 's/Old Text/Replacement Text/'
  70
  71   If $n is passed, copy_field will only copy the Nth field of the list of fields.
  72   E.g. $n = 1 will only use the first field's value, $n = 2 will use only the 2nd field's value.
  73
  74 =cut
  75
  76 sub copy_field {
  77   my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n ) = @_;
  78   C4::Koha::Log( "C4::SimpleMARC::copy_field( '$record', '$fromFieldName', '$fromSubfieldName', '$toFieldName', '$toSubfieldName', '$regex', '$n' )" ) if $debug;
  79
  80   if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
  81
  82   my @values = read_field( $record, $fromFieldName, $fromSubfieldName );
  83   @values = ( $values[$n-1] ) if ( $n );
  84   C4::Koha::Log( "@values = read_field( $record, $fromFieldName, $fromSubfieldName )" ) if $debug >= 3;
  85
  86   if ( $regex ) {
  87     foreach my $value ( @values ) {
  88       C4::Koha::Log( "\$value =~ s$regex" ) if ( $debug >= 3 );
  89       eval "\$value =~ s$regex";
  90     }
  91   }
  92
  93   update_field( $record, $toFieldName, $toSubfieldName, @values );
  94
  95 }
  96
  97 =head2
  98
  99   update_field( $record, $fieldName, $subfieldName, $value[, $value,[ $value ... ] ] );
 100
 101   Updates a field with the given value, creating it if neccessary.
 102
 103   If multiple values are supplied, they will be used to update a list of repeatable fields
 104   until either the fields or the values are all used.
 105
 106   If a single value is supplied for a repeated field, that value will be used to update
 107   each of the repeated fields.
 108
 109 =cut
 110
 111 sub update_field {
 112   my ( $record, $fieldName, $subfieldName, @values ) = @_;
 113   C4::Koha::Log( "C4::SimpleMARC::update_field( $record, $fieldName, $subfieldName, @values )" ) if $debug;
 114
 115   if ( ! ( $record && $fieldName ) ) { return; }
 116
 117   if ( @values eq 1 ) {
 118     _update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, @values );
 119     return;
 120   }
 121
 122   my $i = 0;
 123   my $field;
 124   if ( $subfieldName ) {
 125     if ( my @fields = $record->field( $fieldName ) ) {
 126       foreach my $field ( @fields ) {
 127         $field->update( "$subfieldName" => $values[$i++] );
 128       }
 129     } else {
 130       ## Field does not exist, create it.
 131       foreach my $value ( @values ) {
 132         $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
 133         $record->append_fields( $field );
 134       }
 135     }
 136   } else { ## No subfield
 137     if ( my @fields = $record->field( $fieldName ) ) {
 138       foreach my $field ( @fields ) {
 139         $field->update( $values[$i++] );
 140       }
 141     } else {
 142       ## Field does not exists, create it
 143       foreach my $value ( @values ) {
 144         $field = MARC::Field->new( $fieldName, $value );
 145         $record->append_fields( $field );
 146       }
 147     }
 148   }
 149 }
 150
 151 =head2
 152
 153   my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );
 154
 155   Returns an array of field values for the given field and subfield
 156
 157   If $n is given, it will return only the $nth value of the array.
 158   E.g. If $n = 1, it return the 1st value, if $n = 3, it will return the 3rd value.
 159
 160 =cut
 161
 162 sub read_field {
 163   my ( $record, $fieldName, $subfieldName, $n ) = @_;
 164   C4::Koha::Log( "C4::SimpleMARC::read_field( '$record', '$fieldName', '$subfieldName', '$n' )" ) if $debug;
 165
 166   my @fields = $record->field( $fieldName );
 167
 168   return @fields unless $subfieldName;
 169
 170   my @subfields;
 171   foreach my $field ( @fields ) {
 172     my @sf = $field->subfield( $subfieldName );
 173     push( @subfields, @sf );
 174   }
 175
 176   if ( $n ) {
 177     return $subfields[$n-1];
 178   } else {
 179     return @subfields;
 180   }
 181 }
 182
 183 =head2
 184
 185   $bool = field_exists( $record, $fieldName[, $subfieldName ]);
 186
 187   Returns true if the field exits, false otherwise.
 188
 189 =cut
 190
 191 sub field_exists {
 192   my ( $record, $fieldName, $subfieldName ) = @_;
 193   C4::Koha::Log( "C4::SimpleMARC::field_exists( $record, $fieldName, $subfieldName )" ) if $debug;
 194
 195   if ( ! $record ) { return; }
 196
 197   my $return = 0;
 198   if ( $fieldName && $subfieldName ) {
 199     $return = $record->field( $fieldName ) && $record->subfield( $fieldName, $subfieldName );
 200   } elsif ( $fieldName ) {
 201     $return = $record->field( $fieldName ) && 1;
 202   }
 203
 204   C4::Koha::Log( "C4:SimpleMARC::field_exists: Returning '$return'" ) if $debug >= 2;
 205   return $return;
 206 }
 207
 208 =head2
 209
 210   $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex [, $n ] ] ]);
 211
 212   Returns true if the field equals the given value, false otherwise.
 213
 214   If a regular expression ( $regex ) is supplied, the value will be compared using
 215   the given regex. Example: $regex = 'm/sought_text/'
 216
 217   If $n is passed, the Nth field of a repeatable series will be used for comparison.
 218   Set $n to 1 or leave empty for a non-repeatable field.
 219
 220 =cut
 221
 222 sub field_equals {
 223   my ( $record, $value, $fieldName, $subfieldName, $regex, $n ) = @_;
 224   $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
 225   C4::Koha::Log( "C4::SimpleMARC::field_equals( '$record', '$value', '$fieldName', '$subfieldName', '$regex', '$n')" ) if $debug;
 226
 227   if ( ! $record ) { return; }
 228
 229   my @field_values = read_field( $record, $fieldName, $subfieldName, $n );
 230   my $field_value = $field_values[$n-1];
 231
 232   if ( $regex ) {
 233     C4::Koha::Log( "Testing '$field_value' =~ m$value" ) if $debug >= 3;
 234     return eval "\$field_value =~ m$value";
 235   } else {
 236     return $field_value eq $value;
 237   }
 238 }
 239
 240 =head2
 241
 242   move_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex [, $n ] ] );
 243
 244   Moves a value from one field to another. If a regular expression ( $regex ) is supplied,
 245   the value will be transformed by the given regex before being moved into the new field.
 246   Example: $regex = 's/Old Text/Replacement Text/'
 247
 248   If $n is passed, only the Nth field will be moved. $n = 1
 249   will move the first repeatable field, $n = 3 will move the third.
 250
 251 =cut
 252
 253 sub move_field {
 254   my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n ) = @_;
 255   C4::Koha::Log( "C4::SimpleMARC::move_field( '$record', '$fromFieldName', '$fromSubfieldName', '$toFieldName', '$toSubfieldName', '$regex', '$n' )" ) if $debug;
 256   copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n );
 257   delete_field( $record, $fromFieldName, $fromSubfieldName, $n );
 258 }
 259
 260 =head2
 261
 262   delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
 263
 264   Deletes the given field.
 265
 266   If $n is passed, only the Nth field will be deleted. $n = 1
 267   will delete the first repeatable field, $n = 3 will delete the third.
 268
 269 =cut
 270
 271 sub delete_field {
 272   my ( $record, $fieldName, $subfieldName, $n ) = @_;
 273   C4::Koha::Log( "C4::SimpleMARC::delete_field( '$record', '$fieldName', '$subfieldName', '$n' )" ) if $debug;
 274
 275   my @fields = $record->field( $fieldName );
 276
 277   @fields = ( $fields[$n-1] ) if ( $n );
 278
 279   if ( @fields && !$subfieldName ) {
 280     foreach my $field ( @fields ) {
 281       $record->delete_field( $field );
 282     }
 283   } elsif ( @fields && $subfieldName ) {
 284     foreach my $field ( @fields ) {
 285       $field->delete_subfield( code => $subfieldName );
 286     }
 287   }
 288 }
 289
 290 =head2
 291
 292   _update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, $value );
 293
 294   Updates a repeatable field, giving all existing copies of that field the given value.
 295
 296   This is an internal function, and thus is not exported.
 297
 298 =cut
 299
 300 sub _update_repeatable_field_with_single_value {
 301   my ( $record, $fieldName, $subfieldName, $value ) = @_;
 302   C4::Koha::Log( "C4::SimpleMARC::_update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, $value )" ) if $debug;
 303
 304   if ( ! ( $record && $fieldName ) ) { return; }
 305
 306   my $field;
 307   if ( $subfieldName ) {
 308     if ( my @fields = $record->field( $fieldName ) ) {
 309       foreach my $field ( @fields ) {
 310         $field->update( "$subfieldName" => $value );
 311       }
 312     } else {
 313       ## Field does not exist, create it.
 314       $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $value );
 315       $record->append_fields( $field );
 316     }
 317   } else { ## No subfield
 318     if ( my @fields = $record->field( $fieldName ) ) {
 319       foreach my $field ( @fields ) {
 320         $field->update( $value );
 321       }
 322     } else {
 323       ## Field does not exists, create it
 324       $field = MARC::Field->new( $fieldName, $value );
 325       $record->append_fields( $field );
 326     }
 327   }
 328 }
 329
 330 1;
 331 __END__