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