BEGIN; INSERT INTO config.upgrade_log (version) VALUES ('0453'); -- miker CREATE OR REPLACE FUNCTION vandelay.add_field ( target_xml TEXT, source_xml TEXT, field TEXT ) RETURNS TEXT AS $_$ use MARC::Record; use MARC::File::XML (BinaryEncoding => 'UTF-8'); use strict; my $target_xml = shift; my $source_xml = shift; my $field_spec = shift; my $target_r = MARC::Record->new_from_xml( $target_xml ); my $source_r = MARC::Record->new_from_xml( $source_xml ); return $target_xml unless ($target_r && $source_r); my @field_list = split(',', $field_spec); my %fields; for my $f (@field_list) { $f =~ s/^\s*//; $f =~ s/\s*$//; if ($f =~ /^(.{3})(\w*)(?:\[([^]]*)\])?$/) { my $field = $1; $field =~ s/\s+//; my $sf = $2; $sf =~ s/\s+//; my $match = $3; $match =~ s/^\s*//; $match =~ s/\s*$//; $fields{$field} = { sf => [ split('', $sf) ] }; if ($match) { my ($msf,$mre) = split('~', $match); if (length($msf) > 0 and length($mre) > 0) { $msf =~ s/^\s*//; $msf =~ s/\s*$//; $mre =~ s/^\s*//; $mre =~ s/\s*$//; $fields{$field}{match} = { sf => $msf, re => qr/$mre/ }; } } } } for my $f ( keys %fields) { if ( @{$fields{$f}{sf}} ) { for my $from_field ($source_r->field( $f )) { my @tos = $target_r->field( $f ); if (!@tos) { next if (exists($fields{$f}{match})); my @new_fields = map { $_->clone } $source_r->field( $f ); $target_r->insert_fields_ordered( @new_fields ); } else { for my $to_field (@tos) { if (exists($fields{$f}{match})) { next unless (grep { $_ =~ $fields{$f}{match}{re} } $to_field->subfield($fields{$f}{match}{sf})); } my @new_sf = map { ($_ => $from_field->subfield($_)) } @{$fields{$f}{sf}}; $to_field->add_subfields( @new_sf ); } } } } else { my @new_fields = map { $_->clone } $source_r->field( $f ); $target_r->insert_fields_ordered( @new_fields ); } } $target_xml = $target_r->as_xml_record; $target_xml =~ s/^<\?.+?\?>$//mo; $target_xml =~ s/\n//sgo; $target_xml =~ s/>\s+