view release on metacpan or  search on metacpan

lib/FlatFile/DataStore/Tiehash.pm  view on Meta::CPAN

use Carp;

#---------------------------------------------------------------------
# NOTE: TIEHASH() is defined in FlatFile/DataStore.pm

#---------------------------------------------------------------------
# FETCH() supports tied hash access
#     Returns a record object.

sub FETCH {
    my( $self, $key ) = @_;

    my $lastkeynum = $self->lastkeynum;
    $key = $lastkeynum if $key eq '';

    return if $key !~ /^[0-9]+$/;
    return if $key  > $lastkeynum;
    $self->retrieve( $key );
}

#---------------------------------------------------------------------
# STORE() supports tied hash access
#     Keys are limited to 0 .. lastkeynum (integers)
#     If $key is new, it has to be nextkeynum, i.e., you can't leave
#     gaps in the sequence of keys
#     e.g., $h{ keys %h                } = { data => "New", user => "record" };
#     or    $h{ tied( %h )->nextkeynum } = { data => "New", user => "record" };
#     or    $h{ ''                     } = { data => "New", user => "record" };
#     or    $h{ undef                  } = { data => "New", user => "record" };
#     ('keys %h' is fairly light-weight, but nextkeynum is more so
#     and $h{''} (or $h{undef}) is shorthand for nextkeynum)

sub STORE {
    my( $self, $key, $parms ) = @_;

    my $nextkeynum = $self->nextkeynum;
    $key = $nextkeynum if $key eq '';
    croak qq/Unsupported key format: $key/
        unless $key =~ /^[0-9]+$/ and $key <= $nextkeynum;

    my $reftype = ref $parms;  # record, hash, sref, string

    # for updates, $parms must be a record object
    if( $key < $nextkeynum ) {
        croak qq/Not a record object: $parms/
            unless $reftype and $reftype =~ /Record/;
        my $keynum = $parms->keynum;
        croak qq/Record key number, $keynum, doesn't match key: $key/
            unless $key == $keynum;
        return $self->update( $parms );
    }

    # for creates, $parms may be record, href, sref, or string
    else {
        if( !$reftype or $reftype eq "SCALAR" ) {  # string
            return $self->create({ data => $parms }); 
        }
        if( $reftype =~ /Record/ ) {
            return $self->create( $parms );
        }
        if( $reftype eq 'HASH' ) {  # e.g., {data=>'recdata',user=>'userdata'}
            return $self->create( $parms );
        }
        else {
            croak qq/Unsupported ref type: $reftype/;
        }
    }
}

#---------------------------------------------------------------------
# DELETE() supports tied hash access
#     If you want the "delete record" to contain anything more than
#     the record being deleted, you have to call tied( %h )->delete()
#     instead.
#
#     Otherwise, we have to have a record to delete one, so we fetch
#     it first.

sub DELETE {
    my( $self, $key ) = @_;
    return if $key !~ /^[0-9]+$/;
    return if $key > $self->lastkeynum;
    my $record = $self->retrieve( $key );
    $self->delete( $record );
}

#---------------------------------------------------------------------
# CLEAR() supports tied hash access
#     except we don't support CLEAR, because it would be very
#     destructive and it would be a pain to recover from an
#     accidental %h = ();

sub CLEAR {
    my $self = shift;
    croak qq/Clearing the entire datastore is not supported/;
}

#---------------------------------------------------------------------
# FIRSTKEY() supports tied hash access
#     The keys in a datastore are always 0 .. lastkeynum (integers).
#     Before the first record is added, nextkeynum() returns 0.
#     In that case, the sub below would return undef.

sub FIRSTKEY {
    my $self = shift;
    return 0 if $self->nextkeynum > 0;
}

#---------------------------------------------------------------------
# NEXTKEY() supports tied hash access
#     Because FIRSTKEY/NEXTKEY are functions of integers and require
#     reading only a single line from a file (lastkeynum() reads the
#     first line of the first toc file), the 'keys %h' operation is
#     comparatively light-weight ('values %h' is a different story.)

sub NEXTKEY {
    my( $self, $prevkey ) = @_; 
    return if $prevkey >= $self->lastkeynum;
    $prevkey + 1;
}