Moved a few things and started on the MySQL schema
[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Engine / DBI.pm
CommitLineData
2c70efe1 1package DBM::Deep::Engine::DBI;
2
3use 5.006_000;
4
5use strict;
6use warnings FATAL => 'all';
7
8use base 'DBM::Deep::Engine';
9
d6ecf579 10use DBM::Deep::Sector::DBI ();
11use DBM::Deep::Storage::DBI ();
12
13sub sector_type { 'DBM::Deep::Sector::DBI' }
14
15__END__
16
2c70efe1 17sub read_value {
18 my $self = shift;
19 my ($obj, $key) = @_;
20}
21
22sub get_classname {
23 my $self = shift;
24 my ($obj) = @_;
25}
26
27sub make_reference {
28 my $self = shift;
29 my ($obj, $old_key, $new_key) = @_;
30}
31
32sub key_exists {
33 my $self = shift;
34 my ($obj, $key) = @_;
35}
36
37sub delete_key {
38 my $self = shift;
39 my ($obj, $key) = @_;
40}
41
42sub write_value {
43 my $self = shift;
44 my ($obj, $key, $value) = @_;
45
46 my $r = Scalar::Util::reftype( $value ) || '';
47 {
48 last if $r eq '';
49 last if $r eq 'HASH';
50 last if $r eq 'ARRAY';
51
52 DBM::Deep->_throw_error(
53 "Storage of references of type '$r' is not supported."
54 );
55 }
56
57 # Load the reference entry
58 # Determine if the row was deleted under us
59 #
60
61 my ($type);
62 if ( $r eq 'ARRAY' || $r eq 'HASH' ) {
63 my $tmpvar;
64 if ( $r eq 'ARRAY' ) {
65 $tmpvar = tied @$value;
66 } elsif ( $r eq 'HASH' ) {
67 $tmpvar = tied %$value;
68 }
69
70 if ( $tmpvar ) {
71 my $is_dbm_deep = eval { local $SIG{'__DIE__'}; $tmpvar->isa( 'DBM::Deep' ); };
72
73 unless ( $is_dbm_deep ) {
74 DBM::Deep->_throw_error( "Cannot store something that is tied." );
75 }
76
77 unless ( $tmpvar->_engine->storage == $self->storage ) {
78 DBM::Deep->_throw_error( "Cannot store values across DBM::Deep files. Please use export() instead." );
79 }
80
81 # Load $tmpvar's sector
82
83 # First, verify if we're storing the same thing to this spot. If we
84 # are, then this should be a no-op. -EJS, 2008-05-19
85
86 # See whether or not we are storing ourselves to ourself.
87 # Write the sector as data in this reference (keyed by $key)
88 $value_sector->increment_refcount;
89
90 return 1;
91 }
92
93 $type = substr( $r, 0, 1 );
94 }
95 else {
96 if ( tied($value) ) {
97 DBM::Deep->_throw_error( "Cannot store something that is tied." );
98 }
99 }
100
101 # This code is to make sure we write all the values in the $value to the
102 # disk and to make sure all changes to $value after the assignment are
103 # reflected on disk. This may be counter-intuitive at first, but it is
104 # correct dwimmery.
105 # NOTE - simply tying $value won't perform a STORE on each value. Hence,
106 # the copy to a temp value.
107 if ( $r eq 'ARRAY' ) {
108 my @temp = @$value;
109 tie @$value, 'DBM::Deep', {
110 base_offset => $value_sector->offset,
111 staleness => $value_sector->staleness,
112 storage => $self->storage,
113 engine => $self,
114 };
115 @$value = @temp;
116 bless $value, 'DBM::Deep::Array' unless Scalar::Util::blessed( $value );
117 }
118 elsif ( $r eq 'HASH' ) {
119 my %temp = %$value;
120 tie %$value, 'DBM::Deep', {
121 base_offset => $value_sector->offset,
122 staleness => $value_sector->staleness,
123 storage => $self->storage,
124 engine => $self,
125 };
126
127 %$value = %temp;
128 bless $value, 'DBM::Deep::Hash' unless Scalar::Util::blessed( $value );
129 }
130
131 return 1;
132}
133
134sub setup {
135 my $self = shift;
136 my ($obj) = @_;
137}
138
139sub begin_work {
140 my $self = shift;
141 my ($obj) = @_;
142}
143
144sub rollback {
145 my $self = shift;
146 my ($obj) = @_;
147}
148
149sub commit {
150 my $self = shift;
151 my ($obj) = @_;
152}
153
154
1551;
156__END__