view release on metacpan or  search on metacpan

lib/DBD/DBM.pm  view on Meta::CPAN

    $meta->{hash}->{$key} = $meta->{dbm_mldbm} ? $row_aryref : $row_aryref->[0];

    return 1;
}

# this is where you grab the column names from a CREATE statement
# if you don't need to do that, it must be defined but can be empty
#
sub push_names ($$$)
{
    my ( $self, $data, $row_aryref ) = @_;
    my $meta = $self->{meta};

    # some sanity checks ...
    my $ncols = scalar(@$row_aryref);
    $ncols < 2 and croak "At least 2 columns are required for DBD::DBM tables ...";
    !$meta->{dbm_mldbm}
      and $ncols > 2
      and croak "Without serializing with MLDBM only 2 columns are supported, you give $ncols";
    $meta->{col_names} = $row_aryref;
    return unless $meta->{dbm_store_metadata};

    my $stmt      = $data->{sql_stmt};
    my $col_names = join( ',', @{$row_aryref} );
    my $schema    = $data->{Database}->{Statement};
    $schema =~ s/^[^\(]+\((.+)\)$/$1/s;
    $schema = $stmt->schema_str() if ( $stmt->can('schema_str') );
    $meta->{hash}->{"_metadata \0"} =
        "<dbd_metadata>"
      . "<schema>$schema</schema>"
      . "<col_names>$col_names</col_names>"
      . "</dbd_metadata>";
}

# fetch_one_row, delete_one_row, update_one_row
# are optimized for hash-style lookup without looping;
# if you don't need them, omit them, they're optional
# but, in that case you may need to define
# truncate() and seek(), see below
#
sub fetch_one_row ($$;$)
{
    my ( $self, $key_only, $key ) = @_;
    my $meta = $self->{meta};
    $key_only and return $meta->{col_names}->[0];
    exists $meta->{hash}->{$key} or return;
    my $val = $meta->{hash}->{$key};
    $val = ( ref($val) eq 'ARRAY' ) ? $val : [$val];
    my $row = [ $key, @$val ];
    return wantarray ? @{$row} : $row;
}

sub delete_one_row ($$$)
{
    my ( $self, $data, $aryref ) = @_;
    my $meta = $self->{meta};
    delete $meta->{hash}->{ $aryref->[0] };
}

sub update_one_row ($$$)
{
    my ( $self, $data, $aryref ) = @_;
    my $meta = $self->{meta};
    my $key  = shift @$aryref;
    defined $key or return;
    my $row = ( ref($aryref) eq 'ARRAY' ) ? $aryref : [$aryref];
    $meta->{hash}->{$key} = $meta->{dbm_mldbm} ? $row : $row->[0];
}

sub update_specific_row ($$$$)
{
    my ( $self, $data, $aryref, $origary ) = @_;
    my $meta   = $self->{meta};
    my $key    = shift @$origary;
    my $newkey = shift @$aryref;
    return unless ( defined $key );
    $key eq $newkey or delete $meta->{hash}->{$key};
    my $row = ( ref($aryref) eq 'ARRAY' ) ? $aryref : [$aryref];
    $meta->{hash}->{$newkey} = $meta->{dbm_mldbm} ? $row : $row->[0];
}

# you may not need to explicitly DESTROY the ::Table
# put cleanup code to run when the execute is done
#
sub DESTROY ($)
{
    my $self = shift;
    my $meta = $self->{meta};
    $meta->{hash} and untie %{ $meta->{hash} };

    $self->SUPER::DESTROY();
}

# truncate() and seek() must be defined to satisfy DBI::SQL::Nano
# *IF* you define the *_one_row methods above, truncate() and
# seek() can be empty or you can use them without actually
# truncating or seeking anything but if you don't define the
# *_one_row methods, you may need to define these

# if you need to do something after a series of
# deletes or updates, you can put it in truncate()
# which is called at the end of executing
#
sub truncate ($$)
{
    # my ( $self, $data ) = @_;
    return 1;
}

# seek() is only needed if you use IO::File
# though it could be used for other non-file operations
# that you need to do before "writes" or truncate()
#
sub seek ($$$$)
{
    # my ( $self, $data, $pos, $whence ) = @_;
    return 1;
}

# Th, th, th, that's all folks!  See DBD::File and DBD::CSV for other
# examples of creating pure perl DBDs.  I hope this helped.
# Now it's time to go forth and create your own DBD!
# Remember to check in with dbi-dev@perl.org before you get too far.
# We may be able to make suggestions or point you to other related
# projects.

1;
__END__

=pod