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::Long
  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::Long;
  37
  38 sub makeLongOpts();        # Create option spec for Getopt::Long::GetOptions();
  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 = "  %-8.8s|%-9.9s|%-7.7s|%-17.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}->{comment} = "Display recognized params";
  70   $optionsDef{v}->{Sort} = 1;
  71
  72   use vars qw(%options);
  73   %options = ("help" => 0);
  74
  75   {
  76     my $roptr = &makeLongOpts();
  77     my $p = Getopt::Long::Parser->new;
  78     $p->configure("bundling");
  79     $p->getoptions(%{$roptr});
  80   }
  81
  82   # Callback routine called by $p->getoptions().
  83   sub handleopts($$$)
  84   {
  85     my ($option, $value, $unknown) = @_;
  86     if (defined($optionsDef{$option})) {
  87       my $fieldname = $optionsDef{$option}->{fieldname};
  88       if (exists($options{$fieldname}) && ($option ne "h")) {
  89         print "Option $option already set\n";
  90         if (defined($options{$fieldname})) {
  91           print "Value \"$value\" would overwrite ";
  92           if (ref($options{$fieldname}) eq "ARRAY") {
  93             print "\"" . join(',', @{$options{$fieldname}}) . "\"\n";
  94           }
  95           else {
  96             print "\"$options{$fieldname}\"\n";
  97           }
  98         }
  99         $option = "h";
 100         $fieldname = "help";
 101       }
 102       if ($option eq "h") {
 103         print "Syntax: $0 options xxxx ...\n";
 104         print "Available options:\n";
 105         printf($helpFormat, "option", "param", "type", "aliases", "comment");
 106         print "  " . "-" x 90 . "\n";
 107         my $optx = &makeHelp();
 108         print "$optx";
 109         $options{$fieldname} = 1;
 110       }
 111       else {
 112         if (defined($optionsDef{$option}->{listsep})) {
 113           my @list = split(/(?<!\\)$optionsDef{$option}->{listsep}/, $value);
 114           $options{$fieldname} = \@list;
 115         }
 116         else {
 117           $options{$fieldname} = $value;
 118         }
 119       }
 120     }
 121   }
 122
 123   if (exists($options{verbose})) {
 124     printf("Found following options:\n    %-16soptvalue\n", "option");
 125     print "    " . "-" x 32 . "\n";
 126     for my $k (sort keys %options) {
 127       if (defined($options{$k})) {
 128         my $val;
 129         if (ref($options{$k}) eq "ARRAY") {
 130           $val = join(',', @{$options{$k}});
 131         }
 132         else {
 133           $val = $options{$k};
 134         }
 135         printf("    %-16s%s\n", $k, $val);
 136       }
 137       else {
 138         print "    $k\n";
 139       }
 140     }
 141   }
 142   if ($options{help}) {
 143     exit 0;
 144   }
 145   return \%options;
 146 }
 147
 148 #############################################################
 149
 150 # Create option spec for Getopt::Long::GetOptions()
 151 sub makeLongOpts()
 152 {
 153   my %opts = ();
 154   for my $ex (sort keys %optionsDef) {
 155     my $e = $optionsDef{$ex};
 156     my $type = "";
 157     if (defined($e->{type})) {
 158       $type = $e->{type};
 159     }
 160     my $optx = $ex;
 161     if (defined($e->{alias})) {
 162       for my $a (@{$e->{alias}}) {
 163         $optx .= "|$a";
 164       }
 165     }
 166     $opts{"$optx$type"} = \&handleopts;
 167   }
 168   return \%opts;        # to be used by Getopt::Long();
 169 }
 170
 171 sub sortHelp
 172 {
 173   if (defined($optionsDef{$a}->{Sort})) {
 174     if (defined($optionsDef{$b}->{Sort})) {
 175       return $optionsDef{$a}->{Sort} <=> $optionsDef{$b}->{Sort};
 176     }
 177     return -1;
 178   }
 179   if (defined($optionsDef{$b}->{Sort})) {
 180     return 1;
 181   }
 182   else {
 183     return $a cmp $b;
 184   }
 185 }
 186
 187 # Create help-string to describe options
 188 sub makeHelp()
 189 {
 190   my $opts = "";
 191   my %modifier = (
 192     ":" => "optional",
 193     "=" => "required",
 194     "s" => "string",
 195     "i" => "integer",
 196     "f" => "float",
 197       );
 198   for my $ex (sort sortHelp keys %optionsDef) {
 199     my $e = $optionsDef{$ex};
 200     my $type = "";
 201     my $needed = "";
 202     my $partype = "";
 203     my $aliases = "";
 204     my $comment = "";
 205     if (defined($e->{type})) {
 206       my $tp = $e->{type};
 207       if ($tp =~ /^([:=])([sif])$/) {
 208         $needed = $modifier{$1};
 209         $partype = $modifier{$2};
 210       }
 211       else {
 212         print "wrong option type: $tp\n";
 213         exit(1);
 214       }
 215     }
 216     if (defined($e->{alias})) {
 217       $aliases = join(',', @{$e->{alias}});
 218     }
 219     if (defined($e->{comment})) {
 220       $comment = $e->{comment};
 221     }
 222     $opts .= sprintf($helpFormat, $ex, $needed, $partype, $aliases, $comment);
 223     if (defined($e->{comment2})) {
 224       my $fill = "_" x 20;
 225       $opts .= sprintf($helpFormat, $fill, $fill, $fill, $fill, $e->{comment2});
 226     }
 227   }
 228   return($opts);
 229 }
 230
 231 #############################################################
 232 1;
 233