File Coverage

blib/lib/SQL/Library.pm

Criterion	Covered	Total	%
statement	43	52	82.6
branch	9	18	50.0
condition			n/a
subroutine	8	9	88.8
pod	7	7	100.0
total	67	86	77.9

package SQL::Library;

use strict;
use warnings;

our $VERSION = '0.0.5';

sub new
{
    my $proto = shift;
    my $options = shift;
    my $self = {
                 'options'  => $options,
                 'contents' => undef
               };

    my $curr_name = '';

    my @lib_arr = ();
    if ( ref $self->{'options'}->{'lib'} eq 'ARRAY' )
    {
        # Could be a filehandle or a string.
        if ( @{ $self->{'options'}->{'lib'} } == 1 )
        {
            @lib_arr = split /(?<=\n)/, $self->{'options'}->{'lib'}->[0];
        }
        else
        {
            @lib_arr = @{ $self->{'options'}->{'lib'} };
        }
    }
    else
    {
        open LIB, $self->{'options'}->{'lib'}
          or die "Cannot open $self->{'options'}->{'lib'}: $!";
        @lib_arr = ;
        close LIB;
    }

    foreach ( @lib_arr )
    {
        next if m{^\s*$};
        next if m{^\s*#};
        next if m{^\s*//};
        if ( m{^\[([^\]]+)\]} )
        {
            $curr_name = $1;
            next;
        }
        if ( $curr_name )
        {
            $self->{'contents'}->{$curr_name} .= $_;
        }
    }

    bless $self, $proto;
    return $self;
}

sub retr
{
    my ( $self, $entity_name ) = @_;
    return $self->{'contents'}->{$entity_name};
}

sub set
{
    my ( $self, $entity_name, $entity ) = @_;
    $self->{'contents'}->{$entity_name} = $entity;
    return $self;
}

sub drop
{
    my ( $self, $entity_name ) = @_;
    delete $self->{'contents'}->{$entity_name};
    return $self;
}

sub elements
{
    my $self = shift;
    return sort keys %{$self->{'contents'}};
}

sub dump
{
    my $self   = shift;
    my $output = '';
    foreach ( sort keys %{$self->{'contents'}} )
    {
        $output .= sprintf "[%s]\n%s\n", $_, $self->{'contents'}->{$_};
    }
    return $output;
}

sub write
{
    my $self = shift;
    open OUT, ">$self->{'options'}->{'lib'}"
      or die "Cannot open $self->{'options'}->{'lib'}: $!";
    print OUT $self->dump;
    close OUT;
}

1 ;
__END__