Open-ILS/src/perlmods/OpenILS/Application/Cat/Utils.pm

   1 package OpenILS::Application::Cat::Utils;
   2 use strict; use warnings;
   3 use OpenILS::Application::AppUtils;
   4 use OpenILS::Utils::Fieldmapper;
   5 use XML::LibXML;
   6 use XML::LibXSLT;
   7 use OpenSRF::Utils::SettingsParser;
   8 use OpenILS::Utils::FlatXML;
   9 use OpenILS::Application::WORM;
  10
  11 my $utils = OpenILS::Application::Cat::Utils->new();
  12
  13 my $parser              = XML::LibXML->new();
  14 my $xslt                        = XML::LibXSLT->new();
  15 my $xslt_doc    = $parser->parse_file( "/pines/cvs/ILS/Open-ILS/xsl/MARC21slim2MODS.xsl" );
  16 my $mods_sheet = $xslt->parse_stylesheet( $xslt_doc );
  17
  18 my $isbn_xpath                  = "//mods:mods/mods:identifier[\@type='isbn']";
  19
  20 my $resource_xpath      = "//mods:mods/mods:typeOfResource";
  21
  22 my $pub_xpath                   = "//mods:mods/mods:originInfo//mods:dateIssued[\@encoding='marc']|" .
  23                                                                 "//mods:mods/mods:originInfo//mods:dateIssued[1]";
  24
  25 my $tcn_xpath                   = "//mods:mods/mods:recordInfo/mods:recordIdentifier";
  26 my $publisher_xpath     = "//mods:mods/mods:originInfo//mods:publisher[1]";
  27
  28
  29 sub new {
  30         my($class) = @_;
  31         $class = ref($class) || $class;
  32         return bless( {}, $class );
  33 }
  34
  35
  36 # ---------------------------------------------------------------------------
  37 # Converts an XML nodeset into a tree
  38 # This method expects a blessed Fieldmapper::biblio::record_node object
  39 sub nodeset2tree {
  40         my($class, $nodeset) = @_;
  41
  42         for my $child (@$nodeset) {
  43                 next unless ($child and defined($child->parent_node));
  44                 my $parent = $nodeset->[$child->parent_node];
  45                 if( ! $parent ) {
  46                         warn "No Parent For " . $child->intra_doc_id() . "\n";
  47                 }
  48                 $parent->children([]) unless defined($parent->children);
  49                 $child->isnew(0);
  50                 $child->isdeleted(0);
  51                 push( @{$parent->children}, $child );
  52         }
  53
  54         return $nodeset->[0];
  55 }
  56
  57
  58 # ---------------------------------------------------------------------------
  59 # Converts a tree into an xml nodeset
  60 # This method expects a blessed Fieldmapper::biblio::record_node object
  61
  62 sub tree2nodeset {
  63
  64         my($self, $node, $newnodes) = @_;
  65         return $newnodes unless $node;
  66
  67         if(!$newnodes) { $newnodes = []; }
  68         push( @$newnodes, $node );
  69
  70         if( $node->children() ) {
  71
  72                 for my $child (@{ $node->children() }) {
  73
  74                         new Fieldmapper::biblio::record_node ($child);
  75                         if(!defined($child->parent_node)) {
  76                                 $child->parent_node($node->intra_doc_id);
  77                                 $child->ischanged(1); #just to be sure
  78                         }
  79                         $self->tree2nodeset( $child, $newnodes );
  80                 }
  81         }
  82
  83         $node->children([]); #we don't need them hanging around
  84         return $newnodes;
  85 }
  86
  87
  88 # Removes any deleted nodes from the tree
  89 sub clean_nodeset {
  90
  91         my($self, $nodeset) = @_;
  92         my @newnodes = ();
  93         for my $node (@$nodeset) {
  94                 if(!$node->isdeleted() ) {
  95                         push @newnodes, $node;
  96                 }
  97         }
  98
  99         return \@newnodes;
 100 }
 101
 102
 103
 104
 105 # ---------------------------------------------------------------------------
 106 # Grabs the data 'we want' from the MODS doc and returns it in hash form
 107 # ---------------------------------------------------------------------------
 108 sub mods_values_to_mods_slim {
 109         my( $self, $modsperl ) = @_;
 110
 111         my $title = "";
 112         my $author = "";
 113         my $subject = [];
 114
 115         my $tmp = $modsperl->{title};
 116
 117         if(!$tmp) { $title = ""; }
 118         else {
 119                 ($title = $tmp->{proper}) ||
 120                 ($title = $tmp->{translated}) ||
 121                 ($title = $tmp->{abbreviated}) ||
 122                 ($title = $tmp->{uniform});
 123         }
 124
 125         $tmp = $modsperl->{author};
 126         if(!$tmp) { $author = ""; }
 127         else {
 128                 ($author = $tmp->{personal}) ||
 129                 ($author = $tmp->{other}) ||
 130                 ($author = $tmp->{corporate}) ||
 131                 ($author = $tmp->{conference});
 132         }
 133
 134         $tmp = $modsperl->{subject};
 135         if(!$tmp) { $subject = []; }
 136         else {
 137                 for my $key( keys %{$tmp}) {
 138                         push(@$subject, $tmp->{$key}) if $tmp->{$key};
 139                 }
 140         }
 141
 142         return { title => $title, author => $author, subject => $subject };
 143
 144 }
 145
 146 sub _marcxml_to_perl {
 147         my($self, $marcxml) = @_;
 148         my $xmldoc = $parser->parse_string( $marcxml );
 149         my $mods = $mods_sheet->transform($xmldoc);
 150         my $perl = OpenSRF::Utils::SettingsParser::XML2perl( $mods->documentElement );
 151         return $perl->{mods} if exists($perl->{mods});
 152         return $perl;
 153 }
 154
 155
 156 # ---------------------------------------------------------------------------
 157 # Initializes a MARC -> Unified MODS batch process
 158 # ---------------------------------------------------------------------------
 159
 160 sub start_mods_batch {
 161
 162         my( $self, $master_doc ) = @_;
 163         if(!ref($self)) {
 164                 $self = new OpenILS::Application::Cat::Utils;
 165         }
 166
 167         my $xmldoc = $parser->parse_string($master_doc);
 168         my $mods = $mods_sheet->transform($xmldoc);
 169
 170         $self->{master_doc} = OpenILS::Application::WORM->modsdoc_to_values( $mods );
 171         $self->{master_doc} = $utils->mods_values_to_mods_slim( $self->{master_doc} );
 172
 173         $self->{master_doc}->{isbn} =
 174                 OpenILS::Application::WORM::_get_field_value( $mods, $isbn_xpath );
 175
 176         $self->{master_doc}->{type_of_resource} =
 177                 [ OpenILS::Application::WORM::_get_field_value( $mods, $resource_xpath ) ];
 178
 179         $self->{master_doc}->{tcn} =
 180                 OpenILS::Application::WORM::_get_field_value( $mods, $tcn_xpath );
 181
 182         $self->{master_doc}->{pubdate} =
 183                 OpenILS::Application::WORM::_get_field_value( $mods, $pub_xpath );
 184
 185         $self->{master_doc}->{publisher} =
 186                 OpenILS::Application::WORM::_get_field_value( $mods, $publisher_xpath );
 187
 188 }
 189
 190 # ---------------------------------------------------------------------------
 191 # Takes a MARCXML string and adds it to the growing MODS doc
 192 # ---------------------------------------------------------------------------
 193 sub push_mods_batch {
 194         my( $self, $marcxml ) = @_;
 195
 196         my $xmldoc = $parser->parse_string($marcxml);
 197         my $mods = $mods_sheet->transform($xmldoc);
 198
 199         my $xmlperl = OpenILS::Application::WORM->modsdoc_to_values( $mods );
 200         $xmlperl = $utils->mods_values_to_mods_slim( $xmlperl );
 201
 202         for my $subject( @{$xmlperl->{subject}} ) {
 203                 push @{$self->{master_doc}->{subject}}, $subject;
 204         }
 205
 206         push( @{$self->{master_doc}->{type_of_resource}},
 207                 OpenILS::Application::WORM::_get_field_value( $mods, $resource_xpath ));
 208
 209         if(!($self->{master_doc}->{isbn}) ) {
 210                 $self->{master_doc}->{isbn} =
 211                         OpenILS::Application::WORM::_get_field_value( $mods, $isbn_xpath );
 212         }
 213 }
 214
 215
 216 # ---------------------------------------------------------------------------
 217 # Completes a MARC -> Unified MODS batch process and returns the perl hash
 218 # ---------------------------------------------------------------------------
 219 sub finish_mods_batch {
 220         my $self = shift;
 221         my $perl = $self->{master_doc};
 222         $self->{master_doc} = undef;
 223         return $perl
 224 }
 225
 226
 227 1;