File Coverage

blib/lib/WebService/CIA/Source/DBM.pm

Criterion	Covered	Total	%
statement	28	48	58.3
branch	5	14	35.7
condition	3	9	33.3
subroutine	7	11	63.6
pod	5	5	100.0
total	48	87	55.1

package WebService::CIA::Source::DBM;

require 5.005_62;
use strict;
use warnings;
use Fcntl;
use MLDBM qw(DB_File Storable);
use Carp;
use WebService::CIA::Source;

@WebService::CIA::Source::DBM::ISA = ("WebService::CIA::Source");

our $VERSION = '1.4';

sub new {

    my $proto = shift;
    my $opts = shift;
    my $class = ref($proto) || $proto;
    my $self = {};

    unless (exists $opts->{DBM}) {
        croak("WebService::CIA::Source::DBM: No DBM file specified");
    }

    my $mode;
    if (exists $opts->{Mode} && $opts->{Mode} eq "readwrite") {
        tie %{$self->{DBM}}, "MLDBM", $opts->{DBM}, O_CREAT|O_RDWR, 0640 or croak "WebService::CIA::Source::DBM: Can't open DBM: $!"; ## no critic (ProhibitLeadingZeros)
    } elsif (-e $opts->{DBM}) {
        tie %{$self->{DBM}}, "MLDBM", $opts->{DBM}, O_RDONLY, 0440 or croak "WebService::CIA::Source::DBM: Can't open DBM: $!"; ## no critic (ProhibitLeadingZeros)
    } else {
        croak "WebService::CIA::Source::DBM: $opts->{DBM}: $!";
    }

    bless ($self, $class);
    return $self;

}

sub value {

    my $self = shift;
    my ($country, $field) = @_;
    if (exists $self->dbm->{$country} and exists $self->dbm->{$country}->{$field}) {
        return $self->dbm->{$country}->{$field};
    } else {
        return;
    }

}

sub all {

    my $self = shift;
    my $cc = shift;
    if (exists $self->dbm->{$cc}) {
        return $self->dbm->{$cc};
    } else {
        return {};
    }

}

sub set {

    my $self = shift;
    my ($cc, $data) = @_;
    $self->dbm->{$cc} = $data;

}

sub dbm {

    my $self = shift;
    return $self->{DBM};

}


1;

__END__