Open-ILS/src/sql/Pg/upgrade/1299.function.strip_field_multimatch.sql

   1 BEGIN;
   2
   3 SELECT evergreen.upgrade_deps_block_check('1299', :eg_version);
   4
   5 CREATE OR REPLACE FUNCTION vandelay.strip_field(xml text, field text) RETURNS text AS $f$
   6
   7     use MARC::Record;
   8     use MARC::File::XML (BinaryEncoding => 'UTF-8');
   9     use MARC::Charset;
  10     use strict;
  11
  12     MARC::Charset->assume_unicode(1);
  13
  14     my $xml = shift;
  15     my $r = MARC::Record->new_from_xml( $xml );
  16
  17     return $xml unless ($r);
  18
  19     my $field_spec = shift;
  20     my @field_list = split(',', $field_spec);
  21
  22     my %fields;
  23     for my $f (@field_list) {
  24         $f =~ s/^\s*//; $f =~ s/\s*$//;
  25         if ($f =~ /^(.{3})(\w*)(?:\[([^]]*)\])?$/) {
  26             my $field = $1;
  27             $field =~ s/\s+//;
  28             my $sf = $2;
  29             $sf =~ s/\s+//;
  30             my $matches = $3;
  31             $matches =~ s/^\s*//; $matches =~ s/\s*$//;
  32             $fields{$field} = { sf => [ split('', $sf) ] };
  33             if ($matches) {
  34                 for my $match (split('&&', $matches)) {
  35                     $match =~ s/^\s*//; $match =~ s/\s*$//;
  36                     my ($msf,$mre) = split('~', $match);
  37                     if (length($msf) > 0 and length($mre) > 0) {
  38                         $msf =~ s/^\s*//; $msf =~ s/\s*$//;
  39                         $mre =~ s/^\s*//; $mre =~ s/\s*$//;
  40                         $fields{$field}{match}{$msf} = qr/$mre/;
  41                     }
  42                 }
  43             }
  44         }
  45     }
  46
  47     for my $f ( keys %fields) {
  48         for my $to_field ($r->field( $f )) {
  49             if (exists($fields{$f}{match})) {
  50                 my @match_list = grep { $to_field->subfield($_) =~ $fields{$f}{match}{$_} } keys %{$fields{$f}{match}};
  51                 next unless (scalar(@match_list) == scalar(keys %{$fields{$f}{match}}));
  52             }
  53
  54             if ( @{$fields{$f}{sf}} ) {
  55                 $to_field->delete_subfield(code => $fields{$f}{sf});
  56             } else {
  57                 $r->delete_field( $to_field );
  58             }
  59         }
  60     }
  61
  62     $xml = $r->as_xml_record;
  63     $xml =~ s/^<\?.+?\?>$//mo;
  64     $xml =~ s/\n//sgo;
  65     $xml =~ s/>\s+</></sgo;
  66
  67     return $xml;
  68
  69 $f$ LANGUAGE plperlu;
  70
  71 COMMIT;
  72