source: main/trunk/greenstone2/perllib/plugouts/FedoraMETSPlugout.pm@ 22338

Last change on this file since 22338 was 22338, checked in by ak19, 14 years ago

Image URLs are adjusted to refer to their location in Fedora.
File size: 22.5 KB
Line 
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' => "{FedoraMETSPlugout.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 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
67 push(@{$hashArgOptLists->{"OptList"}},$options);
68
69 my $self = new METSPlugout($plugoutlist,$inputargs,$hashArgOptLists);
70
71 return bless $self, $class;
72}
73
74
75sub output_mets_xml_header
76{
77 my $self = shift(@_);
78 my ($handle, $OID, $doc_title) = @_;
79
80 my $fnamespace = $self->{'fedora_namespace'};
81 my $oid_namespace = (defined $fnamespace) ? $fnamespace : "test";
82
83 my $collection = $ENV{'GSDLCOLLECTION'};
84
85 # Might need the following in the schemeLocation attribute for Fedora3
86 # http://www.fedora.info/definitions/1/0/mets-fedora-ext1-1.xsd
87 my $extra_attr = "OBJID=\"$oid_namespace:$collection-$OID\" TYPE=\"FedoraObject\" LABEL=\"$doc_title\"";
88
89 my $extra_schema = undef;
90
91 if (defined $ENV{'FEDORA_VERSION'} && $ENV{'FEDORA_VERSION'} =~ m/^2/) { # checking if major version is 2
92 $extra_schema = "http://www.fedora.info/definitions/1/0/mets-fedora-ext.xsd";
93 }
94 else {
95 $extra_attr .= " EXT_VERSION=\"1.1\"";
96 }
97
98 $self->output_mets_xml_header_extra_attribute($handle,$extra_attr,$extra_schema);
99
100 print $handle '<mets:metsHdr RECORDSTATUS="A"/>'. "\n"; # A = active
101
102}
103
104#
105# Print out "family" of doctxt.xml files
106#
107
108sub saveas_doctxt_section
109{
110 my $self = shift (@_);
111 my ($doc_obj,$working_dir,$section) = @_;
112
113 my $section_ptr=$doc_obj->_lookup_section($section);
114 return unless defined $section_ptr;
115
116 my $section_fnum ="1". $section;
117 $section_fnum =~ s/\./_/g;
118
119 my $doc_txt_file = &util::filename_cat ($working_dir,"doctxt$section_fnum.xml");
120
121 $self->open_xslt_pipe($doc_txt_file,$self->{'xslt_txt'});
122
123 my $outhandler;
124
125 if (defined $self->{'xslt_writer'}){
126 $outhandler = $self->{'xslt_writer'};
127 }
128 else{
129 $outhandler = $self->get_output_handler($doc_txt_file);
130 }
131
132 $self->output_xml_header($outhandler);
133
134 ## change links to be Fedora cognant:
135 my $txt = $section_ptr->{'text'};
136 $section_ptr->{'text'} = $self->adjust_links($doc_obj, \$txt);
137
138 $self->output_txt_section($outhandler,$doc_obj, $section);
139 $self->output_xml_footer($outhandler);
140
141
142 if (defined $self->{'xslt_writer'}){
143 $self->close_xslt_pipe();
144 }
145 else{
146 close($outhandler);
147 }
148
149
150 # Output all the subsections as separate files
151 foreach my $subsection (@{$section_ptr->{'subsection_order'}}){
152
153 $self->saveas_doctxt_section($doc_obj, $working_dir, "$section.$subsection");
154 }
155}
156
157
158#sub adjust_text_before_saving()
159sub adjust_links()
160{
161 my $self = shift(@_);
162 my ($doc_obj, $textref) = @_;
163
164 ## change links to be Fedora cognant:
165 # 1. retrieve txt $$textref ???
166 # 2. change it:
167 # /$ENV{'FEDORA_PREFIX'}/objects/$greenstone-docobj-hash-xxx/datastreams/FG<orig-img-name>/content
168 # (Note that the first image is always "url", instead of FG<orig-img-name>)
169 # 3. only replace it back in doc_obj if we didn't get a ref in the first place
170
171 my $OID = $doc_obj->get_OID();
172 my $fnamespace = $self->{'fedora_namespace'};
173 my $replace_img_name = 1;
174 if($OID ne "collection" && defined $fnamespace) {
175 my $fed_id = "$fnamespace:".$ENV{'GSDLCOLLECTION'}."-$OID"; #oid_namespace:collection-OID
176 my $fedora_url_prefix = $ENV{'FEDORA_PREFIX'}."/objects/$fed_id/datastreams/";
177 my $fedora_url_suffix = "/content";
178
179 $$textref =~ s/(<(?:img|embed|table|tr|td|link|script)[^>]*?(?:src|background|href)\s*=\s*)((?:[\"][^\"]+[\"])|(?:[\'][^\']+[\'])|(?:[^\s\/>]+))([^>]*>)/$self->replace_rel_link($1, $2, $3, $fedora_url_prefix, $fedora_url_suffix, $replace_img_name--)/isge;
180# print STDERR "*** all text after: $$textref\n\n";
181 }
182
183 return $$textref;
184}
185
186# replace relative link with the prefix and suffix given
187sub replace_rel_link
188{
189 my $self = shift (@_);
190 my ($front, $link, $back, $url_prefix, $url_suffix, $replace_img_name) = @_;
191
192 # only process relative links. Return if absolute link
193 if($link =~ m/^http/) {
194 return "$front$link$back";
195 }
196
197 # remove quotes from link at start and end if necessary
198 if ($link=~/^[\"\']/) {
199 $link=~s/^[\"\']//;
200 $link=~s/[\"\']$//;
201 $front.='"';
202 $back="\"$back";
203 }
204
205 # remove any _httpdocimg/ that greenstone may have prefixed to the image
206 $link =~ s/^_httpdocimg_(?:\/|\\)//;
207
208 # the datastream of the first image of each section is always called "url"
209 if($replace_img_name) {
210 return "$front$url_prefix"."url"."$url_suffix$back";
211 }
212 # else
213 return "$front$url_prefix"."FG"."$link$url_suffix$back";
214}
215
216
217sub saveas_doctxt
218{
219 my $self = shift (@_);
220 my ($doc_obj,$working_dir) = @_;
221
222 my $section = $doc_obj->get_top_section();
223
224 $self->saveas_doctxt_section($doc_obj,$working_dir,$section);
225
226 $self->saveas_toc($doc_obj,$working_dir);
227}
228
229sub buffer_toc
230{
231 my $self = shift (@_);
232 my ($doc_obj,$working_dir,$section,$depth) = @_;
233
234 my $section_ptr=$doc_obj->_lookup_section($section);
235 return "" unless defined $section_ptr;
236
237 my $all_text = "";
238
239 my $section_num ="1". $section;
240 my $indent = " " x ($depth*2);
241
242 $all_text .= "$indent<Section id=\"$section_num\">\n";
243
244 # Output all the subsections as separate files
245 foreach my $subsection (@{$section_ptr->{'subsection_order'}})
246 {
247 $all_text
248 .= $self->buffer_toc($doc_obj, $working_dir,
249 "$section.$subsection",$depth+1);
250 }
251
252 $all_text .= "$indent</Section>\n";
253
254 return $all_text;
255}
256
257
258sub saveas_toc
259{
260 my $self = shift (@_);
261 my ($doc_obj,$working_dir) = @_;
262
263 my $section = $doc_obj->get_top_section();
264 my $section_ptr=$doc_obj->_lookup_section($section);
265 my $num_subsections = scalar(@{$section_ptr->{'subsection_order'}});
266
267 # If num_subsections is 0, then there is no nested TOC
268
269 if ($num_subsections>0) {
270
271 my $doc_txt_file = &util::filename_cat ($working_dir,"doctoc.xml");
272
273 $self->open_xslt_pipe($doc_txt_file,$self->{'xslt_txt'});
274
275 my $outhandler;
276
277 if (defined $self->{'xslt_writer'}){
278 $outhandler = $self->{'xslt_writer'};
279 }
280 else{
281 $outhandler = $self->get_output_handler($doc_txt_file);
282 }
283 print $outhandler $self->buffer_toc($doc_obj, $working_dir, $section, 0);
284
285 if (defined $self->{'xslt_writer'}){
286 $self->close_xslt_pipe();
287 }
288 else{
289 close($outhandler);
290 }
291 }
292
293}
294
295
296sub buffer_mets_relsext_xml
297{
298 my $self = shift(@_);
299 my ($doc_obj) = @_;
300
301 my $OID = $doc_obj->get_OID();
302
303 my $fnamespace = $self->{'fedora_namespace'};
304 my $oid_namespace = (defined $fnamespace) ? $fnamespace : "test";
305 my $collection = $ENV{'GSDLCOLLECTION'};
306
307 my $fed_id = "$oid_namespace:$collection-$OID";
308
309 my $all_text = "";
310
311 my $top_section = $doc_obj->get_top_section();
312 my $plugin_type = $doc_obj->get_metadata_element($top_section,"Plugin");
313
314# Images do not get ingested into Fedora when on Linux if the following is included
315# Needs more investigation, since we'd like a working version of the following
316# in order to get thumbnails working and other stuff.
317# if ((defined $plugin_type) && ($plugin_type eq "ImagePlugin"))
318# {
319#
320# $all_text .= "<mets:amdSec ID=\"RELS-EXT\">\n";
321# $all_text .= " <mets:techMD ID=\"RELS-EXT1.0\" STATUS=\"A\">\n";
322# $all_text .= " <mets:mdWrap LABEL=\"RELS-EXT - RDF formatted relationship metadata\" MDTYPE=\"OTHER\" MIMETYPE=\"text/xml\">\n";
323# $all_text .= " <mets:xmlData>\n";
324# $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";
325# $all_text .= " <rdf:Description rdf:about=\"info:fedora/$fed_id\">\n";
326# $all_text .= " <fedora-model:hasContentModel rdf:resource=\"info:fedora/demo:UVA_STD_IMAGE\"/>\n";
327# $all_text .= " </rdf:Description>\n";
328# $all_text .= " </rdf:RDF>\n";
329# $all_text .= " </mets:xmlData>\n";
330# $all_text .= " </mets:mdWrap>\n";
331# $all_text .= " </mets:techMD>\n";
332# $all_text .= "</mets:amdSec>\n";
333# }
334
335 return $all_text;
336}
337
338
339#
340# Print out docmets.xml file
341#
342sub output_mets_section
343{
344 my $self = shift(@_);
345 my ($handle, $doc_obj, $section, $working_dir) = @_;
346
347 # print out the dmdSection
348 print $handle $self->buffer_mets_dmdSection_section_xml($doc_obj,$section);
349
350 print $handle $self->buffer_mets_relsext_xml($doc_obj);
351
352 print $handle "<mets:fileSec>\n";
353 print $handle " <mets:fileGrp ID=\"DATASTREAMS\">\n";
354
355 # Generate Filestream for Table of Contents (TOC)
356 my $section_ptr=$doc_obj->_lookup_section($section);
357 my $num_subsections = scalar(@{$section_ptr->{'subsection_order'}});
358
359 # If num_subsections is 0, then there is no nested TOC
360
361 if ($num_subsections>0) {
362 print $handle $self->buffer_mets_fileSection_toc($doc_obj,$section,$working_dir);
363 }
364
365 # print out the fileSection by sections
366 print $handle $self->buffer_mets_fileSection_section_xml($doc_obj,$section,$working_dir);
367
368 # print out the whole fileSection
369 print $handle $self->buffer_mets_fileWhole_section_xml($doc_obj,$section,$working_dir);
370
371 print $handle " </mets:fileGrp>\n";
372 print $handle "</mets:fileSec>\n";
373
374 # print out the StructMapSection by sections
375
376 my $struct_type = "fedora:dsBindingMap";
377
378 # If document is going to make use of deminators (BMech and BDef) then
379 # need to code up more output XML here (structMap)and in
380 # METS:behaviorSec (Fedora extension?) sections
381
382}
383
384sub buffer_mets_amdSec_header
385{
386 my $self = shift(@_);
387 my ($section,$id) = @_;
388
389 # convert section number
390 my $section_num ="1". $section;
391
392 my $all_text = "";
393
394 my $label_attr = "";
395
396 $all_text .= "<mets:amdSec ID=\"$id$section\" >\n";
397 $all_text .= " <mets:techMD ID=\"$id$section.0\">\n"; # .0 fedora version number?
398
399 $label_attr = "LABEL=\"Metadata\"";
400
401 $all_text .= " <mets:mdWrap $label_attr MDTYPE=\"OTHER\" OTHERMDTYPE=\"gsdl3\" ID=\"".$id."gsdl$section_num\">\n";
402 $all_text .= " <mets:xmlData>\n";
403
404 return $all_text;
405
406}
407
408sub buffer_mets_amdSec_footer
409{
410 my $self = shift(@_);
411
412 my $all_text = "";
413
414 $all_text .= " </mets:xmlData>\n";
415 $all_text .= " </mets:mdWrap>\n";
416
417 $all_text .= " </mets:techMD>\n";
418 $all_text .= "</mets:amdSec>\n";
419
420 return $all_text;
421
422}
423
424sub oai_dc_metadata_xml
425{
426 my $self = shift(@_);
427 my ($doc_obj,$section) = @_;
428
429 my $all_text = "";
430
431 my $dc_namespace = "";
432 $dc_namespace .= "xmlns:dc=\"http://purl.org/dc/elements/1.1/\"";
433 $dc_namespace .= " xmlns:oai_dc=\"http://www.openarchives.org/OAI/2.0/oai_dc/\" ";
434
435 $all_text .= " <oai_dc:dc $dc_namespace>\n";
436
437 $all_text .= $self->get_dc_metadata($doc_obj, $section,"oai_dc");
438 $all_text .= " </oai_dc:dc>\n";
439
440 return $all_text;
441}
442
443
444
445
446
447# Work out the what the metadata set prefixes (dc,dls etc.) are for
448# this document
449
450sub metadata_set_prefixes
451{
452 my $self = shift(@_);
453 my ($doc_obj, $section) = @_;
454
455 $section="" unless defined $section;
456
457 my $section_ptr = $doc_obj->_lookup_section($section);
458 return {} unless defined $section_ptr;
459
460 my $unique_prefix = {};
461
462 foreach my $data (@{$section_ptr->{'metadata'}})
463 {
464 my ($prefix) = ($data->[0]=~ m/^(.*?)\./);
465
466 if (defined $prefix)
467 {
468 next if ($prefix eq "dc"); # skip dublin core as handled separately elsewhere
469
470 $unique_prefix->{$prefix} = 1;
471 }
472 else
473 {
474 $unique_prefix->{"ex"} = 1;
475 }
476
477 }
478
479 return $unique_prefix;
480}
481
482
483sub mds_metadata_xml
484{
485 my $self = shift(@_);
486 my ($doc_obj, $section, $mds_prefix, $namespace) = @_;
487
488 # build up string of metadata with $mds_prefix
489 $section="" unless defined $section;
490
491 my $section_ptr = $doc_obj->_lookup_section($section);
492 return "" unless defined $section_ptr;
493
494 my $all_text="";
495 $all_text .= " <$mds_prefix:$mds_prefix $namespace>\n";
496
497
498 foreach my $data (@{$section_ptr->{'metadata'}})
499 {
500 if ($data->[0]=~ m/^(?:(.*?)\.)?(.*)$/)
501 {
502 my $curr_mds_prefix = $1;
503 my $mds_full_element = $2;
504
505 $curr_mds_prefix = "ex" unless defined $curr_mds_prefix;
506
507 if ($curr_mds_prefix eq $mds_prefix)
508 {
509 # split up full element in the form Title^en into element=Title, attr="en"
510 my ($mds_element,$subelem) = ($mds_full_element =~ m/^(.*?)(?:\^(.*))?$/);
511 my $mds_attr = (defined $subelem) ? "qualifier=\"$subelem\"" : "";
512
513 my $escaped_value = &docprint::escape_text($data->[1]);
514
515 $all_text .= " <$mds_prefix:metadata name=\"$mds_element\" $mds_attr>$escaped_value</$mds_prefix:metadata>\n";
516 }
517 }
518 }
519
520 $all_text .= " </$mds_prefix:$mds_prefix>\n";
521
522
523 $all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
524
525 return $all_text;
526}
527
528
529
530sub buffer_mets_dmdSection_section_xml
531{
532 my $self = shift(@_);
533 my ($doc_obj,$section) = @_;
534
535 $section="" unless defined $section;
536
537 my $section_ptr=$doc_obj->_lookup_section($section);
538 return "" unless defined $section_ptr;
539
540 my $all_text = "";
541
542 $all_text .= $self->buffer_mets_amdSec_header($section,"DC");
543 $all_text .= $self->oai_dc_metadata_xml($doc_obj,$section);
544 $all_text .= $self->buffer_mets_amdSec_footer($section);
545
546 # for each metadata set
547 my $md_sets = $self->metadata_set_prefixes($doc_obj,$section);
548
549 foreach my $md_set (keys %$md_sets)
550 {
551 # Greenstone's agnostic approach to metadata sets conflicts with
552 # Fedoras more clinically prescribed one. Fake a namespace for
553 # each $md_set to keep both sides happy
554
555 my $fake_namespace
556 = "xmlns:$md_set=\"http://www.greenstone.org/namespace/fake/$md_set\"";
557 my $id_caps = $md_set;
558 $id_caps =~ tr/[a-z]/[A-Z]/;
559
560 $all_text .= $self->buffer_mets_amdSec_header($section,$id_caps);
561 $all_text .= $self->mds_metadata_xml($doc_obj,$section,$md_set,$fake_namespace);
562 $all_text .= $self->buffer_mets_amdSec_footer($section);
563 }
564
565
566 foreach my $subsection (@{$section_ptr->{'subsection_order'}}){
567 $all_text .= $self->buffer_mets_dmdSection_section_xml($doc_obj,"$section.$subsection");
568 }
569
570 $all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
571
572 return $all_text;
573}
574
575
576sub doctxt_to_xlink
577{
578 my $self = shift @_;
579 my ($fname,$working_dir) = @_;
580
581 my $xlink_href;
582
583 my $fedora_prefix = $ENV{'FEDORA_HOME'};
584 if (!defined $fedora_prefix) {
585 $xlink_href = "file:$fname";
586 }
587 else
588 {
589 my $collectparent;
590 if (defined $ENV{'GSDL3SRCHOME'}) { # we're dealing with a GS3 server
591 if(defined $ENV{'GSDL3HOME'}) { # in case the web directory is located in a separate place
592 $collectparent = &util::filename_cat($ENV{'GSDL3HOME'},"sites","localsite");
593 }
594 else { # try the default location for the web directory
595 $collectparent = &util::filename_cat($ENV{'GSDL3SRCHOME'},"web","sites","localsite");
596 }
597 }
598 else {
599 # greenstone 2
600 $collectparent = $ENV{'GSDLHOME'};
601 }
602
603 my $gsdl_href = &util::filename_cat($working_dir, $fname);
604 $collectparent =~ s/\\/\\\\/g; # escape reserved metacharacter \ in path (by replacing it with \\) for substitution
605 $gsdl_href =~ s/^$collectparent(\/|\\)?//; # remove the collectparent path in gsdl_href and any trailing slash
606 $gsdl_href =~ s/\\/\//g; # make sure we have url paths (which only use / not \)
607 my $localfedora = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "packages", "tomcat", "conf", "Catalina", "localhost", "fedora.xml");
608
609 my $greenstone_url_prefix = &util::get_greenstone_url_prefix();
610 # prepend url_prefix (which will contain the forward slash upfront)
611 if($ENV{'GSDL3SRCHOME'} && -e $localfedora) { # Fedora uses Greenstone's tomcat.
612 $gsdl_href = "$greenstone_url_prefix/sites/localsite/$gsdl_href"; # Default: /greenstone3/sites/localsite/$gsdl_href
613 } else {
614 $gsdl_href = "$greenstone_url_prefix/$gsdl_href"; # By default: "/greenstone/$gsdl_href";
615 }
616
617 my $fserver = $ENV{'FEDORA_HOSTNAME'};
618 my $fport = $ENV{'FEDORA_SERVER_PORT'};
619
620 my $fdomain = "http://$fserver:$fport";
621 $xlink_href = "$fdomain$gsdl_href";
622#ERROR: $xlink_href = "$fname";
623 }
624
625 return $xlink_href;
626
627}
628
629
630sub buffer_mets_fileSection_toc
631{
632 my $self = shift(@_);
633 my ($doc_obj,$section,$working_dir) = @_;
634
635 my $opt_attr = "OWNERID=\"M\"";
636
637 my $all_text = ' <mets:fileGrp ID="TOC">'. "\n";
638 $all_text .= " <mets:file MIMETYPE=\"text/xml\" ID=\"FILETOC\" $opt_attr >\n";
639 my $xlink = $self->doctxt_to_xlink("doctoc.xml",$working_dir);
640
641 $all_text .= ' <mets:FLocat LOCTYPE="URL" xlink:href="'.$xlink.'"';
642
643 $all_text .= ' xlink:title="Table of Contents"/>' . "\n";
644 $all_text .= " </mets:file>\n";
645 $all_text .= " </mets:fileGrp>\n";
646
647 return $all_text;
648}
649
650
651sub buffer_mets_fileSection_section_xml
652{
653 my $self = shift(@_);
654 my ($doc_obj,$section,$working_dir) = @_;
655
656 my $is_txt_split = 1;
657 my $opt_owner_id = "OWNERID=\"M\"";
658
659 my $all_text
660 = $self->SUPER::buffer_mets_fileSection_section_xml($doc_obj,$section,$working_dir,$is_txt_split, $opt_owner_id,"SECTION");
661
662
663 return $all_text;
664}
665
666sub buffer_mets_fileWhole_section_xml
667{
668 my $self = shift(@_);
669 my ($doc_obj,$section,$working_dir) = @_;
670
671 my $section_ptr = $doc_obj-> _lookup_section($section);
672 return "" unless defined $section_ptr;
673
674 my $all_text="";
675
676 my $fileID=0;
677
678 # Output the fileSection for the whole section
679 # => get the sourcefile and associative file
680
681 my $id_root = "";
682 my $opt_owner_id = "OWNERID=\"M\"";
683
684
685 my $first_assocfile = 1;
686
687 foreach my $data (@{$section_ptr->{'metadata'}}){
688 my $escaped_value = &docprint::escape_text($data->[1]);
689
690 if ($data->[0] eq "gsdlassocfile"){
691
692 $escaped_value =~ m/^(.*?):(.*):(.*)$/;
693 my $assoc_file = $1;
694 my $mime_type = $2;
695 my $assoc_dir = $3;
696
697 if ($first_assocfile) {
698 $id_root = "url";
699 $first_assocfile = 0;
700 }
701 else {
702 $id_root = "FG$assoc_file";
703 }
704
705 $id_root =~ s/\//_/g;
706 $all_text .= " <mets:fileGrp ID=\"$id_root\">\n";
707
708 # The assoc_file's name may be url-encoded, so the xlink_href in the <mets:FLocat>
709 # element must be the url to this (possibly url-encoded) filename
710 my $assocfile_url = &unicode::filename_to_url($assoc_file);
711 my $assfilePath = ($assoc_dir eq "") ? $assocfile_url : "$assoc_dir/$assocfile_url";
712 ++$fileID;
713
714 my $mime_attr = "MIMETYPE=\"$mime_type\"";
715 my $xlink_title = "xlink:title=\"$assoc_file\"";
716
717 my $id_attr;
718 my $xlink_href;
719
720 $id_attr = "ID=\"F$id_root.0\"";
721
722 my $fedora_prefix = $ENV{'FEDORA_HOME'};
723 if (!defined $fedora_prefix) {
724 $xlink_href = "xlink:href=\"$assfilePath\"";
725 }
726 else
727 {
728 my $collectparent;
729 if (defined $ENV{'GSDL3SRCHOME'}) { # we're dealing with a GS3 server
730 if(defined $ENV{'GSDL3HOME'}) { # in case the web directory is located in a separate place
731 $collectparent = &util::filename_cat($ENV{'GSDL3HOME'},"sites","localsite");
732 }
733 else { # try the default location for the web directory
734 $collectparent = &util::filename_cat($ENV{'GSDL3SRCHOME'},"web","sites","localsite");
735 }
736 }
737 else {
738 # greenstone 2
739 $collectparent = $ENV{'GSDLHOME'};
740 }
741
742 my $gsdl_href = &util::filename_cat($working_dir,$assfilePath);
743 $collectparent =~ s/\\/\\\\/g; # escape reserved metacharacter \ in path (by replacing it with \\) for substitution
744 $gsdl_href =~ s/^$collectparent(\/|\\)?//; # remove the collectparent path in gsdl_href and any trailing slash
745 $gsdl_href =~ s/\\/\//g; # make sure we have url paths (which only use / not \)
746 my $localfedora = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "packages", "tomcat", "conf", "Catalina", "localhost", "fedora.xml");
747
748 my $greenstone_url_prefix = &util::get_greenstone_url_prefix();
749 # prepend url_prefix (which will contain the forward slash upfront)
750 if($ENV{'GSDL3SRCHOME'} && -e $localfedora) { # Fedora uses Greenstone's tomcat.
751 $gsdl_href = "$greenstone_url_prefix/sites/localsite/$gsdl_href"; # Default: /greenstone3/sites/localsite/$gsdl_href
752 } else {
753 $gsdl_href = "$greenstone_url_prefix/$gsdl_href"; # By default: "/greenstone/$gsdl_href";
754 }
755
756 my $fserver = $ENV{'FEDORA_HOSTNAME'};
757 my $fport = $ENV{'FEDORA_SERVER_PORT'};
758
759 my $fdomain = "http://$fserver:$fport";
760 $xlink_href = "xlink:href=\"$fdomain$gsdl_href\"";
761#ERROR: $xlink_href = "xlink:href=\"$assfilePath\"";
762 }
763
764 my $top_section = $doc_obj->get_top_section();
765 my $id = $doc_obj->get_metadata_element($top_section,"Identifier");
766
767### print STDERR "**** mime-type: $mime_attr\n";
768
769 $all_text .= " <mets:file $mime_attr $id_attr $opt_owner_id >\n";
770 $all_text .= " <mets:FLocat LOCTYPE=\"URL\" $xlink_href $xlink_title />\n";
771
772 $all_text .= " </mets:file>\n";
773
774 $all_text .= " </mets:fileGrp>\n";
775 }
776 }
777
778 $all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
779
780 return $all_text;
781}
782
783
7841;
Note: See TracBrowser for help on using the repository browser.