source: main/trunk/greenstone2/bin/script/import.pl@ 28703

Last change on this file since 28703 was 28703, checked in by kjdon, 10 years ago

can set the defaults now in the args structure, as we have default_argname to see if it was set by the user or not.

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 11.1 KB
RevLine 
[14031]1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# import.pl --
6# A component of the Greenstone digital library software
7# from the New Zealand Digital Library Project at the
8# University of Waikato, New Zealand.
9#
10# Copyright (C) 1999 New Zealand Digital Library Project
11#
12# This program is free software; you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation; either version 2 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20# GNU General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program; if not, write to the Free Software
24# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25#
26###########################################################################
27
28
29# This program will import a number of files into a particular collection
30
31package import;
32
33BEGIN {
34 die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
35 die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};
36 unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
37 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
38 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/plugins");
39 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/plugouts");
[14957]40
41 if (defined $ENV{'GSDLEXTS'}) {
42 my @extensions = split(/:/,$ENV{'GSDLEXTS'});
43 foreach my $e (@extensions) {
44 my $ext_prefix = "$ENV{'GSDLHOME'}/ext/$e";
45
46 unshift (@INC, "$ext_prefix/perllib");
47 unshift (@INC, "$ext_prefix/perllib/cpan");
[16788]48 unshift (@INC, "$ext_prefix/perllib/plugins");
49 unshift (@INC, "$ext_prefix/perllib/plugouts");
[14957]50 }
51 }
[21291]52 if (defined $ENV{'GSDL3EXTS'}) {
53 my @extensions = split(/:/,$ENV{'GSDL3EXTS'});
54 foreach my $e (@extensions) {
55 my $ext_prefix = "$ENV{'GSDL3SRCHOME'}/ext/$e";
56
57 unshift (@INC, "$ext_prefix/perllib");
58 unshift (@INC, "$ext_prefix/perllib/cpan");
59 unshift (@INC, "$ext_prefix/perllib/plugins");
60 unshift (@INC, "$ext_prefix/perllib/plugouts");
61 }
62 }
[23372]63
64 if ((defined $ENV{'DEBUG_UNICODE'}) && (defined $ENV{'DEBUG_UNICODE'})) {
65 binmode(STDERR,":utf8");
66 }
[14031]67}
68
[27305]69# Pragma
[14957]70use strict;
[27305]71use warnings;
72
73# Modules
74use Symbol qw<qualify>; # Needed for runtime loading of modules [jmt12]
75
76# Greenstone Modules
77use FileUtils;
[18456]78use inexport;
[27305]79use util;
[28640]80use gsprintf 'gsprintf';
[14031]81
82
[14957]83# used to control output file format
[14031]84my $saveas_list =
[17751]85 [ { 'name' => "GreenstoneXML",
86 'desc' => "{export.saveas.GreenstoneXML}"},
[14957]87 { 'name' => "GreenstoneMETS",
88 'desc' => "{export.saveas.GreenstoneMETS}"},
[17038]89 ];
[14031]90
91
92# Possible attributes for each argument
93# name: The name of the argument
94# desc: A description (or more likely a reference to a description) for this argument
95# type: The type of control used to represent the argument. Options include: string, int, flag, regexp, metadata, language, enum etc
96# reqd: Is this argument required?
97# hiddengli: Is this argument hidden in GLI?
98# modegli: The lowest detail mode this argument is visible at in GLI
99
[14957]100my $saveas_argument
101 = { 'name' => "saveas",
102 'desc' => "{import.saveas}",
103 'type' => "enum",
104 'list' => $saveas_list,
[28703]105 'deft' => "GreenstoneXML",
[14957]106 'reqd' => "no",
107 'modegli' => "3" };
108
109
[14031]110my $arguments =
[14957]111 [
112 $saveas_argument,
[28639]113 { 'name' => "sortmeta",
[14031]114 'desc' => "{import.sortmeta}",
[19625]115 'type' => "string",
116 #'type' => "metadata", #doesn't work properly in GLI
[14031]117 'reqd' => "no",
[18590]118 'modegli' => "2" },
[14031]119 { 'name' => "removeprefix",
120 'desc' => "{BasClas.removeprefix}",
121 'type' => "regexp",
122 'deft' => "",
123 'reqd' => "no",
124 'modegli' => "3" },
125 { 'name' => "removesuffix",
126 'desc' => "{BasClas.removesuffix}",
127 'type' => "regexp",
128 'deft' => "",
129 'reqd' => "no",
130 'modegli' => "3" },
131 { 'name' => "groupsize",
132 'desc' => "{import.groupsize}",
133 'type' => "int",
134 'deft' => "1",
135 'reqd' => "no",
[18590]136 'modegli' => "2" },
[28639]137 { 'name' => "archivedir",
138 'desc' => "{import.archivedir}",
139 'type' => "string",
140 'reqd' => "no",
[28703]141 'deft' => "archives",
[28639]142 'hiddengli' => "yes" },
143 @$inexport::directory_arguments,
[14031]144 { 'name' => "gzip",
145 'desc' => "{import.gzip}",
146 'type' => "flag",
147 'reqd' => "no",
[18590]148 'modegli' => "3" },
[28639]149 @$inexport::arguments
150];
[14031]151
152my $options = { 'name' => "import.pl",
153 'desc' => "{import.desc}",
154 'args' => $arguments };
155
[27305]156my $function_to_inexport_subclass_mappings = {};
[14031]157
[27305]158sub main
[22413]159{
[27305]160 # Dynamically include arguments from any subclasses of inexport we find
161 # in the extensions directory
162 if (defined $ENV{'GSDLEXTS'})
163 {
164 &_scanForSubclasses($ENV{'GSDLHOME'}, $ENV{'GSDLEXTS'});
165 }
166 if (defined $ENV{'GSDL3EXTS'})
167 {
168 &_scanForSubclasses($ENV{'GSDL3SRCHOME'}, $ENV{'GSDL3EXTS'});
169 }
[14031]170
[27305]171 # Loop through arguments, checking to see if any depend on a specific
172 # subclass of InExport. Note that we load the first subclass we encounter
173 # so only support a single 'override' ATM.
174 my $inexport_subclass;
175 foreach my $argument (@ARGV)
176 {
177 # proper arguments start with a hyphen
178 if ($argument =~ /^-/ && defined $function_to_inexport_subclass_mappings->{$argument})
179 {
180 my $required_inexport_subclass = $function_to_inexport_subclass_mappings->{$argument};
181 if (!defined $inexport_subclass)
182 {
183 $inexport_subclass = $required_inexport_subclass;
184 }
185 # Oh noes! The user has included specific arguments from two different
186 # inexport subclasses... this isn't supported
187 elsif ($inexport_subclass ne $required_inexport_subclass)
188 {
189 print STDERR "Error! You cannot specify arguments from two different extention specific inexport modules: " . $inexport_subclass . " != " . $required_inexport_subclass . "\n";
190 exit;
191 }
192 }
193 }
[22459]194
[27305]195 my $inexport;
196 if (defined $inexport_subclass)
197 {
198 print "* Loading Overriding InExport Module: " . $inexport_subclass . "\n";
199 require $inexport_subclass . '.pm';
200 $inexport = new $inexport_subclass("import",\@ARGV,$options);
201 }
202 # We don't have a overridden inexport, or the above command failed somehow
203 # so load the base inexport class
204 if (!defined $inexport)
205 {
206 $inexport = new inexport("import",\@ARGV,$options);
207 }
208
209 my $collection = $inexport->get_collection();
210
211 if (defined $collection)
212 {
213 my ($config_filename,$collect_cfg) = $inexport->read_collection_cfg($collection,$options);
214
[28639]215 #$inexport->set_collection_options($collect_cfg);
216 &set_collection_options($inexport, $collect_cfg);
[27305]217
218 my $pluginfo = $inexport->process_files($config_filename,$collect_cfg);
219
220 $inexport->generate_statistics($pluginfo);
221 }
222
223 $inexport->deinit();
224}
225# main()
226
227# @function _scanForSubclasses()
228# @param $dir The extension directory to look within
229# @param $exts A list of the available extensions (as a colon separated string)
230# @return The number of subclasses of InExport found as an Integer
231sub _scanForSubclasses
232{
233 my ($dir, $exts) = @_;
234 my $inexport_class_count = 0;
235 my $ext_prefix = &FileUtils::filenameConcatenate($dir, "ext");
236 my @extensions = split(/:/, $exts);
237 foreach my $e (@extensions)
238 {
239 # - any subclass of InExport must be prefixed with the name of the ext
240 my $package_name = $e . 'inexport';
241 $package_name =~ s/[^a-z]//gi; # package names have limited characters
242 my $inexport_filename = $package_name . '.pm';
243 my $inexport_path = &FileUtils::filenameConcatenate($ext_prefix, $e, 'perllib', $inexport_filename);
244 # see if we have a subclass of InExport lurking in that extension folder
245 if (-f $inexport_path)
246 {
247 # - note we load the filename (with pm) unlike normal modules
248 require $inexport_filename;
249 # - make call to the newly created package
250 my $symbol = qualify('getSupportedArguments', $package_name);
251 # - strict prevents strings being used as function calls, so temporarily
252 # disable that pragma
253 no strict;
254 # - lets check that the function we are about to call actually exists
255 if ( defined &{$symbol} )
256 {
257 my $extra_arguments = &{$symbol}();
258 foreach my $argument (@{$extra_arguments})
259 {
260 # - record a mapping from each extra arguments to the inexport class
261 # that supports it. We put the hyphen on here to make comparing
262 # with command line arguments even easier
263 $function_to_inexport_subclass_mappings->{'-' . $argument->{'name'}} = $package_name;
264 # - and them add them as acceptable arguments to import.pl
265 push(@{$options->{'args'}}, $argument);
266 }
267 $inexport_class_count++;
268 }
269 else
270 {
271 print "Warning! A subclass of InExport module (named '" . $inexport_filename . "') does not implement the required getSupportedArguments() function - ignoring. Found in: " . $inexport_path . "\n";
272 }
[22459]273 }
[27305]274 }
275 return $inexport_class_count;
[22413]276}
[27305]277# _scanForInExportModules()
[14031]278
[28639]279# look up collect.cfg for import options, then all inexport version for the
280# common ones
281sub set_collection_options
282{
283
284 my ($inexport, $collectcfg) = @_;
[28640]285 my $out = $inexport->{'out'};
[28639]286
[28703]287 # check all options for default_optname - this will be set if the parsing
288 # code has just set the value based on the arg default. In this case,
289 # check in collect.cfg for the option
290
291 # groupsize can only be defined for import, not export, and actually only
292 # applies to GreenstoneXML format.
293 if (defined $inexport->{'default_groupsize'}) {
[28639]294 if (defined $collectcfg->{'groupsize'} && $collectcfg->{'groupsize'} =~ /\d+/) {
295 $inexport->{'groupsize'} = $collectcfg->{'groupsize'};
296 }
[28703]297
[28639]298 }
[28703]299 if (defined $inexport->{'default_saveas'}) {
[28639]300 if (defined $collectcfg->{'saveas'}
301 && $collectcfg->{'saveas'} =~ /^(GreenstoneXML|GreenstoneMETS)$/) {
302 $inexport->{'saveas'} = $collectcfg->{'saveas'};
303 } else {
304 $inexport->{'saveas'} = "GreenstoneXML"; # the default
305 }
306 }
307
308 my $sortmeta = $inexport->{'sortmeta'};
[28703]309 if (defined $collectcfg->{'sortmeta'} && $sortmeta eq "") {
[28639]310 $sortmeta = $collectcfg->{'sortmeta'};
311 }
312 # sortmeta cannot be used with group size
313 $sortmeta = undef unless defined $sortmeta && $sortmeta =~ /\S/;
314 if (defined $sortmeta && $inexport->{'groupsize'} > 1) {
315 &gsprintf($out, "{import.cannot_sort}\n\n");
316 $sortmeta = undef;
317 }
318 if (defined $sortmeta) {
319 &gsprintf($out, "{import.sortmeta_paired_with_ArchivesInfPlugin}\n\n");
320 }
321 $inexport->{'sortmeta'} = $sortmeta;
322
323 if (defined $collectcfg->{'removeprefix'} && $inexport->{'removeprefix'} eq "") {
324 $inexport->{'removeprefix'} = $collectcfg->{'removeprefix'};
325 }
326
327 if (defined $collectcfg->{'removesuffix'} && $inexport->{'removesuffix'} eq "") {
328 $inexport->{'removesuffix'} = $collectcfg->{'removesuffix'};
329 }
330
331 $inexport->set_collection_options($collectcfg);
332
333}
[22413]334&main();
Note: See TracBrowser for help on using the repository browser.