view release on metacpan or  search on metacpan

DBass.pm  view on Meta::CPAN

                    if (ref $out{$unroot}{$tag} eq 'ARRAY') {
                        push @{$out{$unroot}{$tag}}, $untagged->{$tag};
                        next;
                    }
                    my $val = $out{$unroot}{$tag};
                    undef $out{$unroot}{$tag};
                    @{$out{$unroot}{$tag}} = ($val, $untagged->{$tag});
                    next;
                }
                $out{$unroot}{$tag} = $untagged->{$tag};
                next;
            }
            $out{$unroot} = unescape $in;
        }
    }
}

###############################  XEEN DELETE  ###############################
sub xeen_delete {
    my $self = shift;
    return 1 unless defined $self->{'_OBJ'};
    die unless $self->{'_MODE'} =~ /[+>]/;
    my %argv = @_;
    if (defined $argv{'-keys'}) {
        my $ref = ref $argv{'-keys'};
        if ($ref eq 'ARRAY') {
            for (@{$argv{'-keys'}}) {
                delete $self->{'_HASHREF'}->{$_}
                    if exists $self->{'_HASHREF'}->{$_};
                delete $self->{'_UNTAGGED'}->{$_}
                    if exists $self->{'_UNTAGGED'}->{$_};
            }
        } elsif ($ref eq 'HASH') {
            for (keys %{$argv{'-keys'}}) {
                delete $self->{'_HASHREF'}->{$_}
                    if exists $self->{'_HASHREF'}->{$_};
                delete $self->{'_UNTAGGED'}->{$_}
                    if exists $self->{'_UNTAGGED'}->{$_};
            }
        } else {
            my $key = $argv{'-keys'};
            delete $self->{'_HASHREF'}->{$key}
                if exists $self->{'_HASHREF'}->{$key};
            delete $self->{'_UNTAGGED'}->{$key}
                if exists $self->{'_UNTAGGED'}->{$key};
        }
    } else {
        $self->{'_HASHREF'}  = {};
        $self->{'_UNTAGGED'} = {};
    }
    $self->{'_OBJ'}->sync;
}

#############################  XEEN DESTRUCTOR  #############################
sub xeen_destroy {
    my $self = shift;
    return 1 unless defined $self->{'_OBJ'};
    undef $self->{'_OBJ'};
    untie %$self->{'_HASHREF'};
    if ($^O eq 'MacOS' || $^O eq 'MacPerl') {
        chmod 0666, $self->{'_LOCK'};
    } else {
        flock $self->{'_FH'}, LOCK_UN;
        CORE::close $self->{'_FH'};
    }
}

################################  XEEN KEYS  ################################
sub xeen_keys {
    my $self = shift;
    keys %{$self->{'_HASHREF'}};
}

#############################  XEEN CONSTRUCTOR  #############################
sub xeen_new {
    my $self = shift;
    my %argv = ('-mode' => 0644, @_);
    die unless $argv{'-file'};
    ($self->{'_FILE'} = $argv{'-file'}) =~ s/^([+<>]+)//;
    $self->{'_MODE'} = $1 || '';
    $self->{'_LOCK'} = $argv{'-lock'};
    $self->{'_UNTAGGED'} = {};
    if ($^O eq 'MacOS' || $^O eq 'MacPerl') {
        chmod 0444, $self->{'_LOCK'};
    } else {
        if ($self->{'_MODE'} =~ /[+>]/) {
            open FH, '>>' . $self->{'_LOCK'} or die $!;
            unless (flock FH, LOCK_EX) {
                CORE::close FH;
                die;
            }
        } else {
            open FH, $self->{'_LOCK'} or die $!;
            unless (flock FH, LOCK_SH) {
                CORE::close FH;
                die;
            }
        }
        $self->{'_FH'} = *FH;
    }
    die unless
        $self->{'_OBJ'} = tie %{$self->{'_HASHREF'}}, 'DB_File',
            $self->{'_FILE'}, O_CREAT | O_RDWR, $argv{'-mode'};
}

################################  XEEN READ  ################################
sub xeen_read {
    my $self = shift;
    my %argv = @_;
    my $ref;
    for (defined $argv{'-keys'} && defined $argv{'-root'}
            ? (($ref = ref $argv{'-keys'}) eq 'ARRAY'
                ? @{$argv{'-keys'}}
                : ($ref eq 'HASH' ? keys %{$argv{'-keys'}} : $argv{'-keys'}))
            : (defined $self->{'_HASHREF'}
                ? keys %{$self->{'_HASHREF'}}
                : keys %{$self->{'_UNTAGGED'}})) {
        next if defined $self->{'_UNTAGGED'}->{$_};
        $self->{'_UNTAGGED'}->{$_} =
            xeen_untag $argv{'-root'}, $self->{'_HASHREF'}->{$_}
            if (defined $self->{'_HASHREF'} &&
                defined $self->{'_HASHREF'}->{$_});
    }
    $self->{'_UNTAGGED'};
}

################################  XEEN WRITE  ################################
sub xeen_write {
    my $self = shift;
    return 1 unless defined $self->{'_OBJ'};
    die unless $self->{'_MODE'} =~ /[+>]/;
    my %argv = @_;
    die unless defined $argv{'-hash'} && defined $argv{'-root'};
    for (keys %{$argv{'-hash'}}) {
        next unless defined $argv{'-hash'}->{$_};
        $self->{'_HASHREF'}->{$_} =
            xeen_tag $argv{'-root'}, \%{$argv{'-hash'}->{$_}};
        $self->{'_UNTAGGED'}->{$_} = \%{$argv{'-hash'}->{$_}};
    }
    $self->{'_OBJ'}->sync;
}

################################  DESTRUCTOR  ################################
sub DESTROY {