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
  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 # Converts an XML nodeset into a tree
  17 sub nodeset2tree {
  18         my($class, $nodeset) = @_;
  19
  20         for my $child (@$nodeset) {
  21                 next unless ($child and defined($child->parent_node));
  22                 my $parent = $nodeset->[$child->parent_node];
  23                 $parent->children([]) unless defined($parent->children);
  24                 push( @{$parent->children}, $child );
  25         }
  26
  27         return $nodeset->[0];
  28 }
  29
  30 # ---------------------------------------------------------------------------
  31 # Converts a tree into an xml nodeset
  32
  33 my @_nodelist = ();
  34 sub tree2nodeset {
  35         my($self, $node) = @_;
  36
  37         if((ref($node) eq "ARRAY")) {
  38                 $node = Fieldmapper::biblio::record_node->new($node);
  39         }
  40
  41         return \@_nodelist unless $node;
  42
  43         if(!defined($node->parent_node)) {
  44                 @_nodelist = ();
  45         }
  46
  47         push( @_nodelist, $node );
  48
  49         if( $node->children() ) {
  50
  51                 for my $child (@{ $node->children() }) {
  52
  53                         $child =
  54                                 Fieldmapper::biblio::record_node->new($child);
  55
  56                         if(!defined($child->parent_node)) {
  57                                 $child->parent_node($node->intra_doc_id);
  58                                 $child->ischanged(1); #just to be sure
  59                         }
  60
  61                         $self->tree2nodeset( $child );
  62                 }
  63         }
  64
  65         $node->children(undef);
  66         return \@_nodelist;
  67 }
  68
  69 # ---------------------------------------------------------------------------
  70 # Walks a nodeset and checks for insert, update, and delete and makes
  71 # appropriate db calls
  72
  73 sub commit_nodeset {
  74         my($self, $nodeset) = @_;
  75
  76         my $size = @$nodeset;
  77         my $offset = 0;
  78
  79         for my $index (0..$size) {
  80
  81                 my $pos = $index + $offset;
  82                 my $node = $nodeset->[$index];
  83                 next unless $node;
  84
  85                 if($node->isdeleted()) {
  86                         $offset--;
  87                         return 0 unless _deletenode($node);
  88                         next;
  89                 }
  90
  91                 if($node->isnew()) {
  92                         $node->intra_doc_id($pos);
  93                         return 0 unless _addnode($node);
  94                         next;
  95                 }
  96
  97                 if(     ($node->intra_doc_id()
  98                                 and $node->intra_doc_id() != $pos) ||
  99                          $node->ischanged() ) {
 100
 101                         $node->intra_doc_id($pos);
 102                         return 0 unless _updatenode($node);
 103                         next;
 104                 }
 105         }
 106         return 1;
 107 }
 108
 109 # send deletes, updates, then adds
 110
 111 sub _updatenode {
 112         my $node = shift;
 113         return 1;
 114 }
 115
 116 sub _addnode {
 117         my $node = shift;
 118         return 1;
 119 }
 120
 121 sub _deletenode {
 122         my $node = shift;
 123         return 1;
 124 }
 125
 126 # ---------------------------------------------------------------------------
 127
 128
 129 sub marcxml_doc_to_perl {
 130         my( $self, $marcxml_doc ) = @_;
 131         return undef unless $marcxml_doc;
 132         return OpenSRF::Utils::SettingsParser::XML2perl( $marcxml_doc->documentElement );
 133 }
 134
 135
 136 sub marcxml_doc_to_mods_perl {
 137         my( $self, $marcxml_doc ) = @_;
 138
 139         print  "DOC:\n" . $marcxml_doc->toString(1) . "\n";
 140         my $mods = $mods_sheet->transform($marcxml_doc);
 141         print "MODS:\n " . $mods->toString(1). "\n";
 142         print "-------------------------------------------\n";
 143
 144         my $perl = OpenSRF::Utils::SettingsParser::XML2perl( $mods->documentElement );
 145         return $perl->{mods} if $perl;
 146         return undef;
 147 }
 148
 149 sub marcxml_nodeset_to_doc {
 150         my( $self, $nodes ) = @_;
 151         my $u = OpenILS::Utils::FlatXML->new();
 152         return $u->nodeset_to_xml( $nodes );
 153 }
 154
 155 sub marcxml_doc_to_mods_nodeset {
 156         my( $self, $marcxml_doc ) = @_;
 157         my $mods = $mods_sheet->transform($marcxml_doc);
 158         my $u = OpenILS::Utils::FlatXML->new();
 159         my $nodeset = $u->xmldoc_to_nodeset( $mods );
 160         return $nodeset->nodeset if $nodeset;
 161         return undef;
 162 }
 163
 164
 165
 166
 167
 168
 169
 170 1;