File Coverage

blib/lib/FormValidator/Simple/ProfileManager/YAML.pm

Criterion	Covered	Total	%
statement	48	61	78.6
branch	15	20	75.0
condition	2	4	50.0
subroutine	9	10	90.0
pod	5	6	83.3
total	79	101	78.2

package FormValidator::Simple::ProfileManager::YAML;
use strict;

use vars qw($VERSION);
$VERSION = '0.06';

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    $self->init(@_);
    $self;
}

sub init {
    my ($self, $yaml, $options) = @_;
    $options ||= {};
    my $loader = $options->{loader} || 'YAML';
    if ( $loader eq 'YAML::Syck') {
        require YAML::Syck;
        $self->{_profile} = YAML::Syck::LoadFile($yaml);
    } elsif ( $loader eq 'YAML' ) {
        require YAML;
        $self->{_profile} = YAML::LoadFile($yaml);
    } else {
        die "Don't know loader $loader.";
    }
}

sub extract {
    my $self = shift;
    my $self_new = bless { %$self }, ref $self;
    $self_new->{_profile} = $self_new->get_profile(@_);
    return unless $self_new->{_profile};
    return $self_new;
}

sub get_profile {
    my ($self, @paths) = @_;
    @paths = map { split /\./ } @paths;
    return $self->_get_profile_recursive($self->{_profile}, @paths);
}

sub _get_profile_recursive {
    my ($self, $profile, @paths) = @_;
    if ( @paths ) {
        $profile = $profile->{shift @paths};
        return $profile ? $self->_get_profile_recursive($profile, @paths) : undef;
    } else {
        return $profile;
    }
}

sub add_profile {
    my $self = shift;
    my ($keys, $constraint, @paths) = @_;
    my $prof = $self->get_profile(@paths);

    my $key = $self->_get_key($keys);

    # check key duplication. replace constraint if key already exists.
    my $key_exists;
    for (my $i=0; $i< @$prof; $i+=2) {
        my $cur_key = $self->_get_key($prof->[$i]);
        if ( $key eq $cur_key ) {
            $prof->[$i+1] = $constraint;
            $key_exists++;
            last;
        }
    }
    # push profile unless keys eixsts
    unless ( $key_exists ) {
        push @$prof, $keys, $constraint;
    }

}

sub remove_profile {
    my $self = shift;
    my ($keys, @paths) = @_;
    my $prof = $self->get_profile(@paths);

    my $key = $self->_get_key($keys);

    for (my $i=0; $i< @$prof; $i+=2) {
        my $cur_key = $self->_get_key($prof->[$i]);
        if ( $key eq $cur_key ) {
            splice (@$prof, $i, 2);
            last;
        }
    }

}

sub _get_key {
    my ($self,$keys) = @_;
    if ( my $ref = ref $keys ) {
        if ( $ref eq 'HASH') {
            return (keys %$keys)[0];
        } else {
            die "keys must be a hashref or single scalar.";
        }
    } else {
        return $keys;
    }
}


1;
__END__