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