source: gsdl/trunk/perllib/plugouts/FedoraMETSPlugout.pm@ 14970

Last change on this file since 14970 was 14970, checked in by davidb, 16 years ago

Changes made to generated files to support Fedora3 syntax
File size: 16.4 KB
RevLine 
[14927]1###########################################################################
2#
3# FedoraMETSPlugout.pm -- the plugout module for METS archives
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 2006 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# But WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26package FedoraMETSPlugout;
27
28use strict;
29no strict 'refs';
30
31#eval {require bytes};
32#use util;
33use METSPlugout;
34#use docprint; # for escape_text
35
36sub BEGIN {
37 @FedoraMETSPlugout::ISA = ('METSPlugout');
38}
39
40my $arguments = [
41 { 'name' => "fedora_namespace",
42 'desc' => "{FedoraPlugout.fedora_namespace}",
43 'type' => "string",
44 'deft' => "greenstone",
45 'reqd' => "no",
46 'hiddengli' => "no"}
47 ];
48
49
50
51my $options = { 'name' => "FedoraMETSPlugout",
52 'desc' => "{FedoraMETSPlugout.desc}",
53 'abstract' => "no",
54 'inherits' => "yes",
55 'args' => $arguments
56 };
57
58
59sub new
60{
61 my ($class) = shift (@_);
62 my ($plugoutlist, $inputargs,$hashArgOptLists) = @_;
63 push(@$plugoutlist, $class);
64
65
66 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
67 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
68
69 my $self = (defined $hashArgOptLists)? new METSPlugout($plugoutlist,$inputargs,$hashArgOptLists): new METSPlugout($plugoutlist,$inputargs);
70
71
72 return bless $self, $class;
73}
74
75
76sub output_mets_xml_header
77{
78 my $self = shift(@_);
79 my ($handle, $OID, $doc_title) = @_;
80
81 my $fnamespace = $self->{'fedora_namespace'};
82 my $oid_namespace = (defined $fnamespace) ? $fnamespace : "test";
83
84 my $collection = $ENV{'GSDLCOLLECTION'};
85
[14970]86 # Might need the following in the schemeLocation attribute for Fedora3
87 # http://www.fedora.info/definitions/1/0/mets-fedora-ext1-1.xsd
[14927]88
[14970]89 my $extra_attr = "OBJID=\"$oid_namespace:$collection-$OID\" TYPE=\"FedoraObject\" LABEL=\"$doc_title\" EXT_VERSION=\"1.1\"";
90
[14927]91 $self->output_mets_xml_header_extra_attribute($handle,$extra_attr);
92
93 print $handle '<mets:metsHdr RECORDSTATUS="A"/>'. "\n"; # A = active
94
95}
96
97#
98# Print out "family" of doctxt.xml files
99#
100
101sub saveas_doctxt_section
102{
103 my $self = shift (@_);
104 my ($doc_obj,$working_dir,$section) = @_;
105
106 my $section_ptr=$doc_obj->_lookup_section($section);
107 return unless defined $section_ptr;
108
109 my $section_fnum ="1". $section;
110 $section_fnum =~ s/\./_/g;
111
112 my $doc_txt_file = &util::filename_cat ($working_dir,"doctxt$section_fnum.xml");
113
114 $self->open_xslt_pipe($doc_txt_file,$self->{'xslt_txt'});
115
116 my $outhandler;
117
118 if (defined $self->{'xslt_writer'}){
119 $outhandler = $self->{'xslt_writer'};
120 }
121 else{
122 $outhandler = $self->get_output_handler($doc_txt_file);
123 }
124
125 $self->output_xml_header($outhandler);
126 $self->output_txt_section($outhandler,$doc_obj, $section);
127 $self->output_xml_footer($outhandler);
128
129
130 if (defined $self->{'xslt_writer'}){
131 $self->close_xslt_pipe();
132 }
133 else{
134 close($outhandler);
135 }
136
137
138 # Output all the subsections as separate files
139 foreach my $subsection (@{$section_ptr->{'subsection_order'}}){
140
141 $self->saveas_doctxt_section($doc_obj, $working_dir, "$section.$subsection");
142 }
143
144
145}
146
147
148sub saveas_doctxt
149{
150 my $self = shift (@_);
151 my ($doc_obj,$working_dir) = @_;
152
153 my $section = $doc_obj->get_top_section();
154
155 $self->saveas_doctxt_section($doc_obj,$working_dir,$section);
156
157 $self->saveas_toc($doc_obj,$working_dir);
158}
159
160sub buffer_toc
161{
162 my $self = shift (@_);
163 my ($doc_obj,$working_dir,$section,$depth) = @_;
164
165 my $section_ptr=$doc_obj->_lookup_section($section);
166 return "" unless defined $section_ptr;
167
168 my $all_text = "";
169
170 my $section_num ="1". $section;
171 my $indent = " " x ($depth*2);
172
173 $all_text .= "$indent<Section id=\"$section_num\">\n";
174
175 # Output all the subsections as separate files
176 foreach my $subsection (@{$section_ptr->{'subsection_order'}})
177 {
178 $all_text
179 .= $self->buffer_toc($doc_obj, $working_dir,
180 "$section.$subsection",$depth+1);
181 }
182
183 $all_text .= "$indent</Section>\n";
184
185 return $all_text;
186}
187
188
189sub saveas_toc
190{
191 my $self = shift (@_);
192 my ($doc_obj,$working_dir) = @_;
193
194 my $section = $doc_obj->get_top_section();
195
196 my $doc_txt_file = &util::filename_cat ($working_dir,"doctoc.xml");
197
198 $self->open_xslt_pipe($doc_txt_file,$self->{'xslt_txt'});
199
200 my $outhandler;
201
202 if (defined $self->{'xslt_writer'}){
203 $outhandler = $self->{'xslt_writer'};
204 }
205 else{
206 $outhandler = $self->get_output_handler($doc_txt_file);
207 }
208
209 print $outhandler $self->buffer_toc($doc_obj, $working_dir, $section, 0);
210
211 if (defined $self->{'xslt_writer'}){
212 $self->close_xslt_pipe();
213 }
214 else{
215 close($outhandler);
216 }
217
218}
219
220
[14970]221sub buffer_mets_relsext_xml
222{
223 my $self = shift(@_);
224 my ($doc_obj) = @_;
225
226 my $OID = $doc_obj->get_OID();
227
228 my $fnamespace = $self->{'fedora_namespace'};
229 my $oid_namespace = (defined $fnamespace) ? $fnamespace : "test";
230 my $collection = $ENV{'GSDLCOLLECTION'};
231
232 my $fed_id = "$oid_namespace:$collection-$OID";
233
234 my $all_text = "";
235
236 my $top_section = $doc_obj->get_top_section();
237 my $plugin_type = $doc_obj->get_metadata_element($top_section,"Plugin");
238
239 if ((defined $plugin_type) && ($plugin_type eq "ImagePlug"))
240 {
241
242 $all_text .= "<mets:amdSec ID=\"RELS-EXT\">\n";
243 $all_text .= " <mets:techMD ID=\"RELS-EXT1.0\" STATUS=\"A\">\n";
244 $all_text .= " <mets:mdWrap LABEL=\"RELS-EXT - RDF formatted relationship metadata\" MDTYPE=\"OTHER\" MIMETYPE=\"text/xml\">\n";
245 $all_text .= " <mets:xmlData>\n";
246 $all_text .= " <rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\" xmlns:fedora-model=\"info:fedora/fedora-system:def/model#\">\n";
247 $all_text .= " <rdf:Description rdf:about=\"info:fedora/$fed_id\">\n";
248 $all_text .= " <fedora-model:hasContentModel rdf:resource=\"info:fedora/demo:UVA_STD_IMAGE\"/>\n";
249 $all_text .= " </rdf:Description>\n";
250 $all_text .= " </rdf:RDF>\n";
251 $all_text .= " </mets:xmlData>\n";
252 $all_text .= " </mets:mdWrap>\n";
253 $all_text .= " </mets:techMD>\n";
254 $all_text .= "</mets:amdSec>\n";
255 }
256
257 return $all_text;
258}
259
260
[14927]261#
262# Print out docmets.xml file
263#
264sub output_mets_section
265{
266 my $self = shift(@_);
267 my ($handle, $doc_obj, $section, $working_dir) = @_;
268
269 # print out the dmdSection
270 print $handle $self->buffer_mets_dmdSection_section_xml($doc_obj,$section);
271
[14970]272 print $handle $self->buffer_mets_relsext_xml($doc_obj);
273
[14927]274 print $handle "<mets:fileSec>\n";
275 print $handle " <mets:fileGrp ID=\"DATASTREAMS\">\n";
276
277 # Generate Filestream for Table of Contents (TOC)
278 print $handle $self->buffer_mets_fileSection_toc($doc_obj,$section,$working_dir);
279
280 # print out the fileSection by sections
281 print $handle $self->buffer_mets_fileSection_section_xml($doc_obj,$section,$working_dir);
282
283 # print out the whole fileSection
284 print $handle $self->buffer_mets_fileWhole_section_xml($doc_obj,$section,$working_dir);
285
286 print $handle " </mets:fileGrp>\n";
287 print $handle "</mets:fileSec>\n";
288
289 # print out the StructMapSection by sections
290
291 my $struct_type = "fedora:dsBindingMap";
292
293 # If document is going to make use of deminators (BMech and BDef) then
294 # need to code up more output XML here (structMap)and in
295 # METS:behaviorSec (Fedora extension?) sections
296
297}
298
299sub buffer_mets_amdSec_header
300{
301 my $self = shift(@_);
302 my ($section,$id) = @_;
303
304 # convert section number
305 my $section_num ="1". $section;
306
307 my $all_text = "";
308
309 my $label_attr = "";
310
311 $all_text .= "<mets:amdSec ID=\"$id$section\" >\n";
312 $all_text .= " <mets:techMD ID=\"$id$section.0\">\n"; # .0 fedora version number?
313
314 $label_attr = "LABEL=\"Metadata\"";
315
316 $all_text .= " <mets:mdWrap $label_attr MDTYPE=\"OTHER\" OTHERMDTYPE=\"gsdl3\" ID=\"".$id."gsdl$section_num\">\n";
317 $all_text .= " <mets:xmlData>\n";
318
319 return $all_text;
320
321}
322
323sub buffer_mets_amdSec_footer
324{
325 my $self = shift(@_);
326
327 my $all_text = "";
328
329 $all_text .= " </mets:xmlData>\n";
330 $all_text .= " </mets:mdWrap>\n";
331
332 $all_text .= " </mets:techMD>\n";
333 $all_text .= "</mets:amdSec>\n";
334
335 return $all_text;
336
337}
338
339sub oai_dc_metadata_xml
340{
341 my $self = shift(@_);
342 my ($doc_obj,$section) = @_;
343
344 my $all_text = "";
345
346 my $dc_namespace = "";
347 $dc_namespace .= "xmlns:dc=\"http://purl.org/dc/elements/1.1/\"";
348 $dc_namespace .= " xmlns:oai_dc=\"http://www.openarchives.org/OAI/2.0/oai_dc/\" ";
349
350 $all_text .= " <oai_dc:dc $dc_namespace>\n";
351
352 $all_text .= $self->get_dc_metadata($doc_obj, $section,"oai_dc");
353 $all_text .= " </oai_dc:dc>\n";
354
355 return $all_text;
356}
357
358
359
360
361
362# Work out the what the metadata set prefixes (dc,dls etc.) are for
363# this document
364
365sub metadata_set_prefixes
366{
367 my $self = shift(@_);
368 my ($doc_obj, $section) = @_;
369
370 $section="" unless defined $section;
371
372 my $section_ptr = $doc_obj->_lookup_section($section);
373 return {} unless defined $section_ptr;
374
375 my $unique_prefix = {};
376
377 foreach my $data (@{$section_ptr->{'metadata'}})
378 {
379 my ($prefix) = ($data->[0]=~ m/^(.*?)\./);
380
381 if (defined $prefix)
382 {
383 next if ($prefix eq "dc"); # skip dublin core as handled separately elsewhere
384
385 $unique_prefix->{$prefix} = 1;
386 }
387 else
388 {
389 $unique_prefix->{"ex"} = 1;
390 }
391
392 }
393
394 return $unique_prefix;
395}
396
397
398sub mds_metadata_xml
399{
400 my $self = shift(@_);
401 my ($doc_obj, $section, $mds_prefix, $namespace) = @_;
402
403 # build up string of metadata with $mds_prefix
404 $section="" unless defined $section;
405
406 my $section_ptr = $doc_obj->_lookup_section($section);
407 return "" unless defined $section_ptr;
408
409 my $all_text="";
410 $all_text .= " <$mds_prefix:$mds_prefix $namespace>\n";
411
412
413 foreach my $data (@{$section_ptr->{'metadata'}})
414 {
415 if ($data->[0]=~ m/^(?:(.*?)\.)?(.*)$/)
416 {
417 my $curr_mds_prefix = $1;
418 my $mds_full_element = $2;
419
420 $curr_mds_prefix = "ex" unless defined $curr_mds_prefix;
421
422 if ($curr_mds_prefix eq $mds_prefix)
423 {
424 # split up full element in the form Title^en into element=Title, attr="en"
425 my ($mds_element,$subelem) = ($mds_full_element =~ m/^(.*?)(?:\^(.*))?$/);
426 my $mds_attr = (defined $subelem) ? "qualifier=\"$subelem\"" : "";
427
428 my $escaped_value = &docprint::escape_text($data->[1]);
429
430 $all_text .= " <$mds_prefix:metadata name=\"$mds_element\" $mds_attr>$escaped_value</$mds_prefix:metadata>\n";
431 }
432 }
433 }
434
435 $all_text .= " </$mds_prefix:$mds_prefix>\n";
436
437
438 $all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
439
440 return $all_text;
441}
442
443
444
445sub buffer_mets_dmdSection_section_xml
446{
447 my $self = shift(@_);
448 my ($doc_obj,$section) = @_;
449
450 $section="" unless defined $section;
451
452 my $section_ptr=$doc_obj->_lookup_section($section);
453 return "" unless defined $section_ptr;
454
455 my $all_text = "";
456
457 $all_text .= $self->buffer_mets_amdSec_header($section,"DC");
458 $all_text .= $self->oai_dc_metadata_xml($doc_obj,$section);
459 $all_text .= $self->buffer_mets_amdSec_footer($section);
460
461 # for each metadata set
462 my $md_sets = $self->metadata_set_prefixes($doc_obj,$section);
463
464 foreach my $md_set (keys %$md_sets)
465 {
466 # Greenstone's agnostic approach to metadata sets conflicts with
467 # Fedoras more clinically prescribed one. Fake a namespace for
468 # each $md_set to keep both sides happy
469
470 my $fake_namespace
471 = "xmlns:$md_set=\"http://www.greenstone.org/namespace/fake/$md_set\"";
472 my $id_caps = $md_set;
473 $id_caps =~ tr/[a-z]/[A-Z]/;
474
475 $all_text .= $self->buffer_mets_amdSec_header($section,$id_caps);
476 $all_text .= $self->mds_metadata_xml($doc_obj,$section,$md_set,$fake_namespace);
477 $all_text .= $self->buffer_mets_amdSec_footer($section);
478 }
479
480
481 foreach my $subsection (@{$section_ptr->{'subsection_order'}}){
482 $all_text .= $self->buffer_mets_dmdSection_section_xml($doc_obj,"$section.$subsection");
483 }
484
485 $all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
486
487 return $all_text;
488}
489
490
491
492
493sub doctxt_to_xlink
494{
495 my $self = shift @_;
496 my ($fname,$working_dir) = @_;
497
498 my $xlink_href;
499
[14970]500 my $fedora_prefix = $ENV{'FEDORA_HOME'};
[14927]501 if (!defined $fedora_prefix) {
502 $xlink_href = "file:$fname";
503 }
504 else
505 {
506 my $gsdlhome = $ENV{'GSDLHOME'};
507 my $gsdl_href = "$working_dir/$fname";
508
509 $gsdl_href =~ s/^$gsdlhome(\/)?//;
510 $gsdl_href = "/gsdl/$gsdl_href";
511
512 my $fserver = $ENV{'FEDORA_HOSTNAME'};
513 my $fport = $ENV{'FEDORA_SERVER_PORT'};
514
515 my $fdomain = "http://$fserver:$fport";
516 $xlink_href = "$fdomain$gsdl_href";
517 }
518
519
520 return $xlink_href;
521
522}
523
524
525sub buffer_mets_fileSection_toc
526{
527 my $self = shift(@_);
528 my ($doc_obj,$section,$working_dir) = @_;
529
530 my $opt_attr = "OWNERID=\"M\"";
531
532 my $all_text = ' <mets:fileGrp ID="TOC">'. "\n";
533 $all_text .= " <mets:file MIMETYPE=\"text/xml\" ID=\"FILETOC\" $opt_attr >\n";
534 my $xlink = $self->doctxt_to_xlink("doctoc.xml",$working_dir);
535
536 $all_text .= ' <mets:FLocat LOCTYPE="URL" xlink:href="'.$xlink.'"';
537
538 $all_text .= ' xlink:title="Table of Contents"/>' . "\n";
539 $all_text .= " </mets:file>\n";
540 $all_text .= " </mets:fileGrp>\n";
541
542 return $all_text;
543}
544
545
546sub buffer_mets_fileSection_section_xml
547{
548 my $self = shift(@_);
549 my ($doc_obj,$section,$working_dir) = @_;
550
551 my $is_txt_split = 1;
552 my $opt_owner_id = "OWNERID=\"M\"";
553
554 my $all_text
555 = $self->SUPER::buffer_mets_fileSection_section_xml($doc_obj,$section,$working_dir,$is_txt_split, $opt_owner_id,"SECTION");
556
557
558 return $all_text;
559}
560
561sub buffer_mets_fileWhole_section_xml
562{
563 my $self = shift(@_);
564 my ($doc_obj,$section,$working_dir) = @_;
565
566 my $section_ptr = $doc_obj-> _lookup_section($section);
567 return "" unless defined $section_ptr;
568
569 my $all_text="";
570
571 my $fileID=0;
572
573 # Output the fileSection for the whole section
574 # => get the sourcefile and associative file
575
576 my $id_root = "";
577 my $opt_owner_id = "OWNERID=\"M\"";
578
579
[14970]580 my $first_assocfile = 1;
581
[14927]582 foreach my $data (@{$section_ptr->{'metadata'}}){
583 my $escaped_value = &docprint::escape_text($data->[1]);
584
585 if ($data->[0] eq "gsdlassocfile"){
586
587 $escaped_value =~ m/^(.*?):(.*):(.*)$/;
588 my $assoc_file = $1;
589 my $mime_type = $2;
590 my $assoc_dir = $3;
[14970]591
592 if ($first_assocfile) {
593 $id_root = "url";
594 $first_assocfile = 0;
595 }
596 else {
597 $id_root = "FG$assoc_file";
598 }
599
[14927]600 $id_root =~ s/\//_/g;
601 $all_text .= " <mets:fileGrp ID=\"$id_root\">\n";
602
603 my $assfilePath = ($assoc_dir eq "") ? $assoc_file : "$assoc_dir/$assoc_file";
604 ++$fileID;
605
606 my $mime_attr = "MIMETYPE=\"$mime_type\"";
607 my $xlink_title = "xlink:title=\"$assoc_file\"";
608
609 my $id_attr;
610 my $xlink_href;
611
[14970]612 $id_attr = "ID=\"F$id_root.0\"";
[14927]613
[14970]614 my $fedora_prefix = $ENV{'FEDORA_HOME'};
[14927]615 if (!defined $fedora_prefix) {
616 $xlink_href = "xlink:href=\"$assfilePath\"";
617 }
618 else
619 {
620 my $gsdlhome = $ENV{'GSDLHOME'};
621 my $gsdl_href = "$working_dir/$assfilePath";
622
623 $gsdl_href =~ s/^$gsdlhome(\/)?//;
624 $gsdl_href = "/gsdl/$gsdl_href";
625
626 my $fserver = $ENV{'FEDORA_HOSTNAME'};
627 my $fport = $ENV{'FEDORA_SERVER_PORT'};
628
629 my $fdomain = "http://$fserver:$fport";
630 $xlink_href = "xlink:href=\"$fdomain$gsdl_href\"";
631 }
632
633 my $top_section = $doc_obj->get_top_section();
634 my $id = $doc_obj->get_metadata_element($top_section,"Identifier");
635
636 $all_text .= " <mets:file $mime_attr $id_attr $opt_owner_id >\n";
637 $all_text .= " <mets:FLocat LOCTYPE=\"URL\" $xlink_href $xlink_title />\n";
638
639 $all_text .= " </mets:file>\n";
640
641 $all_text .= " </mets:fileGrp>\n";
642 }
643 }
644
645 $all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
646
647 return $all_text;
648}
649
650
6511;
Note: See TracBrowser for help on using the repository browser.