source: gsdl/trunk/perllib/plugouts/GreenstoneMETSPlugout.pm@ 16996

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

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

File size: 7.2 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 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 repository browser.