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 use OpenILS::Utils::FlatXML;
   8
   9
  10 my $parser              = XML::LibXML->new();
  11 my $xslt                        = XML::LibXSLT->new();
  12 my $xslt_doc    =       $parser->parse_file( "/pines/cvs/ILS/Open-ILS/xsl/MARC21slim2MODS.xsl" );
  13 my $mods_sheet = $xslt->parse_stylesheet( $xslt_doc );
  14
  15
  16
  17 sub new {
  18         my($class) = @_;
  19         $class = ref($class) || $class;
  20         return bless( {}, $class );
  21 }
  22
  23
  24 # ---------------------------------------------------------------------------
  25 # Converts an XML nodeset into a tree
  26 # This method expects a blessed Fieldmapper::biblio::record_node object
  27 sub nodeset2tree {
  28         my($class, $nodeset) = @_;
  29
  30         #       my $x = 0;
  31         for my $child (@$nodeset) {
  32                 next unless ($child and defined($child->parent_node));
  33                 my $parent = $nodeset->[$child->parent_node];
  34                 if( ! $parent ) {
  35                         warn "No Parent For " . $child->intra_doc_id() . "\n";
  36                 }
  37                 $parent->children([]) unless defined($parent->children);
  38                 $child->isnew(0);
  39                 $child->isdeleted(0);
  40                 #$child->intra_doc_id($x++);
  41                 push( @{$parent->children}, $child );
  42         }
  43
  44         return $nodeset->[0];
  45 }
  46
  47
  48 # ---------------------------------------------------------------------------
  49 # Converts a tree into an xml nodeset
  50 # This method expects a blessed Fieldmapper::biblio::record_node object
  51
  52 sub tree2nodeset {
  53         my($self, $node, $newnodes) = @_;
  54
  55         return $newnodes unless $node;
  56
  57         if(!$newnodes) { $newnodes = []; }
  58
  59         push( @$newnodes, $node );
  60
  61         if( $node->children() ) {
  62
  63                 for my $child (@{ $node->children() }) {
  64
  65                         new Fieldmapper::biblio::record_node ($child);
  66
  67                         if(!defined($child->parent_node)) {
  68                                 $child->parent_node($node->intra_doc_id);
  69                                 $child->ischanged(1); #just to be sure
  70                         }
  71
  72                         $self->tree2nodeset( $child, $newnodes );
  73                 }
  74         }
  75
  76         $node->children([]); #we don't need them hanging around
  77         return $newnodes;
  78 }
  79
  80 sub update_children_parents {
  81         my($self, $node)  = @_;
  82         if( $node->children ) {
  83                 for my $child( @{$node->children()} ) {
  84                         $child->parent_node( $node->intra_doc_id() );
  85                 }
  86         }
  87 }
  88
  89
  90 sub clean_nodeset {
  91
  92         my($self, $nodeset) = @_;
  93         my @newnodes = ();
  94         for my $node (@$nodeset) {
  95                 if(!$node->isdeleted() ) {
  96                         push @newnodes, $node;
  97                 }
  98         }
  99
 100         return \@newnodes;
 101 }
 102
 103
 104 # ---------------------------------------------------------------------------
 105 # Walks a nodeset and checks for insert, update, and delete and makes
 106 # appropriate db calls
 107 # This method expects a blessed Fieldmapper::biblio::record_node object
 108 =head comment
 109 sub clean_nodeset {
 110         my($self, $nodeset) = @_;
 111
 112         my @_deleted = ();
 113 #my @_added = ();
 114 #       my @_altered = ();
 115
 116         my $size = @$nodeset;
 117         my $offset = 0;
 118 #       my $doc_id = undef;
 119
 120         for my $index (0..$size) {
 121
 122                 my $pos = $index + $offset;
 123                 my $node = $nodeset->[$index];
 124                 next unless $node;
 125
 126 #       if( !defined($doc_id) ) {
 127 #                       $doc_id = $node->owner_doc;
 128 #               }
 129
 130                 if($node->isdeleted()) {
 131                         $offset--;
 132                         warn "Deleting Node " . $node->intra_doc_id() . "\n";
 133                         push @_deleted, $node;
 134                         next;
 135                 }
 136         }
 137
 138 }
 139
 140                 if($node->isnew()) {
 141                         $node->intra_doc_id($pos);
 142                         warn "Adding Node $pos\n";
 143                         $node->owner_doc($doc_id);
 144                         $node->clear_id();
 145                         push @_added, $node;
 146                         next;
 147                 }
 148
 149                 if(     ($node->intra_doc_id()
 150                                 and $node->intra_doc_id() != $pos) ||
 151                          $node->ischanged() ) {
 152
 153                         warn "Updating Node " . $node->intra_doc_id() . " to $pos\n";
 154
 155                         $node->intra_doc_id($pos);
 156                         $self->update_children_parents( $node );
 157                         push @_altered, $node;
 158                         next;
 159                 }
 160
 161
 162         my $d;
 163         my $al;
 164         my $added_stuff;
 165         my $status;
 166
 167         warn "Building db session\n";
 168         my $session = $self->start_db_session();
 169
 170         my $szz = @_deleted;
 171         warn "Deleting $szz\n";
 172
 173         if(@_deleted) {
 174                 warn "Sending deletes to db\n";
 175                 my $del_req = $session->request(
 176                                 "open-ils.storage.biblio.record_node.batch.delete", @_deleted );
 177                 $status = $del_req->recv();
 178                 if(ref($status) and $status->isa("Error")) {
 179                         warn " +++++++ Node Delete Failed in Cat";
 180                         throw $status ("Node Delete Failed in Cat") ;
 181                 }
 182                 warn "Delete Successful\n";
 183                 $d = $status->content();
 184         }
 185
 186         $szz = @_altered;
 187         warn "Updating $szz\n";
 188
 189         if( @_altered ) {
 190                 warn "Sending updates to db\n";
 191                 @_altered = sort { $a->id <=> $b->id } @_altered;
 192                 my $alt_req = $session->request(
 193                         "open-ils.storage.biblio.record_node.batch.update", @_altered );
 194                 $status = $alt_req->recv();
 195                 if(ref($status) and $status->isa("Error")) {
 196                         warn " +++++++ Node Update Failed in Cat";
 197                         throw $status ("Node Update Failed in Cat");
 198                 }
 199                 warn "Update Successful\n";
 200                 $al = $status->content();
 201         }
 202
 203         $szz = @_added;
 204         warn "Adding $szz\n";
 205
 206         if(@_added) {
 207                 warn "Sending adds to db\n";
 208                 my $add_req = $session->request(
 209                                 "open-ils.storage.biblio.record_node.batch.create", @_added );
 210                 $status = $add_req->recv();
 211                 if(ref($status) and $status->isa("Error")) {
 212                         warn " +++++++ Node Create Failed in Cat";
 213                         throw $status ("Node Create Failed in Cat");
 214                 }
 215                 $added_stuff = $status->content();
 216                 warn "Add successful\n";
 217         }
 218
 219         warn "done updating records\n";
 220         $self->commit_db_session( $session );
 221
 222         my $hash = { added => $added_stuff, deleted => $d, updated =>  $al };
 223         use Data::Dumper;
 224         warn Dumper $hash;
 225
 226         return $hash;
 227 }
 228 =cut
 229
 230 # on sucess, returns the created session, on failure throws ERROR exception
 231 sub start_db_session {
 232         my $self = shift;
 233         my $session = OpenSRF::AppSession->connect( "open-ils.storage" );
 234         my $trans_req = $session->request( "open-ils.storage.transaction.begin" );
 235         my $trans_resp = $trans_req->recv();
 236         if(ref($trans_resp) and $trans_resp->isa("Error")) { throw $trans_resp; }
 237         if( ! $trans_resp->content() ) {
 238                 throw OpenSRF::ERROR ("Unable to Begin Transaction with database" );
 239         }
 240         $trans_req->finish();
 241         return $session;
 242 }
 243
 244 # commits and destroys the session
 245 sub commit_db_session {
 246         my( $self, $session ) = @_;
 247
 248         my $req = $session->request( "open-ils.storage.transaction.commit" );
 249         my $resp = $req->recv();
 250         if(ref($resp) and $resp->isa("Error")) { throw $resp; }
 251
 252         $session->finish();
 253         $session->disconnect();
 254         $session->kill_me();
 255 }
 256
 257
 258 sub mods_perl_to_mods_slim {
 259         my( $self, $modsperl ) = @_;
 260
 261         use Data::Dumper;
 262         warn Dumper $modsperl;
 263
 264         my $title = $modsperl->{titleInfo}->{title};
 265         my $author      = $modsperl->{name}->{namePart};
 266         if(ref($author) eq "ARRAY") {
 267                 $author = $author->[0];
 268         }
 269
 270         return { "title" => $title, "author" => $author };
 271
 272 }
 273
 274
 275
 276 # ---------------------------------------------------------------------------
 277 # Utility method for turning a nodes_array ($nodelist->nodelist) into
 278 # a perl structure
 279 # ---------------------------------------------------------------------------
 280 sub _nodeset_to_perl {
 281         my($self, $nodeset) = @_;
 282         return undef unless ($nodeset);
 283         my $xmldoc =
 284                 OpenILS::Utils::FlatXML->new()->nodeset_to_xml($nodeset);
 285
 286         # Evil, but for some reason necessary
 287         $xmldoc = $parser->parse_string( $xmldoc->toString() );
 288         my $perl = $self->marcxml_doc_to_mods_perl($xmldoc);
 289         return $perl;
 290 }
 291
 292
 293 # ---------------------------------------------------------------------------
 294 # Initializes a MARC -> Unified MODS batch process
 295 # ---------------------------------------------------------------------------
 296 sub start_mods_batch {
 297         my( $self, $master_doc ) = @_;
 298         $self->{master_doc} = $self->_nodeset_to_perl( $master_doc );
 299 }
 300
 301 # ---------------------------------------------------------------------------
 302 # Completes a MARC -> Unified MODS batch process and returns the perl hash
 303 # ---------------------------------------------------------------------------
 304 sub finish_mods_batch {
 305         my $self = shift;
 306         my $perl = $self->{master_doc};
 307         $self->{master_doc} = undef;
 308         return $perl
 309 }
 310
 311 # ---------------------------------------------------------------------------
 312 # Pushes a marcxml nodeset into the current MODS batch
 313 # ---------------------------------------------------------------------------
 314 sub mods_push_nodeset {
 315         my( $self, $nodeset ) = @_;
 316         my $xmlperl     = $self->_nodeset_to_perl( $nodeset );
 317         for my $subject( @{$xmlperl->{subject}} ) {
 318                 push @{$self->{master_doc}->{subject}}, $subject;
 319         }
 320 }
 321
 322
 323
 324 # ---------------------------------------------------------------------------
 325 # Transforms a MARC21SLIM XML document into a MODS formatted perl hash
 326 # ---------------------------------------------------------------------------
 327 sub marcxml_doc_to_mods_perl {
 328         my( $self, $marcxml_doc ) = @_;
 329         my $mods = $mods_sheet->transform($marcxml_doc);
 330         my $perl = OpenSRF::Utils::SettingsParser::XML2perl( $mods->documentElement );
 331         return $perl->{mods} if exists($perl->{mods});
 332         return $perl;
 333 }
 334
 335
 336
 337 # ---------------------------------------------------------------------------
 338 # Transforms a set of marcxml nodesets into a unified MODS perl hash.  The
 339 # first doc is assumed to be the 'master'
 340 # ---------------------------------------------------------------------------
 341 sub marcxml_nodeset_list_to_mods_perl {
 342         my( $self, $nodeset_list ) = @_;
 343         my $master = $self->_nodeset_to_perl( shift(@$nodeset_list) );
 344         my $first;
 345         for my $nodes (@$nodeset_list) {
 346                 my $xmlperl     = $self->_nodeset_to_perl( $nodes );
 347                 for my $subject( @{$xmlperl->{subject}} ) {
 348                         push @{$master->{subject}}, $subject;
 349                 }
 350         }
 351         return $master;
 352 }
 353
 354
 355
 356 # not really sure if we'll ever need this one...
 357 sub marcxml_doc_to_mods_nodeset {
 358         my( $self, $marcxml_doc ) = @_;
 359         my $mods = $mods_sheet->transform($marcxml_doc);
 360         my $u = OpenILS::Utils::FlatXML->new();
 361         my $nodeset = $u->xmldoc_to_nodeset( $mods );
 362         return $nodeset->nodeset if $nodeset;
 363         return undef;
 364 }
 365
 366
 367
 368
 369
 370
 371
 372 1;