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

   1 package OpenILS::Application::Cat::Utils;
   2 use strict; use warnings;
   3 use OpenILS::Utils::Fieldmapper;
   4 use XML::LibXML;
   5 use XML::LibXSLT;
   6 use OpenSRF::Utils::SettingsParser;
   7
   8
   9 my $parser              = XML::LibXML->new();
  10 my $xslt                        = XML::LibXSLT->new();
  11 my $xslt_doc    =       $parser->parse_file( "/pines/cvs/ILS/Open-ILS/xsl/MARC21slim2MODS.xsl" );
  12 my $mods_sheet = $xslt->parse_stylesheet( $xslt_doc );
  13
  14
  15
  16 sub new {
  17         my($class) = @_;
  18         $class = ref($class) || $class;
  19         return bless( {}, $class );
  20 }
  21
  22
  23 # ---------------------------------------------------------------------------
  24 # Converts an XML nodeset into a tree
  25 # This method expects a blessed Fieldmapper::biblio::record_node object
  26 sub nodeset2tree {
  27         my($class, $nodeset) = @_;
  28
  29         for my $child (@$nodeset) {
  30                 next unless ($child and defined($child->parent_node));
  31                 my $parent = $nodeset->[$child->parent_node];
  32                 $parent->children([]) unless defined($parent->children);
  33                 $child->isnew(0);
  34                 $child->isdeleted(0);
  35                 push( @{$parent->children}, $child );
  36         }
  37
  38         return $nodeset->[0];
  39 }
  40
  41 # ---------------------------------------------------------------------------
  42 # Converts a tree into an xml nodeset
  43 # This method expects a blessed Fieldmapper::biblio::record_node object
  44
  45 sub tree2nodeset {
  46         my($self, $node, $newnodes) = @_;
  47
  48         return $newnodes unless $node;
  49
  50         if(!$newnodes) { $newnodes = []; }
  51
  52         push( @$newnodes, $node );
  53
  54         if( $node->children() ) {
  55
  56                 for my $child (@{ $node->children() }) {
  57
  58                         new Fieldmapper::biblio::record_node ($child);
  59
  60                         if(!defined($child->parent_node)) {
  61                                 $child->parent_node($node->intra_doc_id);
  62                                 $child->ischanged(1); #just to be sure
  63                         }
  64
  65                         $self->tree2nodeset( $child, $newnodes );
  66                 }
  67         }
  68
  69         $node->children([]); #we don't need them hanging around
  70         return $newnodes;
  71 }
  72
  73 # ---------------------------------------------------------------------------
  74 # Walks a nodeset and checks for insert, update, and delete and makes
  75 # appropriate db calls
  76 # This method expects a blessed Fieldmapper::biblio::record_node object
  77 sub commit_nodeset {
  78         my($self, $nodeset) = @_;
  79
  80         my @_deleted = ();
  81         my @_added = ();
  82         my @_altered = ();
  83
  84         my $size = @$nodeset;
  85         my $offset = 0;
  86
  87
  88         for my $index (0..$size) {
  89
  90
  91                 my $pos = $index + $offset;
  92                 my $node = $nodeset->[$index];
  93                 next unless $node;
  94
  95
  96                 if($node->isdeleted()) {
  97                         $offset--;
  98                         warn "Deleting Node " . $node->intra_doc_id() . "\n";
  99                         push @_deleted, $node;
 100                         next;
 101                 }
 102
 103                 if($node->isnew()) {
 104                         $node->intra_doc_id($pos);
 105                         warn "Adding Node $pos\n";
 106                         push @_added, $node;
 107                         next;
 108                 }
 109
 110                 if(     ($node->intra_doc_id()
 111                                 and $node->intra_doc_id() != $pos) ||
 112                          $node->ischanged() ) {
 113
 114                         warn "Updating Node " . $node->intra_doc_id() . " to $pos\n";
 115
 116                         $node->intra_doc_id($pos);
 117                         push @_altered, $node;
 118                         next;
 119                 }
 120         }
 121
 122         my $d = @_deleted;
 123         my $al = @_altered;
 124         my $a = @_added;
 125
 126         # iterate through each list and send updates to the db
 127
 128         my $hash = { added => $a, deleted => $d, updated =>  $al };
 129         return $hash;
 130 }
 131
 132
 133
 134 # ---------------------------------------------------------------------------
 135 # Utility method for turning a nodes_array ($nodelist->nodelist) into
 136 # a perl structure
 137 # ---------------------------------------------------------------------------
 138 sub _nodeset_to_perl {
 139         my($self, $nodeset) = @_;
 140         return undef unless ($nodeset);
 141         my $xmldoc =
 142                 OpenILS::Utils::FlatXML->new()->nodeset_to_xml( $nodeset );
 143
 144         # Evil, but for some reason necessary
 145         $xmldoc = $parser->parse_string( $xmldoc->toString() );
 146         return $self->marcxml_doc_to_mods_perl($xmldoc);
 147 }
 148
 149
 150 # ---------------------------------------------------------------------------
 151 # Initializes a MARC -> Unified MODS batch process
 152 # ---------------------------------------------------------------------------
 153 sub start_mods_batch {
 154         my( $self, $master_doc ) = @_;
 155         $self->{master_doc} = $self->_nodeset_to_perl( $master_doc->nodeset );
 156 }
 157
 158 # ---------------------------------------------------------------------------
 159 # Completes a MARC -> Unified MODS batch process and returns the perl hash
 160 # ---------------------------------------------------------------------------
 161 sub finish_mods_batch {
 162         my $self = shift;
 163         my $perl = $self->{master_doc};
 164         $self->{master_doc} = undef;
 165         return $perl
 166 }
 167
 168 # ---------------------------------------------------------------------------
 169 # Pushes a marcxml nodeset into the current MODS batch
 170 # ---------------------------------------------------------------------------
 171 sub mods_push_nodeset {
 172         my( $self, $nodeset ) = @_;
 173         my $xmlperl     = $self->_nodeset_to_perl( $nodeset->nodeset );
 174         for my $subject( @{$xmlperl->{subject}} ) {
 175                 push @{$self->{master_doc}->{subject}}, $subject;
 176         }
 177 }
 178
 179
 180
 181 # ---------------------------------------------------------------------------
 182 # Transforms a MARC21SLIM XML document into a MODS formatted perl hash
 183 # ---------------------------------------------------------------------------
 184 sub marcxml_doc_to_mods_perl {
 185         my( $self, $marcxml_doc ) = @_;
 186         my $mods = $mods_sheet->transform($marcxml_doc);
 187         my $perl = OpenSRF::Utils::SettingsParser::XML2perl( $mods->documentElement );
 188         return $perl->{mods} if $perl;
 189         return undef;
 190 }
 191
 192
 193
 194 # ---------------------------------------------------------------------------
 195 # Transforms a set of marcxml nodesets into a unified MODS perl hash.  The
 196 # first doc is assumed to be the 'master'
 197 # ---------------------------------------------------------------------------
 198 sub marcxml_nodeset_list_to_mods_perl {
 199         my( $self, $nodeset_list ) = @_;
 200         my $master = $self->_nodeset_to_perl( shift(@$nodeset_list) );
 201         my $first;
 202         for my $nodes (@$nodeset_list) {
 203                 my $xmlperl     = $self->_nodeset_to_perl( $nodes );
 204                 for my $subject( @{$xmlperl->{subject}} ) {
 205                         push @{$master->{subject}}, $subject;
 206                 }
 207         }
 208         return $master;
 209 }
 210
 211
 212
 213 # not really sure if we'll ever need this one...
 214 sub marcxml_doc_to_mods_nodeset {
 215         my( $self, $marcxml_doc ) = @_;
 216         my $mods = $mods_sheet->transform($marcxml_doc);
 217         my $u = OpenILS::Utils::FlatXML->new();
 218         my $nodeset = $u->xmldoc_to_nodeset( $mods );
 219         return $nodeset->nodeset if $nodeset;
 220         return undef;
 221 }
 222
 223
 224
 225
 226
 227
 228
 229 1;