Koha/SimpleMARC.pm

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