line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package NoSQL::PL2SQL::DBI::Null ; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
sub AUTOLOAD { |
4
|
0
|
|
|
0
|
|
|
my $self = shift ; |
5
|
0
|
|
|
|
|
|
my $sql = shift ; |
6
|
0
|
|
|
|
|
|
return $sql ; |
7
|
|
|
|
|
|
|
} |
8
|
|
|
|
|
|
|
|
9
|
0
|
|
|
0
|
|
|
sub DESTROY {} |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
package NoSQL::PL2SQL::DBI ; |
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
29
|
use 5.008009; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
38
|
|
14
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
36
|
|
15
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
29
|
|
16
|
1
|
|
|
1
|
|
318523
|
use DBI ; |
|
1
|
|
|
|
|
21126
|
|
|
1
|
|
|
|
|
77
|
|
17
|
1
|
|
|
1
|
|
3445
|
use XML::Parser::Nodes ; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
require Exporter; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# Items to export into callers namespace by default. Note: do not export |
24
|
|
|
|
|
|
|
# names by default without a very good reason. Use EXPORT_OK instead. |
25
|
|
|
|
|
|
|
# Do not simply export all your public functions/methods/constants. |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# This allows declaration use NoSQL::PL2SQL::Node ':all'; |
28
|
|
|
|
|
|
|
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK |
29
|
|
|
|
|
|
|
# will save memory. |
30
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( 'all' => [ qw() ] ) ; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ) ; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
our @EXPORT = qw() ; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
our $VERSION = '0.12'; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# Preloaded methods go here. |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my @sqllog ; |
41
|
|
|
|
|
|
|
my $nulldbi = bless \( my $null = 'NoSQL::PL2SQL::DBI::Null' ), |
42
|
|
|
|
|
|
|
'NoSQL::PL2SQL::DBI::Null' ; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
## I started looking for an XML based schema that is implementation |
45
|
|
|
|
|
|
|
## independent. This one, my own invention and based on MySQL, was |
46
|
|
|
|
|
|
|
## originally a placeholder. Suffice that it remains a TODO... |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
my $xmlschema =<<'endschema' ; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
endschema |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
my $indexschema =<<'endschema' ; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
endschema |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub schema { |
120
|
|
|
|
|
|
|
my $self = shift ; |
121
|
|
|
|
|
|
|
my $package = ref $self || $self ; |
122
|
|
|
|
|
|
|
my $schema = @_? shift( @_ ): $xmlschema ; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
my $nodes = bless XML::Parser::Nodes->new( $schema ), |
125
|
|
|
|
|
|
|
join( '::', $package, 'Schema' ) ; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
return $nodes->schema ; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
## indexschema is used by NoSQL::PL2SQL::Simple. No one has expressed |
131
|
|
|
|
|
|
|
## an intention of another DBI implementation. Since I can get away with |
132
|
|
|
|
|
|
|
## it, I'm arbitrarily extending this definition, and I really shouldn't. |
133
|
|
|
|
|
|
|
## In the future apps, will have to create their own database specific |
134
|
|
|
|
|
|
|
## subclasses: NoSQL::PL2SQL::Simple::MySQL, etc. |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub indexschema { |
137
|
|
|
|
|
|
|
return $indexschema ; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub sqldump { |
141
|
|
|
|
|
|
|
shift @_ ; |
142
|
|
|
|
|
|
|
@sqllog = () if @_ ; |
143
|
|
|
|
|
|
|
return @sqllog ; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub debug { |
147
|
|
|
|
|
|
|
push @sqllog, $_[-1] if @_ ; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub sqlstatement { |
151
|
|
|
|
|
|
|
my $self = shift ; |
152
|
|
|
|
|
|
|
my $sprintf = shift ; |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
my $ct = 0 ; |
155
|
|
|
|
|
|
|
$ct++ while $sprintf =~ /%s/g ; |
156
|
|
|
|
|
|
|
return sprintf $sprintf, ( $self->[1] ) x$ct ; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub do { |
160
|
|
|
|
|
|
|
my $self = shift ; |
161
|
|
|
|
|
|
|
push @sqllog, my $sql = $self->sqlstatement( @_ ) ; |
162
|
|
|
|
|
|
|
return $self->db->do( $sql ) ; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub rows_hash { |
166
|
|
|
|
|
|
|
my $self = shift ; |
167
|
|
|
|
|
|
|
push @sqllog, my $sql = $self->sqlstatement( @_ ) ; |
168
|
|
|
|
|
|
|
my $st = $self->db->prepare( $sql ) ; |
169
|
|
|
|
|
|
|
$st->execute ; |
170
|
|
|
|
|
|
|
my @out = () ; |
171
|
|
|
|
|
|
|
my $o ; |
172
|
|
|
|
|
|
|
push @out, { %$o } while $o = $st->fetchrow_hashref ; |
173
|
|
|
|
|
|
|
return $out[0] unless wantarray ; |
174
|
|
|
|
|
|
|
return @out ; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub rows_array { |
178
|
|
|
|
|
|
|
my $self = shift ; |
179
|
|
|
|
|
|
|
push @sqllog, my $sql = $self->sqlstatement( @_ ) ; |
180
|
|
|
|
|
|
|
my $st = $self->db->prepare( $sql ) ; |
181
|
|
|
|
|
|
|
$st->execute ; |
182
|
|
|
|
|
|
|
my @out = () ; |
183
|
|
|
|
|
|
|
my $o ; |
184
|
|
|
|
|
|
|
push @out, [ @$o ] while $o = $st->fetchrow_arrayref ; |
185
|
|
|
|
|
|
|
return $out[0] unless wantarray ; |
186
|
|
|
|
|
|
|
return @out ; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub new { |
190
|
|
|
|
|
|
|
my $package = shift ; |
191
|
|
|
|
|
|
|
my $tablename = shift( @_ ) || '%s' ; |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
if ( ref $package ) { |
194
|
|
|
|
|
|
|
$tablename = $package->table ; |
195
|
|
|
|
|
|
|
$package = ref $package ; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
return bless [ $nulldbi, $tablename ], $package ; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub connect { |
202
|
|
|
|
|
|
|
my $self = shift ; |
203
|
|
|
|
|
|
|
my $ref = $self ; |
204
|
|
|
|
|
|
|
$ref = $ref->[0] while ref $ref eq ref $self |
205
|
|
|
|
|
|
|
&& ref $ref->[0] eq ref $self ; |
206
|
|
|
|
|
|
|
$ref->[0] = DBI->connect( @_ ) ; |
207
|
|
|
|
|
|
|
return $self ; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub table { |
211
|
|
|
|
|
|
|
my $self = shift ; |
212
|
|
|
|
|
|
|
return $self->[1] unless @_ ; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
my $package = ref $self ; |
215
|
|
|
|
|
|
|
my $out = $package->new( @_ ) ; |
216
|
|
|
|
|
|
|
$out->[0] = $self ; |
217
|
|
|
|
|
|
|
return $out ; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub db { |
221
|
|
|
|
|
|
|
my $self = shift ; |
222
|
|
|
|
|
|
|
return ref $self->[0] eq ref $self? $self->[0]->db: $self->[0] ; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub dbconnected { |
226
|
|
|
|
|
|
|
my $self = shift ; |
227
|
|
|
|
|
|
|
my $db = $self->db ; |
228
|
|
|
|
|
|
|
my $unconnected = $db->isa('SCALAR') && $$db eq ref $db ; |
229
|
|
|
|
|
|
|
return ! $unconnected ; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
## Implementation Specific |
233
|
|
|
|
|
|
|
## optionally pass a scalar integer- otherwise same arguments as fetch() |
234
|
|
|
|
|
|
|
sub delete { |
235
|
|
|
|
|
|
|
my $self = shift ; |
236
|
|
|
|
|
|
|
my @delete = ref $_[0]? @_: ( [ id => $_[0] ] ) ; |
237
|
|
|
|
|
|
|
return $self->fetch( 'DELETE FROM %s WHERE', @delete ) ; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
## Implementation Specific |
241
|
|
|
|
|
|
|
sub lastinsertid { |
242
|
|
|
|
|
|
|
my $self = shift ; |
243
|
|
|
|
|
|
|
my $db = $self->db ; |
244
|
|
|
|
|
|
|
return ! $self->dbconnected? 0: |
245
|
|
|
|
|
|
|
$db->last_insert_id( |
246
|
|
|
|
|
|
|
undef, undef, $self->table, 'id' ) ; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
## Implementation Specific |
250
|
|
|
|
|
|
|
sub sqlupdate { |
251
|
|
|
|
|
|
|
my $self = shift ; |
252
|
|
|
|
|
|
|
my $nvp = shift ; |
253
|
|
|
|
|
|
|
my $sql = sprintf 'UPDATE %s SET %s WHERE', '%s', $nvp ; |
254
|
|
|
|
|
|
|
return $self->fetch( $sql, @_ ) ; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
## update() method is used for SQL "INSERT" and "UPDATE" constructions. |
258
|
|
|
|
|
|
|
## Implementation Specific. Default method is MySQL syntax. |
259
|
|
|
|
|
|
|
sub update { |
260
|
|
|
|
|
|
|
my $self = shift ; |
261
|
|
|
|
|
|
|
my $id = shift ; |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
## Each subsequent argument is an NVP array reference. An optional |
264
|
|
|
|
|
|
|
## third element, if true, indicates a string value |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
my @pairsf = ( '%s=%s', '%s="%s"', '%s=NULL' ) ; |
267
|
|
|
|
|
|
|
my @termsf = ( '%s', '"%s"', 'NULL' ) ; |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
my $keys = join ',', map { $_->[0] } @_ ; |
270
|
|
|
|
|
|
|
my $values = join ',', map { |
271
|
|
|
|
|
|
|
sprintf $termsf[ defined $_->[1]? |
272
|
|
|
|
|
|
|
$_->[2] || length $_->[1] == 0: 2 ], |
273
|
|
|
|
|
|
|
$self->stringencode( $_->[1], ! $_->[2] ) ; |
274
|
|
|
|
|
|
|
} @_ ; |
275
|
|
|
|
|
|
|
my $nvp = join ',', map { |
276
|
|
|
|
|
|
|
sprintf $pairsf[ defined $_->[1]? |
277
|
|
|
|
|
|
|
$_->[2] || length $_->[1] == 0: 2 ], |
278
|
|
|
|
|
|
|
$_->[0], $self->stringencode( $_->[1], ! $_->[2] ) |
279
|
|
|
|
|
|
|
} @_ ; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
## User data should never be passed to sqlstatement() |
282
|
|
|
|
|
|
|
my $update = $self->sqlstatement( 'UPDATE %s' ) ; |
283
|
|
|
|
|
|
|
my $insert = $self->sqlstatement( 'INSERT INTO %s' ) ; |
284
|
|
|
|
|
|
|
my $sql = defined $id? |
285
|
|
|
|
|
|
|
"$update SET $nvp WHERE id=$id": |
286
|
|
|
|
|
|
|
"$insert ($keys) VALUES ($values)" ; |
287
|
|
|
|
|
|
|
$self->debug( $sql ) if $self->dbconnected ; |
288
|
|
|
|
|
|
|
my $sqlresults = $self->db->do( $sql ) ; ## do not combine |
289
|
|
|
|
|
|
|
return { id => $id || $self->lastinsertid, |
290
|
|
|
|
|
|
|
sqlresults => $sqlresults, |
291
|
|
|
|
|
|
|
nvp => $nvp |
292
|
|
|
|
|
|
|
} ; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
sub insert { |
296
|
|
|
|
|
|
|
my $self = shift ; |
297
|
|
|
|
|
|
|
return $self->update( undef, @_ ) ; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
sub exclude { |
301
|
|
|
|
|
|
|
shift @_ ; |
302
|
|
|
|
|
|
|
my $package = join '::', __PACKAGE__, 'exclude' ; |
303
|
|
|
|
|
|
|
my @out = map { bless $_, $package } @_ ; |
304
|
|
|
|
|
|
|
return wantarray? @out: $out[0] ; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
## Implementation Specific. Default method is MySQL syntax. |
308
|
|
|
|
|
|
|
sub fetch { |
309
|
|
|
|
|
|
|
my $self = shift ; |
310
|
|
|
|
|
|
|
my $delete = ( @_ && ! ref $_[0] )? shift( @_ ): undef ; |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
my @pairsf = ( '%s=%s', '%s="%s"', '%s=NULL' ) ; |
313
|
|
|
|
|
|
|
my @invert = ( '%s!=%s', '%s!="%s"', '%s NOT NULL' ) ; |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
my $exclude = ref $self->exclude( [] ) ; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
my @terms = () ; |
318
|
|
|
|
|
|
|
foreach ( @_ ) { |
319
|
|
|
|
|
|
|
my @how = ref $_ eq $exclude? @invert: @pairsf ; |
320
|
|
|
|
|
|
|
push @terms, sprintf |
321
|
|
|
|
|
|
|
$how[ defined $_->[1]? |
322
|
|
|
|
|
|
|
$_->[2] || length $_->[1] == 0: 2 ], |
323
|
|
|
|
|
|
|
$_->[0], |
324
|
|
|
|
|
|
|
$self->stringencode( $_->[1], ! $_->[2] ) ; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
my $sql = join ' ', $delete || 'SELECT * FROM %s WHERE', |
328
|
|
|
|
|
|
|
join ' AND ', @terms ; |
329
|
|
|
|
|
|
|
return $self->do( $sql ) if defined $delete || ! $self->dbconnected ; |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
my @out = $self->rows_hash( $sql ) ; |
332
|
|
|
|
|
|
|
return wantarray? @out: { map { $_->{id} => $_ } @out } ; |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
## Implementation Specific. Default method is MySQL syntax. |
336
|
|
|
|
|
|
|
sub stringencode { |
337
|
|
|
|
|
|
|
my $self = shift ; |
338
|
|
|
|
|
|
|
my $text = shift ; |
339
|
|
|
|
|
|
|
return $text unless defined $text ; |
340
|
|
|
|
|
|
|
return $text if @_ && $_[0] ; |
341
|
|
|
|
|
|
|
$text =~ s/"/""/gs ; |
342
|
|
|
|
|
|
|
$text =~ s/\\/\\\\/gs ; |
343
|
|
|
|
|
|
|
return $text ; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
sub AUTOLOAD { |
347
|
|
|
|
|
|
|
my $self = shift ; |
348
|
|
|
|
|
|
|
my $sql = shift ; |
349
|
|
|
|
|
|
|
my $package = ref $self ; |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
use vars qw( $AUTOLOAD ) ; |
352
|
|
|
|
|
|
|
my $func = $AUTOLOAD ; |
353
|
|
|
|
|
|
|
$func =~ s/^${package}::// ; |
354
|
|
|
|
|
|
|
return if $func eq 'DESTROY' ; |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
my $cmd = sprintf '$self->db->%s( sprintf $sql || "", $self->table )', |
357
|
|
|
|
|
|
|
$func ; |
358
|
|
|
|
|
|
|
return eval $cmd ; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
sub loadschema { |
362
|
|
|
|
|
|
|
my $self = shift ; |
363
|
|
|
|
|
|
|
return map { $self->do( $_ ) } $self->schema( @_ ) ; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
package NoSQL::PL2SQL::DBI::Schema ; |
368
|
|
|
|
|
|
|
use base qw( XML::Parser::Nodes ) ; |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub schema { |
371
|
|
|
|
|
|
|
shift @_ unless ref $_[0] ; |
372
|
|
|
|
|
|
|
my $self = shift ; |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
my @mysql = $self->childnode('mysql') ; |
375
|
|
|
|
|
|
|
return map { $self->new( $_ )->schema } |
376
|
|
|
|
|
|
|
@mysql? $mysql[0]->childnodes: $self->childnodes ; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
sub new { |
380
|
|
|
|
|
|
|
my $self = shift ; |
381
|
|
|
|
|
|
|
my $nodechild = shift ; |
382
|
|
|
|
|
|
|
my $package = ref $self ; |
383
|
|
|
|
|
|
|
my @package = () ; |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
my @nodenames = () ; |
386
|
|
|
|
|
|
|
my @refself = split /::/, $package ; |
387
|
|
|
|
|
|
|
push @nodenames, pop @refself |
388
|
|
|
|
|
|
|
while @refself && $refself[-1] ne 'Schema' ; |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
push @package, join '::', $package, $nodechild->[0] ; |
391
|
|
|
|
|
|
|
return bless $nodechild->[1], $package[-1] |
392
|
|
|
|
|
|
|
if eval join '', '@', $package[-1], '::ISA' ; |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
push @package, join '::', __PACKAGE__, @nodenames, $nodechild->[0] ; |
395
|
|
|
|
|
|
|
return bless $nodechild->[1], $package[-1] |
396
|
|
|
|
|
|
|
if eval join '', '@', $package[-1], '::ISA' ; |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
return bless $nodechild->[1], join '::', @refself ; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
sub command { |
402
|
|
|
|
|
|
|
my $self = shift ; |
403
|
|
|
|
|
|
|
my $command = $self->getattributes->{command} || '' ; |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
return eval sprintf '$self->%s()', $command if $command ; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
## Example Base Node Schemas |
409
|
|
|
|
|
|
|
# |
410
|
|
|
|
|
|
|
# package NoSQL::PL2SQL::DBI::Schema::table ; |
411
|
|
|
|
|
|
|
# use base qw( NoSQL::PL2SQL::DBI::Schema ) ; |
412
|
|
|
|
|
|
|
# |
413
|
|
|
|
|
|
|
# sub schema { |
414
|
|
|
|
|
|
|
# shift @_ unless ref $_[0] ; |
415
|
|
|
|
|
|
|
# my $self = shift ; |
416
|
|
|
|
|
|
|
# |
417
|
|
|
|
|
|
|
# ## default table definition |
418
|
|
|
|
|
|
|
# } |
419
|
|
|
|
|
|
|
# |
420
|
|
|
|
|
|
|
# package NoSQL::PL2SQL::DBI::Schema::index ; |
421
|
|
|
|
|
|
|
# use base qw( NoSQL::PL2SQL::DBI::Schema ) ; |
422
|
|
|
|
|
|
|
# |
423
|
|
|
|
|
|
|
# sub schema { |
424
|
|
|
|
|
|
|
# shift @_ unless ref $_[0] ; |
425
|
|
|
|
|
|
|
# my $self = shift ; |
426
|
|
|
|
|
|
|
# |
427
|
|
|
|
|
|
|
# ## default index definition |
428
|
|
|
|
|
|
|
# } |
429
|
|
|
|
|
|
|
# |
430
|
|
|
|
|
|
|
1; |
431
|
|
|
|
|
|
|
__END__ |