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, $dont_erase ) = @_;
  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, $dont_erase );
  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, $dont_erase ) = @_;
 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       unless ( $dont_erase ) {
 127         foreach my $field ( @fields ) {
 128           $field->update( "$subfieldName" => $values[$i++] );
 129         }
 130       }
 131       if ( $i <= scalar @values - 1 ) {
 132         foreach my $field ( @fields ) {
 133           foreach my $j ( $i .. scalar( @values ) - 1) {
 134             $field->add_subfields( "$subfieldName" => $values[$j] );
 135           }
 136         }
 137       }
 138     } else {
 139       ## Field does not exist, create it.
 140       foreach my $value ( @values ) {
 141         $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
 142         $record->append_fields( $field );
 143       }
 144     }
 145   } else { ## No subfield
 146     if ( my @fields = $record->field( $fieldName ) ) {
 147       foreach my $field ( @fields ) {
 148         $field->update( $values[$i++] );
 149       }
 150     } else {
 151       ## Field does not exists, create it
 152       foreach my $value ( @values ) {
 153         $field = MARC::Field->new( $fieldName, $value );
 154         $record->append_fields( $field );
 155       }
 156     }
 157   }
 158 }
 159
 160 =head2
 161
 162   my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );
 163
 164   Returns an array of field values for the given field and subfield
 165
 166   If $n is given, it will return only the $nth value of the array.
 167   E.g. If $n = 1, it return the 1st value, if $n = 3, it will return the 3rd value.
 168
 169 =cut
 170
 171 sub read_field {
 172   my ( $record, $fieldName, $subfieldName, $n ) = @_;
 173   C4::Koha::Log( "C4::SimpleMARC::read_field( '$record', '$fieldName', '$subfieldName', '$n' )" ) if $debug;
 174
 175   my @fields = $record->field( $fieldName );
 176
 177   return @fields unless $subfieldName;
 178
 179   my @subfields;
 180   foreach my $field ( @fields ) {
 181     my @sf = $field->subfield( $subfieldName );
 182     push( @subfields, @sf );
 183   }
 184
 185   if ( $n ) {
 186     return $subfields[$n-1];
 187   } else {
 188     return @subfields;
 189   }
 190 }
 191
 192 =head2
 193
 194   $bool = field_exists( $record, $fieldName[, $subfieldName ]);
 195
 196   Returns true if the field exits, false otherwise.
 197
 198 =cut
 199
 200 sub field_exists {
 201   my ( $record, $fieldName, $subfieldName ) = @_;
 202   C4::Koha::Log( "C4::SimpleMARC::field_exists( $record, $fieldName, $subfieldName )" ) if $debug;
 203
 204   if ( ! $record ) { return; }
 205
 206   my $return = 0;
 207   if ( $fieldName && $subfieldName ) {
 208     $return = $record->field( $fieldName ) && $record->subfield( $fieldName, $subfieldName );
 209   } elsif ( $fieldName ) {
 210     $return = $record->field( $fieldName ) && 1;
 211   }
 212
 213   C4::Koha::Log( "C4:SimpleMARC::field_exists: Returning '$return'" ) if $debug >= 2;
 214   return $return;
 215 }
 216
 217 =head2
 218
 219   $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex [, $n ] ] ]);
 220
 221   Returns true if the field equals the given value, false otherwise.
 222
 223   If a regular expression ( $regex ) is supplied, the value will be compared using
 224   the given regex. Example: $regex = 'm/sought_text/'
 225
 226   If $n is passed, the Nth field of a repeatable series will be used for comparison.
 227   Set $n to 1 or leave empty for a non-repeatable field.
 228
 229 =cut
 230
 231 sub field_equals {
 232   my ( $record, $value, $fieldName, $subfieldName, $regex, $n ) = @_;
 233   $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
 234   C4::Koha::Log( "C4::SimpleMARC::field_equals( '$record', '$value', '$fieldName', '$subfieldName', '$regex', '$n')" ) if $debug;
 235
 236   if ( ! $record ) { return; }
 237
 238   my @field_values = read_field( $record, $fieldName, $subfieldName, $n );
 239   my $field_value = $field_values[$n-1];
 240
 241   if ( $regex ) {
 242     C4::Koha::Log( "Testing '$field_value' =~ m$value" ) if $debug >= 3;
 243     return eval "\$field_value =~ m$value";
 244   } else {
 245     return $field_value eq $value;
 246   }
 247 }
 248
 249 =head2
 250
 251   move_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex [, $n ] ] );
 252
 253   Moves a value from one field to another. If a regular expression ( $regex ) is supplied,
 254   the value will be transformed by the given regex before being moved into the new field.
 255   Example: $regex = 's/Old Text/Replacement Text/'
 256
 257   If $n is passed, only the Nth field will be moved. $n = 1
 258   will move the first repeatable field, $n = 3 will move the third.
 259
 260 =cut
 261
 262 sub move_field {
 263   my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n ) = @_;
 264   C4::Koha::Log( "C4::SimpleMARC::move_field( '$record', '$fromFieldName', '$fromSubfieldName', '$toFieldName', '$toSubfieldName', '$regex', '$n' )" ) if $debug;
 265   copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n , "don't_erase");
 266   delete_field( $record, $fromFieldName, $fromSubfieldName, $n );
 267 }
 268
 269 =head2
 270
 271   delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
 272
 273   Deletes the given field.
 274
 275   If $n is passed, only the Nth field will be deleted. $n = 1
 276   will delete the first repeatable field, $n = 3 will delete the third.
 277
 278 =cut
 279
 280 sub delete_field {
 281   my ( $record, $fieldName, $subfieldName, $n ) = @_;
 282   C4::Koha::Log( "C4::SimpleMARC::delete_field( '$record', '$fieldName', '$subfieldName', '$n' )" ) if $debug;
 283
 284   my @fields = $record->field( $fieldName );
 285
 286   @fields = ( $fields[$n-1] ) if ( $n );
 287
 288   if ( @fields && !$subfieldName ) {
 289     foreach my $field ( @fields ) {
 290       $record->delete_field( $field );
 291     }
 292   } elsif ( @fields && $subfieldName ) {
 293     foreach my $field ( @fields ) {
 294       $field->delete_subfield( code => $subfieldName );
 295     }
 296   }
 297 }
 298
 299 =head2
 300
 301   _update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, $value );
 302
 303   Updates a repeatable field, giving all existing copies of that field the given value.
 304
 305   This is an internal function, and thus is not exported.
 306
 307 =cut
 308
 309 sub _update_repeatable_field_with_single_value {
 310   my ( $record, $fieldName, $subfieldName, $value ) = @_;
 311   C4::Koha::Log( "C4::SimpleMARC::_update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, $value )" ) if $debug;
 312
 313   if ( ! ( $record && $fieldName ) ) { return; }
 314
 315   my $field;
 316   if ( $subfieldName ) {
 317     if ( my @fields = $record->field( $fieldName ) ) {
 318       foreach my $field ( @fields ) {
 319         $field->update( "$subfieldName" => $value );
 320       }
 321     } else {
 322       ## Field does not exist, create it.
 323       $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $value );
 324       $record->append_fields( $field );
 325     }
 326   } else { ## No subfield
 327     if ( my @fields = $record->field( $fieldName ) ) {
 328       foreach my $field ( @fields ) {
 329         $field->update( $value );
 330       }
 331     } else {
 332       ## Field does not exists, create it
 333       $field = MARC::Field->new( $fieldName, $value );
 334       $record->append_fields( $field );
 335     }
 336   }
 337 }
 338
 339 1;
 340 __END__