#!/usr/bin/perl -w ########################################################################### # # classinfo.pl -- provide information about classifiers # # A component of the Greenstone digital library software # from the New Zealand Digital Library Project at the # University of Waikato, New Zealand. # # Copyright (C) 1999 New Zealand Digital Library Project # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # ########################################################################### use strict; no strict 'subs'; # allow barewords (eg STDERR) as function arguments BEGIN { die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'}; die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'}; unshift (@INC, "$ENV{'GSDLHOME'}/perllib"); unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan"); unshift (@INC, "$ENV{'GSDLHOME'}/perllib/classify"); } use classify; use util; use gsprintf; use printusage; use parse2; my $arguments = [ { 'name' => "collect", 'desc' => "{classinfo.collect}", 'type' => "string", 'deft' => "", 'reqd' => "no" }, { 'name' => "xml", 'desc' => "{scripts.xml}", 'type' => "flag", 'reqd' => "no" }, { 'name' => "listall", 'desc' => "{scripts.listall}", 'type' => "flag", 'reqd' => "no" }, { 'name' => "language", 'desc' => "{scripts.language}", 'type' => "string", 'reqd' => "no" } ]; my $options = { 'name' => "classinfo.pl", 'desc' => "{classinfo.desc}", 'args' => $arguments }; sub gsprintf { return &gsprintf::gsprintf(@_); } sub main { my $collect = ""; my $xml = 0; my $listall = 0; my $language; my $hashParsingResult = {}; my $blnParseFailed = "false"; # general options available to all plugins my $intArgLeftinAfterParsing = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options"); # If there are more than one argument left after parsing, it mean user input too many arguments. # Error occoured will return 0 if($intArgLeftinAfterParsing > 1) { &PrintUsage::print_txt_usage($options, "{classinfo.params}"); die "\n"; } foreach my $strVariable (keys %$hashParsingResult) { eval "\$$strVariable = \$hashParsingResult->{\"\$strVariable\"}"; } # If $language has been specified, load the appropriate resource bundle # (Otherwise, the default resource bundle will be loaded automatically) if ($language) { &gsprintf::load_language_specific_resource_bundle($language); } # Get classifier my $classifier = shift (@ARGV); if (defined $classifier) { $classifier =~ s/\.pm$//; # allow xxx.pm as the argument } if (($listall == 0) && (!defined $classifier || $classifier eq "")) { &gsprintf(STDERR, "{classinfo.no_classifier_name}\n\n"); &PrintUsage::print_txt_usage($options, "{classinfo.params}", 1); die "\n"; } # make sure the classifier is loaded from the correct location - a hack. if ($collect ne "") { $ENV{'GSDLCOLLECTDIR'} = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collect); } else { $ENV{'GSDLCOLLECTDIR'} = $ENV{'GSDLHOME'}; } if ($listall) { my $class_dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"perllib","classify"); if (!opendir (INDIR, $class_dir)) { print STDERR "classinfo.pl: could not open directory $class_dir\n"; } else { my @class_list = grep (/\.pm$/, readdir (INDIR)); closedir (INDIR); if ($xml) { my $num_class = scalar(@class_list); print STDERR "\n"; print STDERR "\n"; print STDERR " \n"; print STDERR " \n"; print STDERR "]>\n"; print STDERR "\n"; map { print STDERR " $_\n"; } @class_list; print STDERR "\n"; } else { print STDERR join(" ",@class_list), "\n"; } } } else { my $classobj = &classify::load_classifier_for_info ($classifier); if ($xml) { $classobj->print_xml_usage(); } else { &gsprintf(STDERR, "\n{classinfo.passing_options}\n\n"); &gsprintf(STDERR, "{classinfo.option_types}:\n\n"); &gsprintf(STDERR, "{classinfo.specific_options}\n\n"); &gsprintf(STDERR, "{classinfo.general_options}\n\n"); &gsprintf(STDERR, "$classifier {classinfo.info}:\n\n"); $classobj->print_txt_usage(); } } } &main ();