root/main/trunk/greenstone2/perllib/plugouts/FedoraMETSPlugout.pm @ 22465

Revision 22465, 22.9 KB (checked in by ak19, 10 years ago)

Improved checking of environment variables for Fedora values in BEGIN block

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