source: gsdl/trunk/bin/script/classinfo.pl@ 14942

Last change on this file since 14942 was 14942, checked in by davidb, 14 years ago

Modification to support extensions. BEGIN block now adds perllib/ perllib/cpan to @INC for each extension.

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 6.0 KB
Line 
1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# classinfo.pl -- provide information about classifiers
6#
7# A component of the Greenstone digital library software
8# from the New Zealand Digital Library Project at the
9# University of Waikato, New Zealand.
10#
11# Copyright (C) 1999 New Zealand Digital Library Project
12#
13# This program is free software; you can redistribute it and/or modify
14# it under the terms of the GNU General Public License as published by
15# the Free Software Foundation; either version 2 of the License, or
16# (at your option) any later version.
17#
18# This program is distributed in the hope that it will be useful,
19# but WITHOUT ANY WARRANTY; without even the implied warranty of
20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21# GNU General Public License for more details.
22#
23# You should have received a copy of the GNU General Public License
24# along with this program; if not, write to the Free Software
25# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
26#
27###########################################################################
28
29use strict;
30no strict 'subs'; # allow barewords (eg STDERR) as function arguments
31
32BEGIN {
33 die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
34 die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};
35 unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
36 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
37 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/classify");
38
39 if (defined $ENV{'GSDLEXTS'}) {
40 my @extensions = split(/:/,$ENV{'GSDLEXTS'});
41 foreach my $e (@extensions) {
42 my $ext_prefix = "$ENV{'GSDLHOME'}/ext/$e";
43
44 unshift (@INC, "$ext_prefix/perllib");
45 unshift (@INC, "$ext_prefix/perllib/cpan");
46 }
47 }
48}
49
50use classify;
51use util;
52use gsprintf;
53use printusage;
54
55use parse2;
56
57my $arguments =
58 [ { 'name' => "collection",
59 'desc' => "{classinfo.collection}",
60 'type' => "string",
61 'deft' => "",
62 'reqd' => "no" },
63 { 'name' => "xml",
64 'desc' => "{scripts.xml}",
65 'type' => "flag",
66 'reqd' => "no" },
67 { 'name' => "listall",
68 'desc' => "{scripts.listall}",
69 'type' => "flag",
70 'reqd' => "no" },
71 { 'name' => "describeall",
72 'desc' => "{scripts.describeall}",
73 'type' => "flag",
74 'reqd' => "no" },
75 { 'name' => "language",
76 'desc' => "{scripts.language}",
77 'type' => "string",
78 'reqd' => "no" } ];
79
80my $options = { 'name' => "classinfo.pl",
81 'desc' => "{classinfo.desc}",
82 'args' => $arguments };
83
84sub gsprintf
85{
86 return &gsprintf::gsprintf(@_);
87}
88
89sub main {
90 my $collection = "";
91 my $xml = 0;
92 my $listall = 0;
93 my $describeall = 0;
94 my $language;
95
96 my $hashParsingResult = {};
97 # general options available to all classifiers
98 my $intArgLeftinAfterParsing = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options");
99 # parse returns -1 if an error occurred
100 if($intArgLeftinAfterParsing == -1)
101 {
102 &PrintUsage::print_txt_usage($options, "{classinfo.params}");
103 die "\n";
104 }
105
106 foreach my $strVariable (keys %$hashParsingResult)
107 {
108 eval "\$$strVariable = \$hashParsingResult->{\"\$strVariable\"}";
109 }
110 # If $language has been specified, load the appropriate resource bundle
111 # (Otherwise, the default resource bundle will be loaded automatically)
112 if ($language) {
113 &gsprintf::load_language_specific_resource_bundle($language);
114 }
115
116 # If there is not exactly 1 argument left (classifier name), then the arguments were wrong
117 # If the user specified -h, then we output the usage also
118 if((@ARGV && $ARGV[0] =~ /^\-+h/) )
119 {
120 PrintUsage::print_txt_usage($options, "{classinfo.params}");
121 die "\n";
122 }
123
124 # If there is not exactly 1 argument left (classifier name), then the arguments were wrong (apart from if we had listall or describeall set)
125 if ($listall == 0 && $describeall ==0 && $intArgLeftinAfterParsing == 0) {
126 gsprintf(STDERR, "{classinfo.no_classifier_name}\n\n");
127 PrintUsage::print_txt_usage($options, "{classinfo.params}", 1);
128 die "\n";
129 }
130
131 # we had some arguments that we weren't expecting
132 if ($intArgLeftinAfterParsing > 1) {
133 pop(@ARGV); # assume that the last arg is the classifier name
134 gsprintf(STDERR, "{common.invalid_options}\n\n", join (',', @ARGV));
135 PrintUsage::print_txt_usage($options, "{classinfo.params}", 1);
136 die "\n";
137 }
138
139 # Get classifier
140 my $classifier = shift (@ARGV);
141 if (defined $classifier) {
142 $classifier =~ s/\.pm$//; # allow xxx.pm as the argument
143 }
144
145 # make sure the classifier is loaded from the correct location - a hack.
146 if ($collection ne "") {
147 $ENV{'GSDLCOLLECTDIR'} = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
148 } else {
149 $ENV{'GSDLCOLLECTDIR'} = $ENV{'GSDLHOME'};
150 }
151
152 if ($listall || $describeall) {
153 my $classify_dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "perllib", "classify");
154 my @classifier_list = ();
155 if (opendir (INDIR, $classify_dir)) {
156 @classifier_list = grep (/\.pm$/, readdir (INDIR));
157 closedir (INDIR);
158 }
159
160 print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
161 print STDERR "<ClassifyList length=\"" . scalar(@classifier_list) . "\">\n";
162 foreach my $classifier (@classifier_list) {
163 $classifier =~ s/\.pm$//;
164 my $classifierobj = &classify::load_classifier_for_info ($classifier);
165 if ($describeall) {
166 $classifierobj->print_xml_usage(0);
167 }
168 else {
169 $classifierobj->print_xml_usage(0, 1);
170 }
171 }
172 print STDERR "</ClassifyList>\n";
173 }
174 else {
175 &print_single_classifier($classifier, $xml, 1);
176 }
177}
178
179
180sub print_single_classifier {
181 my ($classifier, $xml, $header) = @_;
182 my $classobj = &classify::load_classifier_for_info ($classifier);
183 if ($xml) {
184 $classobj->print_xml_usage($header);
185 }
186 else {
187 &gsprintf(STDERR, "\n{classinfo.passing_options}\n\n");
188 &gsprintf(STDERR, "{classinfo.option_types}:\n\n");
189 &gsprintf(STDERR, "{classinfo.specific_options}\n\n");
190 &gsprintf(STDERR, "{classinfo.general_options}\n\n");
191 &gsprintf(STDERR, "$classifier {classinfo.info}:\n\n");
192
193 $classobj->print_txt_usage();
194 }
195
196}
197
198
199&main ();
Note: See TracBrowser for help on using the repository browser.