source: main/trunk/greenstone2/perllib/plugouts/GreenstoneMETSPlugout.pm@ 23824

Last change on this file since 23824 was 17203, checked in by kjdon, 16 years ago

BasPlugout renamed to BasePlugout. And tidied up the constructors

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