[med-svn] r1064 - in trunk/packages/minc/trunk: . Getopt-Tabular-0.3 debian debian/patches
smr at alioth.debian.org
smr at alioth.debian.org
Thu Jan 3 04:44:14 UTC 2008
Author: smr
Date: 2008-01-03 04:44:13 +0000 (Thu, 03 Jan 2008)
New Revision: 1064
Added:
trunk/packages/minc/trunk/Getopt-Tabular-0.3/
trunk/packages/minc/trunk/Getopt-Tabular-0.3/Tabular.pm
trunk/packages/minc/trunk/debian/libminc-dev.doc-base
trunk/packages/minc/trunk/debian/patches/03_mincview.diff
trunk/packages/minc/trunk/debian/patches/04_progs-use-lib.diff
Removed:
trunk/packages/minc/trunk/debian/libminc0-dev.doc-base
Modified:
trunk/packages/minc/trunk/debian/changelog
trunk/packages/minc/trunk/debian/control
trunk/packages/minc/trunk/debian/copyright
trunk/packages/minc/trunk/debian/rules
Log:
Fix doc-base file, add Getopt::Tabular, fix mincview to use imagemagick.
Added: trunk/packages/minc/trunk/Getopt-Tabular-0.3/Tabular.pm
===================================================================
--- trunk/packages/minc/trunk/Getopt-Tabular-0.3/Tabular.pm (rev 0)
+++ trunk/packages/minc/trunk/Getopt-Tabular-0.3/Tabular.pm 2008-01-03 04:44:13 UTC (rev 1064)
@@ -0,0 +1,913 @@
+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-03 01:09:50 UTC (rev 1063)
+++ trunk/packages/minc/trunk/debian/changelog 2008-01-03 04:44:13 UTC (rev 1064)
@@ -2,15 +2,26 @@
* New upstream version. Closes: #450922.
- * control: Add build-depends for libhdf5-serial-dev, texlive-latex-base.
+ * control: Set Maintainer to debian-med-packaging.
+ Add build-depends for libhdf5-serial-dev, texlive-latex-base.
Rename package libminc0 --> libminc2-1.
Rename package libminc0-dev --> libminc-dev.
Package libminc-dev depends on libhdf5-serial-dev.
+ Package minc-tools depends on imagemagick.
+ * rules: Configure with --enable-minc2 and --enable-acr-nema.
+
+ * Getopt-Tabular-0.3/Tabular.pm: New. Perl module required
+ for mincpik and xfmflip. Closes: #457074.
+
* patches/02_testdir-runtests.diff: New. Fix test scripts.
- * rules: Configure with --enable-minc2 and --enable-acr-nema.
+ * patches/03_mincview.diff: New. Use 'display' from ImageMagick rather
+ than 'xv' to view images. Closes: #457072.
+ * patches/04_progs-use-lib.diff: New. Add "use lib" declaration to find
+ the private Getopt::Tabular.
+
-- Steve M. Robbins <smr at debian.org> Tue, 01 Jan 2008 05:04:20 -0600
minc (1.5-2) NEVER UPLOADED; urgency=low
Modified: trunk/packages/minc/trunk/debian/control
===================================================================
--- trunk/packages/minc/trunk/debian/control 2008-01-03 01:09:50 UTC (rev 1063)
+++ trunk/packages/minc/trunk/debian/control 2008-01-03 04:44:13 UTC (rev 1064)
@@ -2,14 +2,15 @@
Homepage: http://www.bic.mni.mcgill.ca/software/
Section: science
Priority: optional
-Maintainer: Steve M. Robbins <smr at debian.org>
+Maintainer: Debian-Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
+Uploaders: Steve M. Robbins <smr at debian.org>
Build-Depends: cdbs, debhelper (>= 5), csh, netcdfg-dev, libhdf5-serial-dev, zlib1g-dev, texlive-latex-base | tetex-bin
Standards-Version: 3.7.3.0
Vcs-Svn: svn://svn.debian.org/svn/debian-med/trunk/packages/minc/trunk
Package: minc-tools
Architecture: any
-Depends: ${shlibs:Depends}, csh | c-shell, netcdf-bin, libtext-format-perl
+Depends: ${shlibs:Depends}, csh | c-shell, netcdf-bin, libtext-format-perl, imagemagick
Description: MNI medical image format tools
This package contains tools to manipulate MINC files.
.
Modified: trunk/packages/minc/trunk/debian/copyright
===================================================================
--- trunk/packages/minc/trunk/debian/copyright 2008-01-03 01:09:50 UTC (rev 1063)
+++ trunk/packages/minc/trunk/debian/copyright 2008-01-03 04:44:13 UTC (rev 1064)
@@ -12,3 +12,15 @@
author and McGill University make no representations about the
suitability of this software for any purpose. It is provided "as is"
without express or implied warranty.
+
+MINC contains Getopt::Tabular.pm (from
+http://search.cpan.org/dist/Getopt-Tabular) under the following
+license.
+
+# 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.
+
+On Debian GNU/Linux systems, the perl license may be found in
+/usr/share/doc/perl/copyright.
+
Copied: trunk/packages/minc/trunk/debian/libminc-dev.doc-base (from rev 1036, trunk/packages/minc/trunk/debian/libminc0-dev.doc-base)
===================================================================
--- trunk/packages/minc/trunk/debian/libminc-dev.doc-base (rev 0)
+++ trunk/packages/minc/trunk/debian/libminc-dev.doc-base 2008-01-03 04:44:13 UTC (rev 1064)
@@ -0,0 +1,15 @@
+Document: minc
+Title: MINC Medical Image Format Library Reference
+Author: Peter Neelin
+Abstract: The Minc file format is a highly flexible medical image file format.
+ Minc version 1 is built on top of the NetCDF generalized data format.
+ Minc version 2 is built on top of the HDF data format. This library
+ handles both formats. In each case the format is
+ simple, self-describing, extensible, portable and N-dimensional, with
+ programming interfaces for both low-level data access and high-level
+ volume manipulation.
+Section: Apps/Science
+
+Format: HTML
+Index: /usr/share/doc/libminc-dev/index.html
+Files: /usr/share/doc/libminc-dev/index.html
Deleted: trunk/packages/minc/trunk/debian/libminc0-dev.doc-base
===================================================================
--- trunk/packages/minc/trunk/debian/libminc0-dev.doc-base 2008-01-03 01:09:50 UTC (rev 1063)
+++ trunk/packages/minc/trunk/debian/libminc0-dev.doc-base 2008-01-03 04:44:13 UTC (rev 1064)
@@ -1,13 +0,0 @@
-Document: minc
-Title: MINC Medical Image Format Library Reference
-Author: Peter Neelin
-Abstract: The Minc file format is a highly flexible medical image file format
- built on top of the NetCDF generalized data format. The format is
- simple, self-describing, extensible, portable and N-dimensional, with
- programming interfaces for both low-level data access and high-level
- volume manipulation.
-Section: Science
-
-Format: HTML
-Index: /usr/share/doc/libminc0-dev/index.html
-Files: /usr/share/doc/libminc0-dev/index.html
Added: trunk/packages/minc/trunk/debian/patches/03_mincview.diff
===================================================================
--- trunk/packages/minc/trunk/debian/patches/03_mincview.diff (rev 0)
+++ trunk/packages/minc/trunk/debian/patches/03_mincview.diff 2008-01-03 04:44:13 UTC (rev 1064)
@@ -0,0 +1,14 @@
+--- progs/mincview/mincview.old 2007-03-29 00:08:53.000000000 -0500
++++ progs/mincview/mincview 2008-01-02 21:10:36.000000000 -0600
+@@ -6,9 +6,8 @@
+ # Displays images with patient left on left side of the screen.
+
+ # Constants
+-set xv_visual = `xdpyinfo | awk '($1=="class:"){visual=$2};(($1=="depth:") && (visual=="TrueColor") && ($2==24)) {found=1}; END {if (found) print "-visual TrueColor"}'`
+-set VIEWER = "xv" # Any pnm display program that handles a list of files
+-set VIEWER_OPTIONS = "-geometry 512x512 -fixed -cmap -raw $xv_visual"
++set VIEWER = "display" # Any pnm display program that handles a list of files
++set VIEWER_OPTIONS = "-geometry 512x512"
+ set PGM_CODE = "P5"
+ set PPM_CODE = "P6"
+ set usage = "Usage: $0 <filename.mnc> [<slice number>]"
Added: trunk/packages/minc/trunk/debian/patches/04_progs-use-lib.diff
===================================================================
--- trunk/packages/minc/trunk/debian/patches/04_progs-use-lib.diff (rev 0)
+++ trunk/packages/minc/trunk/debian/patches/04_progs-use-lib.diff 2008-01-03 04:44:13 UTC (rev 1064)
@@ -0,0 +1,20 @@
+--- 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-03 01:09:50 UTC (rev 1063)
+++ trunk/packages/minc/trunk/debian/rules 2008-01-03 04:44:13 UTC (rev 1064)
@@ -10,7 +10,7 @@
ps_docs = doc/prog_ref.ps doc/prog_guide.ps volume_io/Documentation/volume_io.ps
-build/libminc0-dev:: $(ps_docs)
+build/libminc-dev:: $(ps_docs)
doc/prog_ref.ps doc/prog_guide.ps:
$(MAKE) -C doc docs
@@ -19,6 +19,7 @@
$(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
@@ -26,11 +27,11 @@
/usr/share/man/man1/voxeltoworld.1 \
/usr/share/man/man1/worldtovoxel.1
-install/libminc0::
- dh_install -plibminc0 --autodest debian/tmp/usr/lib/lib*.so.*
+install/libminc2-1::
+ dh_install -plibminc2-1 --autodest debian/tmp/usr/lib/lib*.so.*
-install/libminc0-dev::
- dh_install -plibminc0-dev --autodest debian/tmp/usr/lib/lib*.so
- dh_install -plibminc0-dev --autodest debian/tmp/usr/lib/lib*.a
- dh_install -plibminc0-dev --autodest debian/tmp/usr/include
- dh_installdocs -plibminc0-dev GETTING_STARTED $(ps_docs) debian/index.html
+install/libminc-dev::
+ dh_install -plibminc-dev --autodest debian/tmp/usr/lib/lib*.so
+ dh_install -plibminc-dev --autodest debian/tmp/usr/lib/lib*.a
+ dh_install -plibminc-dev --autodest debian/tmp/usr/include
+ dh_installdocs -plibminc-dev GETTING_STARTED $(ps_docs) debian/index.html
More information about the debian-med-commit
mailing list