development/tools/GetOptions.pm

   1 #! /usr/bin/env perl
   2 # -*- mode: perl; -*-
   3
   4 # file GetOptions.pm
   5 # This file is part of LyX, the document processor.
   6 # Licence details can be found in the file COPYING
   7 # or at http://www.lyx.org/about/licence.php
   8 #
   9 # author Kornel Benko
  10 # Full author contact details are available in the file CREDITS
  11 # or at https://www.lyx.org/Credits
  12 #
  13 # Used as wrapper for Getopt::Mixed
  14 # as
  15 #    use GetOptions;
  16 #    ...
  17 #    my %optionsDef = (
  18 #    ...
  19 #    );
  20 #    my %options = %{&handleOptions(\%optionsDef)};
  21
  22 package GetOptions;
  23
  24 use strict;
  25 our(@EXPORT, @ISA);
  26
  27 sub handleOptions($);
  28
  29 BEGIN {
  30   use Exporter   ();
  31   @ISA        = qw(Exporter);
  32   @EXPORT     = qw(handleOptions);
  33 }
  34
  35 use warnings;
  36 use Getopt::Mixed;
  37
  38 sub makeOpts();            # Create option spec for Getopt::Mixed::init()
  39 sub makeHelp();            # Create help-string to describe options
  40
  41 # Following fields for a parameter can be defined:
  42 # fieldname:         Name of entry in %options
  43 # type:              [:=][sif], ':' = optional, '=' = required, 's' = string, 'i' = integer, 'f' = float
  44 # alias:             reference to a list of aliases e.g. ["alias1", "alias2", ... ]
  45 # listsep:           Separator for multiple data
  46 # comment:           Parameter description
  47
  48 my %optionsDef = ();
  49 #option|param|type|aliases|comment
  50 my $helpFormat = "  %-8s|%-9s|%-7s|%-17s|%s\n";
  51
  52 sub handleOptions($)
  53 {
  54   if (ref($_[0]) eq "ARRAY") {
  55     for (my $i = 0; defined($_[0]->[$i]); $i++) {
  56       my $rO = $_[0]->[$i];
  57       $optionsDef{$rO->[0]} = $rO->[1];
  58       $optionsDef{$rO->[0]}->{Sort} = $i+2;
  59     }
  60   }
  61   else {
  62     %optionsDef = %{$_[0]};
  63   }
  64   $optionsDef{h}->{fieldname} = "help";
  65   $optionsDef{h}->{alias} = ["help"];
  66   $optionsDef{h}->{Sort} = 0;
  67   $optionsDef{v}->{fieldname} = "verbose";
  68   $optionsDef{v}->{alias} = ["verbose"];
  69   $optionsDef{v}->{Sort} = 1;
  70
  71   my %options = ("help" => 0);
  72   my $opts = &makeOpts();
  73
  74   Getopt::Mixed::init($opts);
  75   while( my( $option, $value, $pretty ) = Getopt::Mixed::nextOption()) {
  76     if (defined($optionsDef{$option})) {
  77       my $fieldname = $optionsDef{$option}->{fieldname};
  78       if (exists($options{$fieldname})) {
  79         print "Option $option already set\n";
  80         print "Value \"$value\" would overwrite ";
  81         if (ref($options{$fieldname}) eq "ARRAY") {
  82           print "\"" . join(',', @{$options{$fieldname}}) . "\"\n";
  83         }
  84         else {
  85           print "\"$options{$fieldname}\"\n";
  86         }
  87         $option = "h";
  88         $fieldname = "help";
  89       }
  90       if ($option eq "h") {
  91         print "Syntax: $0 options xxxx ...\n";
  92         print "Available options:\n";
  93         printf($helpFormat, "option", "param", "type", "aliases", "comment");
  94         print "  " . "-" x 90 . "\n";
  95         my $optx = &makeHelp();
  96         print "$optx";
  97         $options{$fieldname} = 1;
  98       }
  99       else {
 100         if (defined($optionsDef{$option}->{listsep})) {
 101           my @list = split($optionsDef{$option}->{listsep}, $value);
 102           $options{$fieldname} = \@list;
 103         }
 104         else {
 105           $options{$fieldname} = $value;
 106         }
 107       }
 108     }
 109   }
 110
 111   Getopt::Mixed::cleanup();
 112   if (exists($options{verbose})) {
 113     printf("Found following options:\n    %-16soptvalue\n", "option");
 114     print "    " . "-" x 32 . "\n";
 115     for my $k (sort keys %options) {
 116       if (defined($options{$k})) {
 117         my $val;
 118         if (ref($options{$k}) eq "ARRAY") {
 119           $val = join(',', @{$options{$k}});
 120         }
 121         else {
 122           $val = $options{$k};
 123         }
 124         printf("    %-16s%s\n", $k, $val);
 125       }
 126       else {
 127         print "    $k\n";
 128       }
 129     }
 130   }
 131   if ($options{help}) {
 132     exit 0;
 133   }
 134   return \%options;
 135 }
 136
 137 #############################################################
 138
 139 # Create option spec for Getopt::Mixed::init()
 140 sub makeOpts()
 141 {
 142   my $first = 1;
 143   my $opts = "";
 144   for my $ex (sort keys %optionsDef) {
 145     my $e = $optionsDef{$ex};
 146     if (! $first) {
 147       $opts .= " ";
 148     }
 149     $first = 0;
 150     $opts .= $ex;
 151     if (defined($e->{type})) {
 152       my $tp = $e->{type};
 153       $opts .= $tp;
 154     }
 155     if (defined($e->{alias})) {
 156       for my $a (@{$e->{alias}}) {
 157         $opts .= " $a>$ex";
 158       }
 159     }
 160   }
 161   return($opts);
 162 }
 163
 164 sub sortHelp
 165 {
 166   if (defined($optionsDef{$a}->{Sort})) {
 167     if (defined($optionsDef{$b}->{Sort})) {
 168       return $optionsDef{$a}->{Sort} <=> $optionsDef{$b}->{Sort};
 169     }
 170     return -1;
 171   }
 172   if (defined($optionsDef{$b}->{Sort})) {
 173     return 1;
 174   }
 175   else {
 176     return $a cmp $b;
 177   }
 178 }
 179
 180 # Create help-string to describe options
 181 sub makeHelp()
 182 {
 183   my $opts = "";
 184   my %modifier = (
 185     ":" => "optional",
 186     "=" => "required",
 187     "s" => "string",
 188     "i" => "integer",
 189     "f" => "float",
 190       );
 191   for my $ex (sort sortHelp keys %optionsDef) {
 192     my $e = $optionsDef{$ex};
 193     my $type = "";
 194     my $needed = "";
 195     my $partype = "";
 196     my $aliases = "";
 197     my $comment = "";
 198     if (defined($e->{type})) {
 199       my $tp = $e->{type};
 200       if ($tp =~ /^([:=])([sif])$/) {
 201         $needed = $modifier{$1};
 202         $partype = $modifier{$2};
 203       }
 204       else {
 205         print "wrong option type: $tp\n";
 206         exit(1);
 207       }
 208     }
 209     if (defined($e->{alias})) {
 210       $aliases = join(',', @{$e->{alias}});
 211     }
 212     if (defined($e->{comment})) {
 213       $comment = $e->{comment};
 214     }
 215     $opts .= sprintf($helpFormat, $ex, $needed, $partype, $aliases, $comment);
 216   }
 217   return($opts);
 218 }
 219
 220 #############################################################
 221 1;
 222