App-Getconf

 view release on metacpan or  search on metacpan

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

}

=item C<_reformat($string, $max_width, $indent)>

Reformat a multiparagraph string to include maximum of C<$width-1> characters
per line, including indentation.

=cut

sub _reformat {
  my ($str, $width, $indent) = @_;

  $indent ||= 0;

  my @result;

  $str =~ s/^\s+//;
  for my $para (split /\n\s*\n[ \t]*/, $str) {
    my $r = "";
    my $line = "";
    for my $w (split /\s+/, $para) {
      if ($line eq "") {
        $line = (" " x $indent) . $w;
      } elsif (length($line) + 1 + length($w) < $width) {
        $line .= " " . $w;
      } else {
        $r .= $line . "\n";
        $line = (" " x $indent) . $w;
      }
    }
    $r .= $line . "\n";
    push @result, $r;
  }

  return join "\n", @result;
}

=end Internal

=pod }}}

=cut

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

=item C<options($options)>

Set options read from configuration file (hashref).

Example usage:

  App::Getconf->options(YAML::LoadFile("/etc/myapp.yaml"));

=cut

sub options {
  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;

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

=item C<_try_set($option, $option_name, $option_argument)>

Try setting option C<$option_name> (C<$option> was the actual name, under
which it was specified -- mainly I<-X> or I<--long-X>). If the option was
given a parameter (empty string counts here, too), it should be specified as
C<$option_argument>, otherwise C<$option_argument> should be left C<undef>.

In case of success, returned value is empty list. In case of failure,
returned value is a hashref with two keys: I<option> containing C<$option> and
I<cause> containing an error message. There could be third key I<eval>,
containing C<$@>. Method is suitable for
C<< push @errors, $o->_try_set(...) >>.

=cut

sub _try_set {
  my ($self, $option, $opt_name, $opt_arg) = @_;

  if (not $self->has_option($opt_name)) {
    return {
      option => $option,
      cause => "unknown option",
    };
  }

  my $node = $self->option_node($opt_name);

  if (defined $opt_arg) {
    if (not eval { $node->set($opt_arg); "OK" }) {
      chomp $@;
      return {
        option => $option,
        cause => "invalid option argument: $opt_arg",
        eval => $@,
      };
    }
  } else { # not defined $opt_arg
    # XXX: this is important not to pass an argument to $node->set() here, as
    # it would try to set undef
    if (not eval { $node->set(); "OK" }) {
      chomp $@;
      return {
        option => $option,
        cause => "invalid option argument: <undef>",
        eval => $@,
      };
    }
  }

  return ();
}

=end Internal

=pod }}}

=cut

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

=item C<set_verify($data)>

=item C<set_verify($data, $path)>

Set value(s) with verification against schema. If C<$path> was specified,
options start with this prefix. If values were verified successfully, they are
saved in internal storage.

B<NOTE>: This is a semi-internal API.

=cut

sub set_verify {
  my ($self, $data, $path) = @_;

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

  $path ||= "";

  my $datum_type = lc(ref $data) || "scalar";

  if ($datum_type ne 'hash') {
    # this is an option, but there's no corresponding schema node
    if (not $self->has_option($path)) {
      # $path: unknown option ($datum_type)
      croak "Unexpected $datum_type option ($path)";
    }

    $self->option_node($path)->set($data);

    return;
  }

  # more complex case: data is a hash

  # if no corresponding node in schema, just go deeper
  # if there is corresponding node, but it's not a hash, just go deeper, too
  if (!$self->has_option($path) ||
      $self->option_node($path)->storage() ne 'hash') {
    for my $o (keys %$data) {
      my $new_path = "$path.$o";
      $new_path =~ s/^\.|\.$//g;

      $self->set_verify($data->{$o}, $new_path);
    }

    return;
  }

  # it's sure that option called $path exists and it's storage type is "hash"
  # also, this option's type is hash

  my $node = $self->option_node($path);
  for my $k (keys %$data) {
    $node->set($k, $data->{$k});
  }
}

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

=item C<args()>

Retrieve non-option arguments (e.g. everything after "--") passed from command
line.

Values returned by this method are set by C<cmdline()> method.

=cut

sub args {
  my ($self) = @_;

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

  return @{ $self->{args} };
}

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

=item C<getopt($package)>

Retrieve a view of options (L<App::Getconf::View(3)>) appropriate for
package or subsystem called C<$package>.

If C<$package> was not provided, caller's package name is used.

C<$package> sets option search path. See C<new()>, C<prefix> option
description in L<App::Getconf::View(3)> for details.

Typical usage:

  sub foo {
    my (@args) = @_;

    my $opts = App::Getconf->getopt(__PACKAGE__);

    if ($opts->ssl) {
      # ...

=cut

sub getopt {
  my ($self, $package) = @_;

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

    );
  }

  return $self->{getopt_cache}{$package};
}

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

=back

=cut

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

=head2 Functions Defining Schema

=over

=cut

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

=item C<< schema(key => value, key => value, ...) >>

Create a hashref from key/value pairs. The resulting hash is tied to
L<Tie::IxHash(3)>, so the order of keys is preserved.

Main use is for defining order of options in I<--help> message, otherwise it
acts just like anonymous hashref creation (C<< { key => value, ... } >>).

=cut

sub schema {
  my (@args) = @_;

  tie my %h, 'Tie::IxHash';
  %h = @args;

  return \%h;
}

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

=item C<opt($data)>

Generic option specification.

Possible data:

  opt {
    type    => 'flag' | 'bool' | 'int' | 'float' | 'string',
    check   => qr// | sub {} | ["enum", "value", ...],
    storage => undef | \$foo | [] | {},
    help    => "message displayed on --help",
    value   => "initial value",
    default => "default value",
  }

If type is not specified, the option is treated as a string.

Check is for verifying correctness of specified option. It may be a regexp,
callback function (it gets the value to check as a first argument and in C<$_>
variable) or list of possible string values.

Types of options:

=over

=item C<flag>

Simple option, like I<--help> or I<--version>. Flag's value tells how many
times it was encountered.

=item C<bool>

ON/OFF option. May be turned on (I<--verbose>) or off (I<--no-verbose>).

=item C<int>

Option containing an integer.

=item C<float>

Option containing a floating point number.

=item C<string>

Option containing a string. This is the default.

=back

Storage tells if the option is a single-value (default), multi-value
accumulator (e.g. may be specified in command line multiple times, and the
option arguments will be stored in an array) or multi-value hash accumulator
(similar, but option argument is specified as C<key=value>, and the value part
is validated). Note that this specify only type of storage, not the actual
container.

B<NOTE>: Don't specify option with a hash storage and that has sub-options
(see L</"Schema Definition">). Verification can't tell whether the value is
meant for the hash under this option or for one of its sub-options.

Presence of C<help> key indicates that this option should be exposed to
end-users in I<--help> message. Options lacking this key will be skipped (but
stil honoured by App::Getconf).

Except for flags (I<--help>) and bool (I<--no-verbose>) options, the rest of
types require an argument. It may be specified as I<--timeout=120> or as
I<--timeout 120>. This requirement may be loosened by providing
C<default> value. This way end-user may just provide I<--timeout> option, and
the argument to the option is taken from default. (Of course, only
I<--timeout=120> form is supported if the argument needs to be provided.)

Initial value (C<value> key) is the value set for the option just after
defining schema. It may or may not be changed with command line options (which
is different from C<default>, for which the option still needs to be
specified).

Initial and default values are both subject to check that was specified, if
any.



( run in 2.538 seconds using v1.01-cache-2.11-cpan-5837b0d9d2c )