[med-svn] r1082 - in trunk/packages/minc/trunk: Getopt-Tabular-0.3 debian debian/patches
smr at alioth.debian.org
smr at alioth.debian.org
Tue Jan 8 06:33:53 UTC 2008
Author: smr
Date: 2008-01-08 06:33:53 +0000 (Tue, 08 Jan 2008)
New Revision: 1082
Removed:
trunk/packages/minc/trunk/Getopt-Tabular-0.3/Tabular.pm
trunk/packages/minc/trunk/debian/patches/04_progs-use-lib.diff
Modified:
trunk/packages/minc/trunk/debian/changelog
trunk/packages/minc/trunk/debian/control
trunk/packages/minc/trunk/debian/rules
Log:
Remove private copy of Tabular.pm from Getopt-Tabular 0.3,
use the new libgetopt-tabular-perl package, instead.
Thanks to Charles Plessy for getting libgetopt-tabular-perl
into Debian.
Deleted: trunk/packages/minc/trunk/Getopt-Tabular-0.3/Tabular.pm
===================================================================
--- trunk/packages/minc/trunk/Getopt-Tabular-0.3/Tabular.pm 2008-01-07 02:43:07 UTC (rev 1081)
+++ trunk/packages/minc/trunk/Getopt-Tabular-0.3/Tabular.pm 2008-01-08 06:33:53 UTC (rev 1082)
@@ -1,913 +0,0 @@
-package Getopt::Tabular;
-
-#
-# Getopt/Tabular.pm
-#
-# Perl module for table-driven argument parsing, somewhat like Tk's
-# ParseArgv. To use the package, you just have to set up an argument table
-# (a list of array references), and call &GetOptions (the name is exported
-# from the module). &GetOptions takes two or three arguments; a reference
-# to your argument table (which is not modified), a reference to the list
-# of command line arguments, e.g. @ARGV (or a copy of it), and (optionally)
-# a reference to a new empty array. In the two argument form, the second
-# argument is modified in place to remove all options and their arguments.
-# In the three argument form, the second argument is unmodified, and the
-# third argument is set to a copy of it with options removed.
-#
-# The argument table consists of one element per valid command-line option;
-# each element should be a reference to a list of the form:
-#
-# ( option_name, type, num_values, option_data, help_string, arg_desc )
-#
-# See Getopt/Tabular.pod for complete information.
-#
-# originally by Greg Ward 1995/07/06-07/09 as ParseArgs.pm
-# renamed to Getopt::Tabular and somewhat reorganized/reworked,
-# 1996/11/08-11/10
-#
-# $Id: Tabular.pm,v 1.8 1999/04/08 01:11:24 greg Exp $
-
-# Copyright (c) 1995-98 Greg Ward. All rights reserved. This package is
-# free software; you can redistribute it and/or modify it under the same
-# terms as Perl itself.
-
-require Exporter;
-use Carp;
-
-use strict;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-use vars qw/%Patterns %OptionHandlers %TypeDescriptions @OptionPatterns
- %SpoofCode $OptionTerminator $HelpOption
- $LongHelp $Usage $ErrorClass $ErrorMessage/;
-
-$VERSION = 0.3;
- at ISA = qw/Exporter/;
- at EXPORT = qw/GetOptions/;
- at EXPORT_OK = qw/SetHelp SetHelpOption SetError GetError SpoofGetOptions/;
-
-# -------------------------------------------------------------------- #
-# Private global variables #
-# -------------------------------------------------------------------- #
-
-
-# The regexp for floating point numbers here is a little more permissive
-# than the C standard -- it recognizes "0", "0.", ".0", and "0.0" (where 0
-# can be substituted by any string of one or more digits), preceded by an
-# optional sign, and followed by an optional exponent.
-
-%Patterns = ('integer' => '[+-]?\d+',
- 'float' => '[+-]? ( \d+(\.\d*)? | \.\d+ ) ([Ee][+-]?\d+)?',
- 'string' => '.*');
-
-
-# This hash defines the allowable option types, and what to do when we
-# see an argument of a given type in the argument list. New types
-# can be added by calling AddType, as long as you supply an option
-# handler that acts like one of the existing handlers. (Ie. takes
-# the same three arguments, returns 1 for success and 0 for failure,
-# and calls SetError appropriately.)
-
-%OptionHandlers = ("string", \&process_pattern_option,
- "integer", \&process_pattern_option,
- "float", \&process_pattern_option,
- "boolean", \&process_boolean_option,
- "const", \&process_constant_option,
- "copy", \&process_constant_option,
- "arrayconst",\&process_constant_option,
- "hashconst", \&process_constant_option,
- "call", \&process_call_option,
- "eval", \&process_eval_option,
- "section", undef);
-
-# This hash is used for building error messages for pattern types. A
-# subtle point is that the description should be such that it can be
-# pluralized by adding an "s". OK, OK, you can supply an alternate
-# plural form by making the description a reference to a two-element list,
-# singular and plural forms. I18N fanatics should be happy.
-
-%TypeDescriptions = ("integer" => "integer",
- "float" => "floating-point number",
- "string" => "string");
-
- at OptionPatterns = ('(-)(\w+)'); # two parts: "prefix" and "body"
-$OptionTerminator = "--";
-$HelpOption = "-help";
-
-# The %SpoofCode hash is for storing alternate versions of callbacks
-# for call or eval options. The alternate versions should have no side
-# effects apart from changing the argument list identically to their
-# "real" alternatives.
-
-%SpoofCode = ();
-
-$ErrorClass = ""; # can be "bad_option", "bad_value",
- # "bad_eval", or "help"
-$ErrorMessage = ""; # can be anything
-
-# -------------------------------------------------------------------- #
-# Public (but not exported) subroutines used to set options before #
-# calling GetOptions. #
-# -------------------------------------------------------------------- #
-
-sub SetHelp
-{
- $LongHelp = shift;
- $Usage = shift;
-}
-
-sub SetOptionPatterns
-{
- @OptionPatterns = @_;
-}
-
-sub SetHelpOption
-{
- $HelpOption = shift;
-}
-
-sub SetTerminator
-{
- $OptionTerminator = shift;
-}
-
-sub UnsetTerminator
-{
- undef $OptionTerminator;
-}
-
-sub AddType
-{
- my ($type, $handler) = @_;
- croak "AddType: \$handler must be a code ref"
- unless ref $handler eq 'CODE';
- $OptionHandlers{$type} = $handler;
-}
-
-sub AddPatternType
-{
- my ($type, $pattern, $description) = @_;
- $OptionHandlers{$type} = \&process_pattern_option;
- $Patterns{$type} = $pattern;
- $TypeDescriptions{$type} = ($description || $type);
-}
-
-sub GetPattern
-{
- my ($type) = @_;
- $Patterns{$type};
-}
-
-sub SetSpoofCodes
-{
- my ($option, $code);
- croak "Even number of arguments required"
- unless (@_ > 0 && @_ % 2 == 0);
-
- while (@_)
- {
- ($option, $code) = (shift, shift);
- $SpoofCode{$option} = $code;
- }
-}
-
-sub SetError
-{
- $ErrorClass = shift;
- $ErrorMessage = shift;
-}
-
-sub GetError
-{
- ($ErrorClass, $ErrorMessage);
-}
-
-# --------------------------------------------------------------------
-# Private utility subroutines:
-# quote_strings
-# print_help
-# scan_table
-# match_abbreviation
-# option_error
-# check_value
-# split_option
-# find_calling_package
-# --------------------------------------------------------------------
-
-
-#
-# "e_strings
-#
-# prepares strings for printing in a list of default values (for the
-# help text). If a string is empty or contains whitespace, it is quoted;
-# otherwise, it is left alone. The input list of strings is returned
-# concatenated into a single space-separated string. This is *not*
-# rigorous by any stretch; it's just to make the help text look nice.
-#
-sub quote_strings
-{
- my @strings = @_;
- my $string;
- foreach $string (@strings)
- {
- $string = qq["$string"] if ($string eq '' || $string =~ /\s/);
- }
- return join (' ', @strings);
-}
-
-
-#
-# &print_help
-#
-# walks through an argument table and prints out nicely-formatted
-# option help for all entries that provide it. Also does the Right Thing
-# (trust me) if you supply "argument description" text after the help.
-#
-# Don't read this code if you can possibly avoid it. It's pretty gross.
-#
-sub print_help
-{
- confess ("internal error, wrong number of input args to &print_help")
- if (scalar (@_) != 1);
- my ($argtable) = @_;
- my ($maxoption, $maxargdesc, $numcols, $opt, $breakers);
- my ($textlength, $std_format, $alt_format);
- my ($option, $type, $num, $value, $help, $argdesc);
-
- $maxoption = 0;
- $maxargdesc = 0;
-
- # Loop over all options to determine the length of the longest option name
- foreach $opt (@$argtable)
- {
- my ($argdesclen, $neg_option);
- my ($option, $type, $help, $argdesc) = @{$opt} [0,1,4,5];
- next if $type eq "section" or ! defined $help;
-
- # Boolean options contribute *two* lines to the help: one for the
- # option, and one for its negative. Other options just contribute
- # one line, so they're a bit simpler.
- if ($type eq 'boolean')
- {
- my ($pos, $neg) = &split_option ($opt);
- my $pos_len = length ($pos);
- my $neg_len = length ($neg);
- $maxoption = $pos_len if ($pos_len > $maxoption);
- $maxoption = $neg_len if ($pos_len > $maxoption);
- carp "Getopt::Tabular: argument descriptions ignored " .
- "for boolean option \"$option\""
- if defined $argdesc;
- }
- else
- {
- my $optlen = length ($option);
- $maxoption = $optlen if ($optlen > $maxoption);
-
- if (defined $argdesc)
- {
- $argdesclen = length ($argdesc);
- $maxargdesc = $argdesclen if ($argdesclen > $maxargdesc);
- }
- }
- }
-
- # We need to construct and eval code that looks something like this:
- # format STANDARD =
- # @<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- # $option, $help
- # ~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- # $help
- # .
- #
- # with an alternative format like this:
- # format ALTERNATIVE =
- # @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- # $option, $argdesc
- # ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- # $help
- # ~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- # $help
- # .
- # in order to nicely print out the help. Can't hardcode a format,
- # though, because we don't know until now how much space to allocate
- # for the option (ie. $maxoption).
-
- local $: = " \n";
- local $~;
-
- $numcols = 80; # not always accurate, but faster!
-
- # width of text = width of terminal, with columns removed as follows:
- # 3 (for left margin), $maxoption (option names), 2 (gutter between
- # option names and help text), and 2 (right margin)
- $textlength = $numcols - 3 - $maxoption - 2 - 2;
- $std_format = "format STANDARD =\n" .
- " @" . ("<" x $maxoption) . " ^" . ("<" x ($textlength-1)) . "\n".
- "\$option, \$help\n" .
- "~~ " . (" " x $maxoption) . " ^" . ("<" x ($textlength-1)) . "\n" .
- "\$help\n.";
- $alt_format = "format ALTERNATIVE =\n" .
- " @" . ("<" x ($maxoption + $maxargdesc)) . "\n" .
- "\$option\n" .
- " " . (" " x $maxoption) . " ^" . ("<" x ($textlength-1)) . "\n" .
- "\$help\n" .
- "~~ " . (" " x $maxoption) . " ^" . ("<" x ($textlength-1)) . "\n" .
- "\$help\n.";
-
- eval $std_format;
- confess ("internal error with format \"$std_format\": $@") if $@;
- eval $alt_format;
- confess ("internal error with format \"$alt_format\": $@") if $@;
-
- my $show_defaults = 1;
-
- print $LongHelp . "\n" if defined $LongHelp;
- print "Summary of options:\n";
- foreach $opt (@$argtable)
- {
- ($option, $type, $num, $value, $help, $argdesc) = @$opt;
-
- if ($type eq "section")
- {
- printf "\n-- %s %s\n", $option, "-" x ($numcols-4-length($option));
- next;
- }
-
- next unless defined $help;
- $argdesc = "" unless defined $argdesc;
-
- my $show_default = $show_defaults && $help !~ /\[default/;
-
- $~ = 'STANDARD';
- if ($type eq 'boolean')
- {
- undef $option; # arg! why is this necessary?
- my ($pos, $neg) = &split_option ($opt);
- $option = $pos;
- $help .= ' [default]'
- if $show_default && defined $$value && $$value;
- write;
- $help = "opposite of $pos";
- $help .= ' [default]'
- if $show_default && defined $$value && ! $$value;
- $option = $neg;
- write;
- }
- else
- {
- # If the option type is of the argument-taking variety, then
- # we'll try to help out by saying what the default value(s)
- # is/are
- if ($OptionHandlers{$type} == \&process_pattern_option)
- {
- if ($num == 1) # expectes a scalar value
- {
- $help .= ' [default: ' . quote_strings ($$value) . ']'
- if ($show_default && defined $$value);
- }
- else # expects a vector value
- {
- $help .= ' [default: ' . quote_strings (@$value) . ']'
- if ($show_default &&
- @$value && ! grep (! defined $_, @$value));
- }
- }
-
- if ($argdesc)
- {
- my $expanded_option = $option . " " . $argdesc if $argdesc;
- $option = $expanded_option;
-
- if (length ($expanded_option) > $maxoption+1)
- {
- $~ = 'ALTERNATIVE';
- }
- }
- write;
- }
- }
-
- print "\n";
- print $Usage if defined $Usage;
-}
-
-
-#
-# &scan_table
-#
-# walks through an argument table, building a hash that lets us quickly
-# and painlessly look up an option.
-#
-sub scan_table
-{
- my ($argtable, $arghash) = @_;
- my ($opt, $option, $type, $value);
-
- my $i;
- for $i (0 .. $#$argtable)
- {
- $opt = $argtable->[$i];
- ($option, $type, $value) = @$opt;
- unless (exists $OptionHandlers{$type})
- {
- croak "Unknown option type \"$type\" supplied for option $option";
- }
-
- if ($type eq "boolean")
- {
- my ($pos,$neg) = &split_option($opt);
- $arghash->{$pos} = $i;
- $arghash->{$neg} = $i if defined $neg;
- }
- elsif ($type ne "section")
- {
- $arghash->{$option} = $i;
- }
- }
-}
-
-
-#
-# &match_abbreviation
-#
-# Given a string $s and a list of words @$words, finds the word for which
-# $s is a non-ambiguous abbreviation. If $s is found to be ambiguous or
-# doesn't match, a clear and concise error message is printed, using
-# $err_format as a format for sprintf. Suggested form for $err_format is
-# "%s option: %s"; the first %s will be substituted with either "ambiguous"
-# or "unknown" (depending on the problem), and the second will be
-# substituted with $s. Thus, with this format, the error message will look
-# something like "unknown option: -foo" or "ambiguous option: -f".
-#
-sub match_abbreviation
-{
- my ($s, $words, $err_format) = @_;
- my ($match);
-
- my $word;
- foreach $word (@$words)
- {
- # If $s is a prefix of $word, it's at least an approximate match,
- # so try to do better
-
- next unless ($s eq substr ($word, 0, length ($s)));
-
- # We have an exact match, so return it now
-
- return $word if ($s eq $word);
-
- # We have an approx. match, and already had one before
-
- if ($match)
- {
- &SetError ("bad_option", sprintf ("$err_format", "ambiguous", $s));
- return 0;
- }
-
- $match = $word;
- }
- &SetError ("bad_option", sprintf ("$err_format", "unknown", $s))
- if !$match;
- $match;
-}
-
-
-#
-# &option_error
-#
-# Constructs a useful error message to deal with an option that expects
-# a certain number of values of certain types, but a command-line that
-# falls short of this mark. $option should be the option that triggers
-# the situation; $type should be the expected type; $n should be the
-# number of values expected.
-#
-# The error message (returned by the function) will look something like
-# "-foo option must be followed by an integer" (yes, it does pick "a"
-# or "an", depending on whether the description of the type starts
-# with a vowel) or "-bar option must be followed by 3 strings".
-#
-# The error message is put in the global $ErrorMessage, as well as returned
-# by the function. Also, the global $ErrorClass is set to "bad_value".
-#
-sub option_error
-{
- my ($option, $type, $n) = @_;
- my ($typedesc, $singular, $plural, $article, $desc);
-
- $typedesc = $TypeDescriptions{$type};
- ($singular,$plural) = (ref $typedesc eq 'ARRAY')
- ? @$typedesc
- : ($typedesc, $typedesc . "s");
-
- $article = ($typedesc =~ /^[aeiou]/) ? "an" : "a";
- $desc = ($n > 1) ?
- "$n $plural" :
- "$article $singular";
- &SetError ("bad_value", "$option option must be followed by $desc");
-}
-
-
-#
-# &check_value
-#
-# Verifies that a value (presumably from the command line) satisfies
-# the requirements for the expected type.
-#
-# Calls &option_error (to set $ErrorClass and $ErrorMessage globals) and returns
-# 0 if the value isn't up to scratch.
-#
-sub check_value
-{
- my ($val, $option, $type, $n) = @_;
-
- unless (defined $val && $val =~ /^$Patterns{$type}$/x)
- {
- &option_error ($option, $type, $n);
- return 0;
- }
-}
-
-
-#
-# &split_option
-#
-# Splits a boolean option into positive and negative alternatives. The
-# two alternatives are returned as a two-element array.
-#
-# Croaks if it can't figure out the alternatives, or if there appear to be
-# more than 2 alternatives specified.
-#
-sub split_option
-{
- my ($opt_desc) = @_;
- my ($option, @options);
-
- $option = $opt_desc->[0];
- return ($option) if $opt_desc->[1] ne "boolean";
-
- @options = split ('\|', $option);
-
- if (@options == 2)
- {
- return @options;
- }
- elsif (@options == 1)
- {
- my ($pattern, $prefix, $positive_alt, $negative_alt);
- for $pattern (@OptionPatterns)
- {
- my ($prefix, $body);
- if (($prefix, $body) = $option =~ /^$pattern$/)
- {
- $negative_alt = $prefix . "no" . $body;
- return ($option, $negative_alt);
- }
- }
- croak "Boolean option \"$option\" did not match " .
- "any option prefixes - unable to guess negative alternative";
- return ($option);
- }
- else
- {
- croak "Too many alternatives supplied for boolean option \"$option\"";
- }
-}
-
-
-#
-# &find_calling_package
-#
-# walks up the call stack until we find a caller in a different package
-# from the current one. (Handy for `eval' options, when we want to
-# eval a chunk of code in the package that called GetOptions.)
-#
-sub find_calling_package
-{
- my ($i, $this_pkg, $up_pkg, @caller);
-
- $i = 0;
- $this_pkg = (caller(0))[0];
- while (@caller = caller($i++))
- {
- $up_pkg = $caller[0];
- last if $up_pkg ne $this_pkg;
- }
- $up_pkg;
-}
-
-
-# ----------------------------------------------------------------------
-# Option-handling routines:
-# process_constant_option
-# process_boolean_option
-# process_call_option
-# process_eval_option
-# ----------------------------------------------------------------------
-
-# General description of these routines:
-# * each one is passed exactly four options:
-# $arg - the argument that triggered this routine, expanded
-# into unabbreviated form
-# $arglist - reference to list containing rest of command line
-# $opt_desc - reference to an option descriptor list
-# $spoof - flag: if true, then no side effects
-# * they are called from GetOptions, through code references in the
-# %OptionHandlers hash
-# * if they return a false value, then GetOptions immediately returns
-# 0 to its caller, with no error message -- thus, the option handlers
-# should print out enough of an error message for the end user to
-# figure out what went wrong; also, the option handlers should be
-# careful to explicitly return 1 if everything went well!
-
-sub process_constant_option
-{
- my ($arg, $arglist, $opt_desc, $spoof) = @_;
- my ($type, $n, $value) = @$opt_desc[1,2,3];
-
- return 1 if $spoof;
-
- if ($type eq "const")
- {
- $$value = $n;
- }
- elsif ($type eq "copy")
- {
- $$value = (defined $n) ? ($n) : ($arg);
- }
- elsif ($type eq "arrayconst")
- {
- @$value = @$n;
- }
- elsif ($type eq "hashconst")
- {
- %$value = %$n;
- }
- else
- {
- confess ("internal error: can't handle option type \"$type\"");
- }
-
- 1;
-}
-
-
-sub process_boolean_option
-{
- my ($arg, $arglist, $opt_desc, $spoof) = @_;
- my ($value) = $$opt_desc[3];
-
- return 1 if $spoof;
-
- my ($pos,$neg) = &split_option ($opt_desc);
- confess ("internal error: option $arg not found in argument hash")
- if ($arg ne $pos && $arg ne $neg);
-
- $$value = ($arg eq $pos) ? 1 : 0;
- 1;
-}
-
-
-sub process_call_option
-{
- my ($arg, $arglist, $opt_desc, $spoof) = @_;
- my ($option, $args, $value) = @$opt_desc[0,2,3];
-
- croak "Invalid option table entry for option \"$option\" -- \"value\" " .
- "field must be a code reference"
- unless (ref $value eq 'CODE');
-
- # This will crash 'n burn big time if there is no spoof code for
- # this option -- but that's why we check %SpoofCode against the
- # arg table from GetOptions!
-
- $value = $SpoofCode{$arg} if ($spoof);
-
- my @args = (ref $args eq 'ARRAY') ? (@$args) : ();
- my $result = &$value ($arg, $arglist, @args);
- if (!$result)
- {
- # Wouldn't it be neat if we could get the sub name from the code ref?
- &SetError
- ($ErrorClass || "bad_call",
- $ErrorMessage || "subroutine call from option \"$arg\" failed");
- }
-
- return $result;
-
-} # &process_call_option
-
-
-sub process_eval_option
-{
- my ($arg, $arglist, $opt_desc, $spoof) = @_;
- my ($value) = $$opt_desc[3];
-
- $value = $SpoofCode{$arg} if ($spoof);
-
- my $up_pkg = &find_calling_package ();
-# print "package $up_pkg; $value"; # DEBUG ONLY
- my $result = eval "package $up_pkg; no strict; $value";
-
- if ($@) # any error string set?
- {
- &SetError ("bad_eval",
- "error evaluating \"$value\" (from $arg option): $@");
- return 0;
- }
-
- if (!$result)
- {
- &SetError
- ($ErrorClass || "bad_call",
- $ErrorMessage || "code eval'd for option \"$arg\" failed");
- }
-
- return $result;
-}
-
-
-sub process_pattern_option
-{
- my ($arg, $arglist, $opt_desc, $spoof) = @_;
- my ($type, $n, $value) = @$opt_desc[1,2,3];
- my ($dummy, @dummies);
-
- # This code looks a little more complicated than you might at first
- # think necessary. But the ugliness is necessary because $value might
- # reference a scalar or an array, depending on whether $n is 1 (scalar)
- # or not (array). Thus, we can't just assume that either @$value or
- # $$value is valid -- we always have to check which of the two it should
- # be.
-
- if ($n == 1) # scalar-valued option (one argument)
- {
- croak "GetOptions: \"$arg\" option must be associated with a scalar ref"
- unless ref $value eq 'SCALAR';
- $value = \$dummy if $spoof;
- $$value = shift @$arglist;
- return 0 unless &check_value ($$value, $arg, $type, $n);
- }
- else # it's a "vector-valued" option
- { # (fixed number of arguments)
- croak "GetOptions: \"$arg\" option must be associated with an array ref"
- unless ref $value eq 'ARRAY';
- $value = \@dummies if $spoof;
- @$value = splice (@$arglist, 0, $n);
- if (scalar @$value != $n)
- {
- &option_error ($arg, $type, $n);
- return 0;
- }
-
- my $val;
- foreach $val (@$value)
- {
- return 0 unless &check_value ($val, $arg, $type, $n);
- }
- } # else
-
- return 1;
-
-} # &process_pattern_option
-
-
-# --------------------------------------------------------------------
-# The main public subroutine: GetOptions
-# --------------------------------------------------------------------
-
-sub GetOptions
-{
- my ($opt_table, $arglist, $new_arglist, $spoof) = @_;
- my (%argpos, $arg, $pos, $opt_ref);
- my ($option_re, @option_list);
-
- $new_arglist = $arglist if !defined $new_arglist;
- &SetError ("", "");
-
- # Build a hash mapping option -> position in option table
-
- &scan_table ($opt_table, \%argpos);
-
- # Regexp to let us recognize options on the command line
-
- $option_re = join ("|", @OptionPatterns);
-
- # Build a list of all acceptable options -- used to match abbreviations
-
- my $opt_desc;
- foreach $opt_desc (@$opt_table)
- {
- push (@option_list, &split_option ($opt_desc))
- unless $opt_desc->[1] eq "section";
- }
- push (@option_list, $HelpOption) if $HelpOption;
-
- # If in spoof mode: make sure we have spoof code for all call/eval options
-
- if ($spoof)
- {
- my ($opt, $type, $spoof);
-
- foreach $opt_desc (@$opt_table)
- {
- $opt = $opt_desc->[0];
- $type = $opt_desc->[1];
- $spoof = $SpoofCode{$opt};
-
- next unless $type eq 'call' || $type eq 'eval';
- croak "No alternate code supplied for option $opt in spoof mode"
- unless defined $spoof;
- croak "Alternate code must be a CODE ref for option $opt"
- if ($type eq 'call' && ref $spoof ne 'CODE');
- croak "Alternate code must be a string for option $opt"
- if ($type eq 'eval' && ref $spoof);
- }
- }
-
- # Now walk over the argument list
-
- my @tmp_arglist = @$arglist;
- @$new_arglist = ();
- while (defined ($arg = shift @tmp_arglist))
- {
-# print "arg: $arg\n";
-
- # If this argument is the option terminator (usually "--") then
- # transfer all remaining arguments to the new arg list and stop
- # processing immediately.
-
- if (defined $OptionTerminator && $arg eq $OptionTerminator)
- {
- push (@$new_arglist, @tmp_arglist);
- last;
- }
-
- # If this argument isn't an option at all, just append it to
- # @$new_arglist and go to the next one.
-
- if ($arg !~ /^($option_re)/o)
- {
- push (@$new_arglist, $arg);
- next;
- }
-
- # We know we have something that looks like an option; see if it
- # matches or is an abbreviation for one of the strings in
- # @option_list
-
- $arg = &match_abbreviation ($arg, \@option_list, "%s option: %s");
- if (! $arg)
- {
- warn $Usage if defined $Usage;
- warn "$ErrorMessage\n";
- return 0;
- }
-
- # If it's the help option, print out the help and return
- # (even if in spoof mode!)
-
- if ($arg eq $HelpOption)
- {
- &print_help ($opt_table);
- &SetError ("help", "");
- return 0;
- }
-
- # Now we know it's a valid option, and it's not the help option --
- # so it must be in the caller's option table. Look up its
- # entry there, and use that for the actual option processing.
-
- $pos = $argpos{$arg};
- confess ("internal error: didn't find arg in arg hash even " .
- "after resolving abbreviation")
- unless defined $pos;
-
- my $opt_desc = $opt_table->[$pos];
- my $type = $opt_desc->[1];
- my $handler = $OptionHandlers{$type};
-
- if (defined $handler && ref ($handler) eq 'CODE')
- {
- if (! &$handler ($arg, \@tmp_arglist, $opt_desc, $spoof))
- {
- warn $Usage if defined $Usage;
- warn "$ErrorMessage\n";
- return 0;
- }
- }
- else
- {
- croak "Unknown option type \"$type\" (found for arg $arg)";
- }
- } # while ($arg = shift @$arglist)
-
- return 1;
-
-} # GetOptions
-
-
-sub SpoofGetOptions
-{
- &GetOptions (@_[0..2], 1);
-}
-
-1;
Modified: trunk/packages/minc/trunk/debian/changelog
===================================================================
--- trunk/packages/minc/trunk/debian/changelog 2008-01-07 02:43:07 UTC (rev 1081)
+++ trunk/packages/minc/trunk/debian/changelog 2008-01-08 06:33:53 UTC (rev 1082)
@@ -1,3 +1,12 @@
+minc (2.0.14-2) UNRELEASED; urgency=low
+
+ * control: Package minc-tools depends on libgetopt-tabular-perl.
+ * rules: Don't install Tabular.pm.
+ * Getopt-Tabular-0.3/Tabular.pm: Remove.
+ * debian/patches/04_progs-use-lib.diff: Remove.
+
+ -- Steve M. Robbins <smr at debian.org> Tue, 08 Jan 2008 00:09:21 -0600
+
minc (2.0.14-1) unstable; urgency=low
* New upstream version. Closes: #450922.
Modified: trunk/packages/minc/trunk/debian/control
===================================================================
--- trunk/packages/minc/trunk/debian/control 2008-01-07 02:43:07 UTC (rev 1081)
+++ trunk/packages/minc/trunk/debian/control 2008-01-08 06:33:53 UTC (rev 1082)
@@ -10,7 +10,7 @@
Package: minc-tools
Architecture: any
-Depends: ${shlibs:Depends}, csh | c-shell, netcdf-bin, libtext-format-perl, imagemagick
+Depends: ${shlibs:Depends}, csh | c-shell, netcdf-bin, libgetopt-tabular-perl, libtext-format-perl, imagemagick
Description: MNI medical image format tools
This package contains tools to manipulate MINC files.
.
Deleted: trunk/packages/minc/trunk/debian/patches/04_progs-use-lib.diff
===================================================================
--- trunk/packages/minc/trunk/debian/patches/04_progs-use-lib.diff 2008-01-07 02:43:07 UTC (rev 1081)
+++ trunk/packages/minc/trunk/debian/patches/04_progs-use-lib.diff 2008-01-08 06:33:53 UTC (rev 1082)
@@ -1,20 +0,0 @@
---- progs/mincpik/mincpik.old 2007-10-17 22:49:57.000000000 -0500
-+++ progs/mincpik/mincpik 2008-01-02 21:47:51.000000000 -0600
-@@ -16,6 +16,7 @@
-
- use strict;
- use warnings "all";
-+use lib "/usr/share/minc-tools";
- use Getopt::Tabular;
- use File::Basename;
- use File::Temp qw/ tempdir /;
---- progs/xfm/xfmflip.in.old 2007-08-23 20:31:03.000000000 -0500
-+++ progs/xfm/xfmflip.in 2008-01-02 21:49:04.000000000 -0600
-@@ -15,6 +15,7 @@
-
- use strict;
- use warnings "all";
-+use lib "/usr/share/minc-tools";
- use Getopt::Tabular;
- use File::Basename;
- use File::Temp qw/ tempdir /;
Modified: trunk/packages/minc/trunk/debian/rules
===================================================================
--- trunk/packages/minc/trunk/debian/rules 2008-01-07 02:43:07 UTC (rev 1081)
+++ trunk/packages/minc/trunk/debian/rules 2008-01-08 06:33:53 UTC (rev 1082)
@@ -19,7 +19,6 @@
$(MAKE) -C volume_io/Documentation docs
install/minc-tools::
- dh_install -pminc-tools Getopt-Tabular-0.3/Tabular.pm usr/share/minc-tools/Getopt
rm -f debian/tmp/usr/bin/mincexample?
dh_install -pminc-tools --autodest debian/tmp/usr/bin
dh_install -pminc-tools --autodest debian/tmp/usr/share/man
More information about the debian-med-commit
mailing list