Group
Extension

Test2-Harness/blib/lib/Getopt/Yath/Settings.pm

package Getopt::Yath::Settings;
use strict;
use warnings;

our $VERSION = '2.000004';

use Carp();

use Getopt::Yath::Settings::Group;

use Test2::Harness::Util::JSON qw/decode_json decode_json_file/;

sub new {
    my $class = shift;
    my $self = @_ == 1 ? $_[0] : { @_ };

    bless($self, $class);

    Getopt::Yath::Settings::Group->new($_) for values %$self;

    return $self;
}

sub maybe {
    my $self = shift;
    my ($group, $opt, $default) = @_;

    return $default unless $self->check_group($group);

    my $g = $self->$group;

    return $default unless $g->check_option($opt);

    return $g->$opt // $default;
}

sub check_group { $_[0]->{$_[1]} // 0 }

sub group {
    my $self = shift;
    my ($group, $vivify) = @_;

    return $self->{$group} if $self->{$group};

    return $self->{$group} = Getopt::Yath::Settings::Group->new()
        if $vivify;

    Carp::confess("The '$group' group is not defined");
}

sub create_group {
    my $self = shift;
    my ($name, @vals) = @_;

    return $self->{$name} = Getopt::Yath::Settings::Group->new(@vals == 1 ? $vals[0] : { @vals });
}

sub delete_group {
    my $self = shift;
    my ($name) = @_;

    delete $self->{$name};
}

our $AUTOLOAD;
sub AUTOLOAD {
    my $this = shift;

    my $group = $AUTOLOAD;
    $group =~ s/^.*:://g;

    return if $group eq 'DESTROY';

    Carp::confess("Method $group() must be called on a blessed instance") unless ref($this);

    $this->group($group);
}

sub FROM_JSON_FILE {
    my $class = shift;
    my ($file, %params) = @_;

    my $data = decode_json_file($file, %params);
    $class->new($data);
}

sub FROM_JSON {
    my $class = shift;
    my ($json) = @_;

    my $data = decode_json($json);
    $class->new($data);
}

sub TO_JSON {
    my $self = shift;
    return {%$self};
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Getopt::Yath::Settings - FIXME

=head1 DESCRIPTION

=head1 SYNOPSIS

=head1 EXPORTS

=over 4

=back

=head1 SOURCE

The source code repository for Test2-Harness can be found at
L<http://github.com/Test-More/Test2-Harness/>.

=head1 MAINTAINERS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 AUTHORS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 COPYRIGHT

Copyright Chad Granum E<lt>exodist7@gmail.comE<gt>.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See L<http://dev.perl.org/licenses/>

=cut


=pod

=cut POD NEEDS AUDIT



Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.