File Coverage

blib/lib/Psh/Support/TiedOption.pm

Criterion	Covered	Total	%
statement	61	91	67.0
branch	12	26	46.1
condition			n/a
subroutine	17	18	94.4
pod			n/a
total	90	135	66.6

use strict;

require Psh;
require Psh::Options;

package Psh::Support::TiedOption;
package Psh::Support::TiedOption::Scalar;

sub TIESCALAR {
    my ($class, $optname) = @_;
    return bless \$optname, $class;
}
sub FETCH {
    my $optname = shift;
    my $val = Psh::Options::get_option($$optname);
    if (ref $val) {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_scalar', $$optname);
        return;
    }
    return $val;
}
sub STORE {
    my ($optname, $newval) = @_;
    my $val = Psh::Options::get_option($$optname);
    if (ref $val) {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_scalar', $$optname);
        return;
    }
    Psh::Options::set_option($$optname, $newval);
}

package Psh::Support::TiedOption::Array;

sub TIEARRAY {
    my ($class, $optname) = @_;
    return bless \$optname, $class;
}
sub FETCH {
    my ($optname, $index) = @_;
    my $val = Psh::Options::get_option($$optname);
    unless (ref $val eq 'ARRAY') {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_array', $$optname);
        return;
    }
    return $val->[$index];
}
sub STORE {
    my ($optname, $index, $newval) = @_;
    my $array = scalar Psh::Options::get_option($$optname);

    unless (ref $array eq 'ARRAY') {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_array', $$optname);
        return;
    }
    $array->[$index] = $newval;
    Psh::Options::set_option($$optname, $array);
}
sub FETCHSIZE {
    my ($optname) = @_;
    my $val = Psh::Options::get_option($$optname);
    unless (ref $val eq 'ARRAY') {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_array', $$optname);
        return;
    }
    return scalar @$val;
}
sub CLEAR {
    my ($optname) = @_;
    my $val = Psh::Options::get_option($$optname);
    unless (ref $val eq 'ARRAY') {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_array', $$optname);
        return;
    }
    Psh::Options::set_option($$optname, []);
}

sub EXTEND {
}


package Psh::Support::TiedOption::Hash;

sub TIEHASH {
    my ($class, $optname) = @_;
    return bless \$optname, $class;
}
sub FETCH {
    my ($optname, $key) = @_;
    my $val = Psh::Options::get_option($$optname);
    unless (ref $val eq 'HASH') {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname);
        return;
    }
    return $val->{$key};
}
sub STORE {
    my ($optname, $key, $newval) = @_;
    my $hash = scalar Psh::Options::get_option($$optname);
    unless (ref $hash eq 'HASH') {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname);
        return;
    }
    $hash->{$key} = $newval;
    Psh::Options::set_option($$optname, $hash);
}
sub EXISTS {
    my ($optname, $key) = @_;
    my $val = Psh::Options::get_option($$optname);
    unless (ref $val eq 'HASH') {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname);
        return;
    }
    return exists $val->{$key};
}
sub DELETE {
    my ($optname, $key) = @_;
    my $val = Psh::Options::get_option($$optname);
    unless (ref $val eq 'HASH') {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname);
        return;
    }
    return delete $val->{$key};
}
sub CLEAR {
    my ($optname) = @_;
    my $val = Psh::Options::get_option($$optname);
    unless (ref $val eq 'HASH') {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname);
        return;
    }
    Psh::Options::set_option($$optname, {});
}
sub FIRSTKEY {
    my ($optname) = @_;
    my $val = Psh::Options::get_option($$optname);
    unless (ref $val eq 'HASH') {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname);
        return;
    }
    # Reset keys iterator
    my $reset_keys = keys %$val;
    return each %$val;
}
sub NEXTKEY {
    my ($optname) = @_;
    my $val = Psh::Options::get_option($$optname);
    unless (ref $val eq 'HASH') {
        Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname);
        return;
    }
    return each %$val;
}

1;