1 package OpenILS::Application::Cat::Utils;
2 use strict; use warnings;
3 use OpenILS::Utils::Fieldmapper;
6 use OpenSRF::Utils::SettingsParser;
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 );
18 $class = ref($class) || $class;
19 return bless( {}, $class );
23 # ---------------------------------------------------------------------------
24 # Converts an XML nodeset into a tree
26 my($class, $nodeset) = @_;
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 );
38 # ---------------------------------------------------------------------------
39 # Converts a tree into an xml nodeset
43 my($self, $node) = @_;
45 if((ref($node) eq "ARRAY")) {
46 $node = Fieldmapper::biblio::record_node->new($node);
49 return \@_nodelist unless $node;
51 if(!defined($node->parent_node)) {
55 push( @_nodelist, $node );
57 if( $node->children() ) {
59 for my $child (@{ $node->children() }) {
62 Fieldmapper::biblio::record_node->new($child);
64 if(!defined($child->parent_node)) {
65 $child->parent_node($node->intra_doc_id);
66 $child->ischanged(1); #just to be sure
69 $self->tree2nodeset( $child );
73 $node->children(undef);
77 # ---------------------------------------------------------------------------
78 # Walks a nodeset and checks for insert, update, and delete and makes
79 # appropriate db calls
82 my($self, $nodeset) = @_;
87 for my $index (0..$size) {
89 my $pos = $index + $offset;
90 my $node = $nodeset->[$index];
93 if($node->isdeleted()) {
95 return 0 unless _deletenode($node);
100 $node->intra_doc_id($pos);
101 return 0 unless _addnode($node);
105 if( ($node->intra_doc_id()
106 and $node->intra_doc_id() != $pos) ||
107 $node->ischanged() ) {
109 $node->intra_doc_id($pos);
110 return 0 unless _updatenode($node);
117 # send deletes, updates, then adds
134 # ---------------------------------------------------------------------------
137 # ---------------------------------------------------------------------------
138 # Utility method for turning a nodes_array ($nodelist->nodelist) into
140 # ---------------------------------------------------------------------------
141 sub _nodeset_to_perl {
142 my($self, $nodeset) = @_;
143 return undef unless ($nodeset);
145 OpenILS::Utils::FlatXML->new()->nodeset_to_xml( $nodeset );
147 # Evil, but for some reason necessary
148 $xmldoc = XML::LibXML->new()->parse_string( $xmldoc->toString() );
149 return $self->marcxml_doc_to_mods_perl($xmldoc);
153 # ---------------------------------------------------------------------------
154 # Initializes a MARC -> Unified MODS batch process
155 # ---------------------------------------------------------------------------
156 sub start_mods_batch {
157 my( $self, $master_doc ) = @_;
158 $self->{master_doc} = $self->_nodeset_to_perl( $master_doc->nodeset );
161 # ---------------------------------------------------------------------------
162 # Completes a MARC -> Unified MODS batch process and returns the perl hash
163 # ---------------------------------------------------------------------------
164 sub finish_mods_batch {
166 my $perl = $self->{master_doc};
167 $self->{master_doc} = undef;
171 # ---------------------------------------------------------------------------
172 # Pushes a marcxml nodeset into the current MODS batch
173 # ---------------------------------------------------------------------------
174 sub mods_push_nodeset {
175 my( $self, $nodeset ) = @_;
176 my $xmlperl = $self->_nodeset_to_perl( $nodeset->nodeset );
177 for my $subject( @{$xmlperl->{subject}} ) {
178 push @{$self->{master_doc}->{subject}}, $subject;
184 # ---------------------------------------------------------------------------
185 # Transforms a MARC21SLIM XML document into a MODS formatted perl hash
186 # ---------------------------------------------------------------------------
187 sub marcxml_doc_to_mods_perl {
188 my( $self, $marcxml_doc ) = @_;
189 my $mods = $mods_sheet->transform($marcxml_doc);
190 my $perl = OpenSRF::Utils::SettingsParser::XML2perl( $mods->documentElement );
191 return $perl->{mods} if $perl;
197 # ---------------------------------------------------------------------------
198 # Transforms a set of marcxml nodesets into a unified MODS perl hash. The
199 # first doc is assumed to be the 'master'
200 # ---------------------------------------------------------------------------
201 sub marcxml_nodeset_list_to_mods_perl {
202 my( $self, $nodeset_list ) = @_;
203 my $master = $self->_nodeset_to_perl( shift(@$nodeset_list) );
205 for my $nodes (@$nodeset_list) {
206 my $xmlperl = $self->_nodeset_to_perl( $nodes );
207 for my $subject( @{$xmlperl->{subject}} ) {
208 push @{$master->{subject}}, $subject;
216 # not really sure if we'll ever need this one...
217 sub marcxml_doc_to_mods_nodeset {
218 my( $self, $marcxml_doc ) = @_;
219 my $mods = $mods_sheet->transform($marcxml_doc);
220 my $u = OpenILS::Utils::FlatXML->new();
221 my $nodeset = $u->xmldoc_to_nodeset( $mods );
222 return $nodeset->nodeset if $nodeset;