root/gsdl/trunk/perllib/plugouts/GreenstoneMETSPlugout.pm @ 16996

Revision 16996, 7.2 KB (checked in by kjdon, 12 years ago)

changed 'package FedoraMETSPlugout' to 'package 'GreenstoneMETSPlugout'. David, did you test this at all??

Line 
1###########################################################################
2#
3# GreenstoneMETSPlugout.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 GreenstoneMETSPlugout;
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    @GreenstoneMETSPlugout::ISA = ('METSPlugout');
38}
39
40my $arguments = [
41      ];
42
43my $options = { 'name'     => "GreenstoneMETSPlugout",
44        'desc'     => "{GreenstoneMETSPlugout.desc}",
45        'abstract' => "no",
46        'inherits' => "yes",
47            'args'     => $arguments
48                };
49
50sub new {
51    my ($class) = shift (@_);
52    my ($plugoutlist, $inputargs,$hashArgOptLists) = @_;
53    push(@$plugoutlist, $class);
54     
55    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
56    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
57
58    my $self = (defined $hashArgOptLists)? new METSPlugout($plugoutlist,$inputargs,$hashArgOptLists): new METSPlugout($plugoutlist,$inputargs);
59
60   
61   return bless $self, $class;
62}
63
64
65sub output_mets_xml_header
66{
67    my $self = shift(@_);
68    my ($handle, $OID, $doc_title) = @_;
69
70    my $extra_attr = "OBJID=\"$OID:2\"";
71
72    $self->output_mets_xml_header_extra_attribute($handle,$extra_attr);
73
74}
75
76#
77#  Print out docmets.xml file
78#
79sub output_mets_section
80{
81    my $self = shift(@_);
82    my ($handle, $doc_obj, $section, $working_dir) = @_;
83
84    # print out the dmdSection
85    print $handle $self->buffer_mets_dmdSection_section_xml($doc_obj,$section);
86
87    print $handle "<mets:fileSec>\n";
88
89    # print out the fileSection by sections
90    print $handle $self->buffer_mets_fileSection_section_xml($doc_obj,$section,$working_dir);
91
92    # print out the whole fileSection
93    print $handle $self->buffer_mets_fileWhole_section_xml($doc_obj,$section,$working_dir);
94
95    print $handle "</mets:fileSec>\n";
96 
97    # print out the StructMapSection by sections
98
99    my $struct_type = "Section";
100
101
102    # consider making the following its own subroutine
103
104    print $handle "<mets:structMap ID=\"Section\" TYPE=\"$struct_type\" LABEL=\"Section\">\n";
105    my $order_num=0;
106    print $handle $self->buffer_mets_StructMapSection_section_xml($doc_obj,$section, \$order_num);
107    print $handle "</mets:structMap>\n";
108   
109    print $handle '<mets:structMap ID="All" TYPE="Whole Document" LABEL="All">'."\n";
110    print $handle $self->buffer_mets_StructMapWhole_section_xml($doc_obj,$section);
111    print $handle "</mets:structMap>\n";
112
113 
114}
115
116sub buffer_mets_dmdSection_section_xml
117{
118    my $self = shift(@_);
119    my ($doc_obj,$section) = @_;
120   
121    $section="" unless defined $section;
122   
123    my $section_ptr=$doc_obj->_lookup_section($section);
124    return "" unless defined $section_ptr;
125
126    # convert section number
127    my $section_num ="1". $section;
128    my $dmd_num = $section_num;
129
130    my $all_text = "";
131
132    my $label_attr = "";
133    # TODO::
134    #print STDERR "***** Check that GROUPID in dmdSec is valid!!!\n";
135    #print STDERR "***** Check to see if <techMD> required\n";
136    # if it isn't allowed, go back and set $mdTag = dmdSec/amdSec
137
138    $all_text .= "<mets:dmdSec ID=\"DM$dmd_num\" GROUPID=\"$section_num\">\n";
139
140    $all_text .= "  <mets:mdWrap $label_attr MDTYPE=\"OTHER\" OTHERMDTYPE=\"gsdl3\" ID=\"gsdl$section_num\">\n";
141    $all_text .= "    <mets:xmlData>\n";
142
143    foreach my $data (@{$section_ptr->{'metadata'}}){
144    my $escaped_value = &docprint::escape_text($data->[1]);
145    $all_text .= '      <gsdl3:Metadata name="'. $data->[0].'">'. $escaped_value. "</gsdl3:Metadata>\n";
146    if ($data->[0] eq "dc.Title") {
147        $all_text .= '      <gsdl3:Metadata name="Title">'. $escaped_value."</gsdl3:Metadata>\n";
148    }
149    }
150   
151    $all_text .= "    </mets:xmlData>\n";
152    $all_text .= "  </mets:mdWrap>\n";
153   
154    $all_text .= "</mets:dmdSec>\n";   
155
156
157    foreach my $subsection (@{$section_ptr->{'subsection_order'}}){
158    $all_text .= $self->buffer_mets_dmdSection_section_xml($doc_obj,"$section.$subsection");
159    }
160   
161    $all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
162
163    return $all_text;
164}
165
166
167
168sub doctxt_to_xlink
169{
170    my $self = shift @_;
171    my ($fname,$working_dir) = @_;
172
173    my $xlink_href  = "file:$fname";
174
175    return $xlink_href;
176
177}
178
179
180
181sub buffer_mets_fileSection_section_xml
182{
183    my $self = shift(@_);
184    my ($doc_obj,$section,$working_dir,$is_recursive) = @_;
185
186    my $is_txt_split = undef;
187
188    my $all_text
189    = $self->SUPER::buffer_mets_fileSection_section_xml($doc_obj,$section,$working_dir,$is_txt_split);
190
191    return $all_text;
192}
193
194sub buffer_mets_fileWhole_section_xml
195{
196    my $self = shift(@_);
197    my ($doc_obj,$section,$working_dir) = @_;
198
199    my $section_ptr = $doc_obj-> _lookup_section($section);
200    return "" unless defined $section_ptr;
201   
202    my $all_text="";
203
204    my $fileID=0;
205
206    # Output the fileSection for the whole section
207    #  => get the sourcefile and associative file
208
209    my $id_root = "default";
210    my $opt_owner_id = "";   
211
212    $all_text .= "  <mets:fileGrp ID=\"$id_root\">\n";
213
214
215    foreach my $data (@{$section_ptr->{'metadata'}}){
216       my $escaped_value = &docprint::escape_text($data->[1]);
217
218       if ($data->[0] eq "gsdlsourcefilename") {
219          my ($dirPath) = $escaped_value =~ m/^(.*)[\/\\][^\/\\]*$/;
220
221          ++$fileID;     
222          $all_text .= "    <mets:file MIMETYPE=\"text/xml\" ID=\"$id_root.$fileID\" $opt_owner_id >\n";
223       
224      $all_text .= '      <mets:FLocat LOCTYPE="URL" xlink:href="file:'.$data->[1].'" />'."\n";
225     
226          $all_text .= "    </mets:file>\n";
227       }
228       
229       if ($data->[0] eq "gsdlassocfile"){
230       
231       $escaped_value =~ m/^(.*?):(.*):(.*)$/;
232       my $assoc_file = $1;
233       my $mime_type  = $2;
234       my $assoc_dir  = $3;
235       
236       my $assfilePath = ($assoc_dir eq "") ? $assoc_file : "$assoc_dir/$assoc_file";
237       ++$fileID;
238       
239       my $mime_attr   = "MIMETYPE=\"$mime_type\"";
240       my $xlink_title = "xlink:title=\"$assoc_file\"";
241
242       my $id_attr;
243       my $xlink_href;
244
245       $id_attr = "ID=\"$id_root.$fileID\"";
246       $xlink_href  = "xlink:href=\"$assfilePath\"";
247
248       $all_text .= "    <mets:file $mime_attr $id_attr $opt_owner_id >\n";
249       $all_text .= "      <mets:FLocat LOCTYPE=\"URL\" $xlink_href $xlink_title />\n";
250       
251       $all_text .= "    </mets:file>\n";
252           
253       }
254   }
255   
256    $all_text .= "  </mets:fileGrp>\n";
257   
258    $all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
259   
260    return $all_text;
261}
262
263
2641;
Note: See TracBrowser for help on using the browser.