view release on metacpan or  search on metacpan

lib/App/Getconf.pm  view on Meta::CPAN

  my ($self, $options) = @_;

  $self = $static unless ref $self; # static call or non-static?

  $self->set_verify($options);
}

#-----------------------------------------------------------------------------

=item C<cmdline($arguments)>

Set options based on command line arguments (arrayref). If C<$arguments> was
not specified, C<@ARGV> is used.

Method returns list of messages (single line, no C<\n> at end) for errors that
were found, naturally empty if nothing was found.

Arguments that were not options can be retrieved using C<args()> method.

Example usage:

  App::Getconf->cmdline(\@ARGV);
  # the same: App::Getconf->cmdline();
  for my $arg (App::Getconf->args()) {
    # ...
  }

=cut

sub cmdline {
  my ($self, $arguments) = @_;

  $self = $static unless ref $self; # static call or non-static?

  my @args = @{ $arguments || \@ARGV };
  my @left;
  my @errors;

  OPTION:
  for (my $i = 0; $i < @args; ++$i) {
    my $option;
    my $option_name;
    my $option_arg; # undef only when no argument, with argument at least ""

    if ($args[$i] =~ /^--([a-zA-Z0-9-]+)=(.*)$/) {
      # long option with parameter {{{

      $option_name = $1;
      $option_arg  = $2;
      $option = "--$option_name";

      push @errors, $self->_try_set($option, $option_name, $option_arg);

      # }}}
    } elsif ($args[$i] =~ /^--([a-zA-Z0-9-]+)$/) {
      # long option, possible parameter in next argument {{{

      $option_name = $1;
      $option = $args[$i];

      # there's no option of exactly the same name, but the --option looks
      # like a negation of Boolean
      if (!$self->has_option($option_name) && $option_name =~ /^no-/) {
        my $negated_name = substr $option_name, 3;

        # there is an option without "--no-" prefix and that option is
        # a Boolean, so it might be actually negated
        if ($self->has_option($negated_name) &&
            $self->option_node($negated_name)->type() eq 'bool') {
          $option_name = $negated_name;
          $option = "--$negated_name";
          $option_arg = 0;
        }
      }

      if ($self->has_option($option_name) &&
          $self->option_node($option_name)->requires_arg()) {
        # consume the next argument, if this is possible; if not, report an
        # error
        if ($i < $#args) {
          # TODO: if $args[++$i] =~ /^-/, don't consume it (require people to
          # use "--foo=-arg" form)
          $option_arg = $args[++$i];
        } else {
          push @errors, {
            option => $option,
            cause => "missing argument",
          };
        }
      }

      push @errors, $self->_try_set($option, $option_name, $option_arg);

      # }}}
    } elsif ($args[$i] =~ /^-([a-zA-Z0-9]+)$/) {
      # set of short options {{{

      my @short_opts = split //, $1;

      for my $sopt (@short_opts) {
        # XXX: short options can't have arguments specified
        push @errors, $self->_try_set("-$sopt", $sopt);
      }

      next OPTION;

      # }}}
    } elsif ($args[$i] eq "--") {
      # end-of-options marker {{{

      # mark all the rest of arguments as non-options
      push @left, @args[$i + 1 .. $#args];
      last OPTION;

      # }}}
    } elsif ($args[$i] =~ /^-/) {
      # anything beginning with dash (e.g. "-@", "--()&*^&^") {{{

      push @errors, {
        option => $args[$i],
        cause => "unknown option",

lib/App/Getconf.pm  view on Meta::CPAN

}

=item C<opt_flag()>

Flag option (like I<--help>, I<--verbose> or I<--debug>).

=cut

sub opt_flag() {
  return opt { type => 'flag' };
}

=item C<opt_bool()>

Boolean option (like I<--recursive>). Such option gets its counterpart
called I<--no-${option}> (mentioned I<--recursive> gets I<--no-recursive>).

=cut

sub opt_bool() {
  return opt { type => 'bool' };
}

=item C<opt_int()>

Integer option (I<--retries=3>).

=cut

sub opt_int() {
  return opt { type => 'int' };
}

=item C<opt_float()>

Option specifying a floating point number.

=cut

sub opt_float() {
  return opt { type => 'float' };
}

=item C<opt_string()>

Option specifying a string.

=cut

sub opt_string() {
  return opt { type => 'string' };
}

=item C<opt_path()>

Option specifying a path in local filesystem.

=cut

sub opt_path() {
  # TODO: some checks on how this looks like
  #   * existing file
  #   * existing directory
  #   * non-existing file (directory exists)
  #   * Maasai?
  return opt { type => 'string' };
}

=item C<opt_hostname()>

Option specifying a hostname.

B<NOTE>: This doesn't check DNS for the hostname to exist. This only checks
hostname's syntactic correctness (and only to some degree).

=cut

sub opt_hostname() {
  return opt { check => qr/^[a-z0-9-]+(\.[a-z0-9-]+)*$/i };
}

=item C<opt_re(qr/.../)>

Option specifying a string, with check specified as regexp.

=cut

sub opt_re($) {
  my ($re) = @_;

  return opt { check => $re };
}

=item C<opt_sub(sub {...})>

=item C<opt_sub {...}>

Option specifying a string, with check specified as function (code ref).

Subroutine will have C<$_> set to value to check, and the value will be the
only argument (C<@_>) passed.

Subroutine should return C<TRUE> when option value should be accepted,
C<FALSE> otherwise.

=cut

sub opt_sub(&) {
  my ($sub) = @_;

  return opt { check => $sub };
}

=item C<opt_enum ["first", ...]>

Option specifying a string. The string must be one of the specified in the
array.

=cut

sub opt_enum($) {