root/trunk/gsdl/bin/script/classinfo.pl @ 12640

Revision 12640, 5.7 KB (checked in by mdewsnip, 13 years ago)

Now returns valid XML instead of an error when -listall and -describeall is specified and the directory doesn't exist (usually collection-specific).

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
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
40use classify;
41use util;
42use gsprintf;
43use printusage;
44
45use parse2;
46
47my $arguments =
48    [ { 'name' => "collection",
49    'desc' => "{classinfo.collection}",
50    'type' => "string",
51    'deft' => "",
52    'reqd' => "no" },
53      { 'name' => "xml",
54    'desc' => "{scripts.xml}",
55    'type' => "flag",
56    'reqd' => "no" },
57      { 'name' => "listall",
58    'desc' => "{scripts.listall}",
59    'type' => "flag",
60    'reqd' => "no" },
61      { 'name' => "describeall",
62    'desc' => "{scripts.describeall}",
63    'type' => "flag",
64    'reqd' => "no" },
65      { 'name' => "language",
66    'desc' => "{scripts.language}",
67    'type' => "string",
68    'reqd' => "no" } ];
69
70my $options = { 'name' => "classinfo.pl",
71        'desc' => "{classinfo.desc}",
72        'args' => $arguments };
73
74sub gsprintf
75{
76    return &gsprintf::gsprintf(@_);
77}
78
79sub main {
80    my $collection = "";
81    my $xml = 0;
82    my $listall = 0;
83    my $describeall = 0;
84    my $language;
85
86    my $hashParsingResult = {};
87    # general options available to all classifiers
88    my $intArgLeftinAfterParsing = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options");
89    # parse returns -1 if an error occurred
90    if($intArgLeftinAfterParsing == -1)
91    {
92    &PrintUsage::print_txt_usage($options, "{classinfo.params}");
93    die "\n";
94    }
95
96    foreach my $strVariable (keys %$hashParsingResult)
97    {
98    eval "\$$strVariable = \$hashParsingResult->{\"\$strVariable\"}";
99    }
100    # If $language has been specified, load the appropriate resource bundle
101    # (Otherwise, the default resource bundle will be loaded automatically)
102    if ($language) {
103    &gsprintf::load_language_specific_resource_bundle($language);
104    }
105   
106    # If there is not exactly 1 argument left (classifier name), then the arguments were wrong
107    # If the user specified -h, then we output the usage also
108    if((@ARGV && $ARGV[0] =~ /^\-+h/) )
109    {
110    PrintUsage::print_txt_usage($options, "{classinfo.params}"); 
111        die "\n";
112    }
113
114    # If there is not exactly 1 argument left (classifier name), then the arguments were wrong (apart from if we had listall or describeall set)
115    if ($listall == 0 && $describeall ==0 && $intArgLeftinAfterParsing == 0) {
116    gsprintf(STDERR, "{classinfo.no_classifier_name}\n\n");
117    PrintUsage::print_txt_usage($options, "{classinfo.params}", 1);
118    die "\n";
119    }
120   
121    # we had some arguments that we weren't expecting
122    if ($intArgLeftinAfterParsing > 1) {
123    pop(@ARGV); # assume that the last arg is the classifier name
124    gsprintf(STDERR, "{common.invalid_options}\n\n", join (',', @ARGV));
125    PrintUsage::print_txt_usage($options, "{classinfo.params}", 1);
126    die "\n";
127    }
128
129    # Get classifier
130    my $classifier = shift (@ARGV);
131    if (defined $classifier) {
132    $classifier =~ s/\.pm$//; # allow xxx.pm as the argument
133    }
134
135    # make sure the classifier is loaded from the correct location - a hack.
136    if ($collection ne "") {
137    $ENV{'GSDLCOLLECTDIR'} = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
138    } else {
139    $ENV{'GSDLCOLLECTDIR'} = $ENV{'GSDLHOME'};
140    }
141 
142    if ($listall || $describeall) {
143    my $classify_dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "perllib", "classify");
144    my @classifier_list = ();
145    if (opendir (INDIR, $classify_dir)) {
146        @classifier_list = grep (/\.pm$/, readdir (INDIR));
147        closedir (INDIR);
148    }
149
150    print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
151    print STDERR "<ClassifyList length=\"" . scalar(@classifier_list) . "\">\n";
152    foreach my $classifier (@classifier_list) {
153        $classifier =~ s/\.pm$//;
154        my $classifierobj = &classify::load_classifier_for_info ($classifier);
155        if ($describeall) {
156        $classifierobj->print_xml_usage(0);
157        }
158        else {
159        $classifierobj->print_xml_usage(0, 1);
160        }
161    }
162    print STDERR "</ClassifyList>\n";
163    }
164    else {
165    &print_single_classifier($classifier, $xml, 1);
166    }
167}
168
169
170sub print_single_classifier {
171    my ($classifier, $xml, $header) = @_;
172    my $classobj = &classify::load_classifier_for_info ($classifier);
173    if ($xml) {
174    $classobj->print_xml_usage($header);
175    }
176    else {
177    &gsprintf(STDERR, "\n{classinfo.passing_options}\n\n");
178    &gsprintf(STDERR, "{classinfo.option_types}:\n\n");
179    &gsprintf(STDERR, "{classinfo.specific_options}\n\n");
180    &gsprintf(STDERR, "{classinfo.general_options}\n\n");
181    &gsprintf(STDERR, "$classifier {classinfo.info}:\n\n");
182   
183    $classobj->print_txt_usage();
184    }
185   
186}
187
188
189&main ();
Note: See TracBrowser for help on using the browser.