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 module 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
  78   if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
  79
  80   my @values = read_field( $record, $fromFieldName, $fromSubfieldName );
  81   @values = ( $values[$n-1] ) if ( $n );
  82
  83   if ( $regex and $regex->{search} ) {
  84     $regex->{modifiers} //= q||;
  85     my @available_modifiers = qw( i g );
  86     my $modifiers = q||;
  87     for my $modifier ( split //, $regex->{modifiers} ) {
  88         $modifiers .= $modifier
  89             if grep {/$modifier/} @available_modifiers;
  90     }
  91     foreach my $value ( @values ) {
  92         for ( $modifiers ) {
  93           when ( /^(ig|gi)$/ ) {
  94             $value =~ s/$regex->{search}/$regex->{replace}/ig;
  95           }
  96           when ( /^i$/ ) {
  97             $value =~ s/$regex->{search}/$regex->{replace}/i;
  98           }
  99           when ( /^g$/ ) {
 100             $value =~ s/$regex->{search}/$regex->{replace}/g;
 101           }
 102           default {
 103             $value =~ s/$regex->{search}/$regex->{replace}/;
 104           }
 105       }
 106     }
 107   }
 108   update_field( $record, $toFieldName, $toSubfieldName, $dont_erase, @values );
 109 }
 110
 111 =head2 update_field
 112
 113   update_field( $record, $fieldName, $subfieldName, $dont_erase, $value[, $value,[ $value ... ] ] );
 114
 115   Updates a field with the given value, creating it if neccessary.
 116
 117   If multiple values are supplied, they will be used to update a list of repeatable fields
 118   until either the fields or the values are all used.
 119
 120   If a single value is supplied for a repeated field, that value will be used to update
 121   each of the repeated fields.
 122
 123 =cut
 124
 125 sub update_field {
 126   my ( $record, $fieldName, $subfieldName, $dont_erase, @values ) = @_;
 127
 128   if ( ! ( $record && $fieldName ) ) { return; }
 129
 130   my $i = 0;
 131   my $field;
 132   if ( $subfieldName ) {
 133     if ( my @fields = $record->field( $fieldName ) ) {
 134       unless ( $dont_erase ) {
 135         @values = ($values[0]) x scalar( @fields )
 136           if @values == 1;
 137         foreach my $field ( @fields ) {
 138           $field->update( "$subfieldName" => $values[$i++] );
 139         }
 140       }
 141       if ( $i <= scalar ( @values ) - 1 ) {
 142         foreach my $field ( @fields ) {
 143           foreach my $j ( $i .. scalar( @values ) - 1) {
 144             $field->add_subfields( "$subfieldName" => $values[$j] );
 145           }
 146         }
 147       }
 148     } else {
 149       ## Field does not exist, create it.
 150       foreach my $value ( @values ) {
 151         $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
 152         $record->append_fields( $field );
 153       }
 154     }
 155   } else { ## No subfield
 156     if ( my @fields = $record->field( $fieldName ) ) {
 157       @values = ($values[0]) x scalar( @fields )
 158         if @values == 1;
 159       foreach my $field ( @fields ) {
 160         $field->update( $values[$i++] );
 161       }
 162     } else {
 163       ## Field does not exists, create it
 164       foreach my $value ( @values ) {
 165         $field = MARC::Field->new( $fieldName, $value );
 166         $record->append_fields( $field );
 167       }
 168     }
 169   }
 170 }
 171
 172 =head2 read_field
 173
 174   my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );
 175
 176   Returns an array of field values for the given field and subfield
 177
 178   If $n is given, it will return only the $nth value of the array.
 179   E.g. If $n = 1, it return the 1st value, if $n = 3, it will return the 3rd value.
 180
 181 =cut
 182
 183 sub read_field {
 184   my ( $record, $fieldName, $subfieldName, $n ) = @_;
 185
 186   my @fields = $record->field( $fieldName );
 187
 188   return map { $_->data() } @fields unless $subfieldName;
 189
 190   my @subfields;
 191   foreach my $field ( @fields ) {
 192     my @sf = $field->subfield( $subfieldName );
 193     push( @subfields, @sf );
 194   }
 195
 196   if ( $n ) {
 197     return $subfields[$n-1];
 198   } else {
 199     return @subfields;
 200   }
 201 }
 202
 203 =head2 field_exists
 204
 205   $bool = field_exists( $record, $fieldName[, $subfieldName ]);
 206
 207   Returns true if the field exits, false otherwise.
 208
 209 =cut
 210
 211 sub field_exists {
 212   my ( $record, $fieldName, $subfieldName ) = @_;
 213
 214   if ( ! $record ) { return; }
 215
 216   my $return = 0;
 217   if ( $fieldName && $subfieldName ) {
 218     $return = $record->field( $fieldName ) && $record->subfield( $fieldName, $subfieldName );
 219   } elsif ( $fieldName ) {
 220     $return = $record->field( $fieldName ) && 1;
 221   }
 222
 223   return $return;
 224 }
 225
 226 =head2 field_equals
 227
 228   $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex [, $n ] ] ]);
 229
 230   Returns true if the field equals the given value, false otherwise.
 231
 232   If a regular expression ( $regex ) is supplied, the value will be compared using
 233   the given regex. Example: $regex = 'sought_text'
 234
 235   If $n is passed, the Nth field of a repeatable series will be used for comparison.
 236   Set $n to 1 or leave empty for a non-repeatable field.
 237
 238 =cut
 239
 240 sub field_equals {
 241   my ( $record, $value, $fieldName, $subfieldName, $regex, $n ) = @_;
 242   $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
 243
 244   if ( ! $record ) { return; }
 245
 246   my @field_values = read_field( $record, $fieldName, $subfieldName, $n );
 247   my $field_value = $field_values[$n-1];
 248
 249   if ( $regex ) {
 250     return $field_value =~ m/$value/;
 251   } else {
 252     return $field_value eq $value;
 253   }
 254 }
 255
 256 =head2 move_field
 257
 258   move_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex [, $n ] ] );
 259
 260   Moves a value from one field to another. If a regular expression ( $regex ) is supplied,
 261   the value will be transformed by the given regex before being moved into the new field.
 262   Example: $regex = 's/Old Text/Replacement Text/'
 263
 264   If $n is passed, only the Nth field will be moved. $n = 1
 265   will move the first repeatable field, $n = 3 will move the third.
 266
 267 =cut
 268
 269 sub move_field {
 270   my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n ) = @_;
 271   copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n , 'dont_erase' );
 272   delete_field( $record, $fromFieldName, $fromSubfieldName, $n );
 273 }
 274
 275 =head2 delete_field
 276
 277   delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
 278
 279   Deletes the given field.
 280
 281   If $n is passed, only the Nth field will be deleted. $n = 1
 282   will delete the first repeatable field, $n = 3 will delete the third.
 283
 284 =cut
 285
 286 sub delete_field {
 287   my ( $record, $fieldName, $subfieldName, $n ) = @_;
 288
 289   my @fields = $record->field( $fieldName );
 290
 291   @fields = ( $fields[$n-1] ) if ( $n );
 292
 293   if ( @fields && !$subfieldName ) {
 294     foreach my $field ( @fields ) {
 295       $record->delete_field( $field );
 296     }
 297   } elsif ( @fields && $subfieldName ) {
 298     foreach my $field ( @fields ) {
 299       $field->delete_subfield( code => $subfieldName );
 300     }
 301   }
 302 }
 303
 304 1;
 305 __END__