File Coverage

lib/Decl/Semantics/Table.pm
Criterion Covered Total %
statement 22 131 16.7
branch 0 44 0.0
condition 0 20 0.0
subroutine 8 20 40.0
pod 13 13 100.0
total 43 228 18.8


line stmt bran cond sub pod time code
1             package Decl::Semantics::Table;
2            
3 12     12   75 use warnings;
  12         22  
  12         440  
4 12     12   69 use strict;
  12         27  
  12         547  
5            
6 12     12   62 use base qw(Decl::Node);
  12         95  
  12         1156  
7 12     12   70 use Text::ParseWords;
  12         24  
  12         926  
8 12     12   75 use Iterator::Simple qw(:all);
  12         24  
  12         3170  
9 12     12   179 use Carp;
  12         28  
  12         745  
10 12     12   32789 use DBI;
  12         255763  
  12         20950  
11            
12             =head1 NAME
13            
14             Decl::Semantics::Table - implements a table in a database.
15            
16             =head1 VERSION
17            
18             Version 0.01
19            
20             =cut
21            
22             our $VERSION = '0.01';
23            
24            
25             =head1 SYNOPSIS
26            
27             When working with databases, it is always true that we make certain assumptions about its structure (what tables it has, what fields they have).
28             The C tag is how we define what in a table we intend to use, and how we expect it to be formatted. When developing a system from scratch, the
29             C tag can even create the table directly, and if we continue to give it authoritative status, it can also modify the existing tables to meet
30             the specifications of the script. It does so by generating SQL CREATE and ALTER TABLE statements and running them against its database.
31            
32             A set of tables can also be told to generate a full SQL schema without talking to the database directly. This is the default if no database handle
33             is defined.
34            
35             The semantics of the C tag, as you'll not be surprised to hear, correspond closely to SQL semantics. There are just a few differences, and as usual,
36             you don't have to use them if you don't want to, but I find them useful. Note that at the moment, these semantics are a subset of full SQL - don't expect to do your
37             DBA work through the C tag. The point of this exercise right now is to provide more of a quick sketch tool that generates simple SQL that can be refined as
38             needed; my own SQL work is pretty superficial, so to do a better job, I'll eventually have to put a lot more work into refining the semantics of database management.
39            
40             =head2 Basic types
41            
42             Each column in a table has a type. I'm arbitrarily calling these types int, float, char, text, bool, and date (the last being a timestamp).
43             You can, of course, use anything else you want as a type, and the C tag will assume it's SQL and pass it through, for better or worse; this
44             allows you to use anything specifically defined for your own database.
45            
46             A field specification in the C tag is backwards from SQL - the type comes first. I'm really not doing this to mess with your head; tags are better
47             suited for expression of type, so this matches C::Decl semantics better. If you really hate it, use the C subtag - this passes whatever it sees through as SQL
48             without trying to get cute at all. It doesn't even try to parse it, actually, except to strip out the first word as the field name. So this will work fine:
49            
50             table mytable
51             sql key integer not null
52             sql field varchar(200) not null default 'George'
53            
54             This is your best bet when you start to offload checks to the database instead of just hacking something together.
55            
56             As always with Decl, the idea is to make it easy to slap something together while making it possible to be careful later. Nowhere is this
57             attitude more evident than here in my glossing over the vast and troubled territory that is SQL. Did you know the 'S' is for 'standard'? Have you ever seen a more
58             ironic acronym?
59            
60             One more "basic" type: a C is always an integer that autoincrements. You can have a character key by saying e.g. C; a character key is simply
61             declared PRIMARY KEY.
62            
63             =head2 Structural types
64            
65             To represent relationships between tables, I'm using C> (defines a field named after the table with the same type as the table's key),
66             C> (in case you want to name it something else; maybe you have two such fields, for example), and "list". The list actually defines
67             a subtable, and there are two variants: C>/C> (defines an n-to-n relationship to the other table by means of an
68             anonymous linking table), and a multilined variant:
69            
70             list
71             int field1
72             int field2
73            
74             This actually creates an new table called _ and gives it those two fields, plus the key of the master table.
75            
76             All of this makes it simpler and quicker to set up a normalized database and build queries against it that can be called from code.
77            
78             =head2 Data dictionary
79            
80             The data dictionary is a quick and easy way to define new "types" - a title may be standardized throughout your database as a char (100), for example. So:
81            
82             data-dictionary
83             char title (100)
84            
85             Now we can use the title as a field type anywhere:
86            
87             table
88             title
89            
90             or
91            
92             table
93             title
94             title subtitle
95            
96             If a field is not named, the type name will also be used as the default field name. (This seems pretty reasonable.)
97            
98             =head1 FUTURE POSSIBILITIES
99            
100             =head2 Variant SQL data dictionaries
101            
102             The tags used in the data dictionary are C, whatever that might mean for your own database. C
103             then you can define database-specific data dictionaries like this:
104            
105             data-dictionary (msaccess)
106             char title (100)
107            
108             and so on. If you leave one data dictionary unadorned with a database type, then it will serve as the default for any fields that don't have to be defined
109             differently between the different databases. I wrestled with this setup, but I think it's the cleanest way to represent these things - plus it gives the added
110             benefit that if you move from database A to database B, you can simply take your data dictionary and work down the list deciding which datatypes correspond to
111             what in the new regime, then use the new data dictionary with no other format changes.
112            
113             How often will this come up, though? No idea. I just worry, that's all.
114            
115             At any rate, you can think of the special definitions for generic datatypes defined by this code as a default data dictionary. Any of those types may be overridden.
116             Clear? Of course it is.
117            
118             =head2 More refined DBA facilities
119            
120             Defining indices would be nice, wouldn't it?
121            
122             =head2 Building a spec based on existing SQL table definitions
123            
124             This would be useful for introspection as well.
125            
126             =head1 FUNCTIONS DEFINED
127            
128             =head2 defines(), tags_defined()
129            
130             =cut
131 0     0 1 0 sub defines { ('table', 'data-dictionary'); }
132 12     12 1 138 sub tags_defined { Decl->new_data(<
133             table (body=vanilla)
134             data-dictionary (body=vanilla)
135             EOF
136            
137             =head2 build_payload, build_table, build_ddict
138            
139             We connect to the default database - unless we are actually in a database object, or given a specific database by name.
140            
141             We first write SQL to define the table, and query the database to see what structure it thinks that table has (if it has that table), and of
142             course, we do the same for any subtables. If there's a mismatch, we generate SQL to alter the table(s).
143            
144             If we have authority, we then execute any SQL already generated. There should probably be some kind of workflow step to allow this authority to
145             be delegated or deferred, but man, that's a can of worms that can be opened another day.
146            
147             The C tag thus doesn't actually I a payload per se.
148            
149             =cut
150             sub build_payload {
151 0     0 1   my $self = shift;
152 0           $self->{dictionary} = $self->find_context('data-dictionary');
153 0           foreach ($self->nodes) {
154 0 0         $_->build if $_->can('build');
155             }
156            
157 0 0         return $self->build_table(@_) if $self->is('table');
158 0           $self->build_ddict(@_);
159             }
160            
161             sub build_table {
162 0     0 1   my $self = shift;
163            
164 0           $self->{tables} = [];
165 0           $self->{table_data} = {};
166 0           push @{$self->{tables}}, $self->name;
  0            
167 0           foreach my $l ($self->nodes()) {
168 0 0         if ($l->is('query')) {
169             # Not handling at the moment
170             } else {
171             # Anything else is either a list/link or a field.
172 0           my ($fname, $def) = $self->sql_single_field($self->name, $l);
173 0 0 0       $self->{key} = $fname if ($def->{key}) and not $self->{key};
174             }
175 0 0         if (not $self->{key}) {
176 0           $self->{key} = $self->default_key($self->name);
177             }
178             }
179            
180 0           my $database = $self->find_context('database');
181 0           my $dbtype = '';
182 0 0         $dbtype = $database->{database_type} if defined $database;
183 0           my $db = undef;
184 0 0 0       $db = $database if defined $database and $database->parameter('tables') eq 'active';
185            
186 0           $self->{sql} = join ("\n", map { $self->sql_single_table($_, $dbtype, $db) } @{$self->{tables}});
  0            
  0            
187             }
188            
189            
190            
191            
192             =head2 Helper functions sql_single_table() and sql_single_field
193            
194             These functions just spin out some SQL based on our data structures.
195            
196             =cut
197             sub sql_single_table {
198 0     0 1   my ($self, $table, $dbtype, $db) = @_;
199            
200 0           my $table_info;
201            
202 0 0         if (defined $db) {
203 0           $table_info = $db->table_info($table);
204             }
205            
206 0           my @fields = map {
207 0           my $fd = $self->{table_data}->{$table}->{fielddata}->{$_};
208 0 0         "$_ " . $fd->{type} . ($fd->{size} eq '' ? '' : ' (' . $fd->{size} . ")")
209 0           } @{$self->{table_data}->{$table}->{fields}};
210            
211 0           my $sql = "create table $table (\n " .
212             join (",\n ", @fields) .
213             "\n);\n";
214            
215 0 0 0       if (defined $db and not defined $table_info) {
216 0           print "Creating table $table\n";
217 0           $db->dbh->do($sql);
218             }
219            
220 0           return $sql;
221             }
222            
223             sub sql_single_field {
224 0     0 1   my ($self, $table, $field) = @_;
225 0 0         if ($field->is('list')) {
226 0 0         if ($field->nodes) {
227             # Subtable.
228 0   0       my $tname = $field->name || 'list';
229 0           my $subtable = $table . '_' . $tname;
230 0           push @{$self->{tables}}, $subtable;
  0            
231 0           my $key = $self->get_table_key($table);
232 0           my $keydef = $self->get_table_field($table, $key);
233 0           my $def = {
234             type => $keydef->{type},
235             size => $keydef->{size},
236             key => 0,
237             };
238 0           my $parent_key = 'ref_' . $key;
239 0           $self->add_field($subtable, $parent_key, $def);
240 0           $self->{tabledata}->{$subtable}->{parent_key} = $parent_key;
241 0           foreach ($field->nodes) {
242 0           $self->sql_single_field($subtable, $_);
243             }
244             } else {
245 0           my @names = $field->names;
246 0           my $tname;
247 0 0         if (@names == 0) {
    0          
248             # error
249 0           next;
250             } elsif (@names == 1) {
251 0           $tname = $names[0];
252             } else {
253 0           $tname = $names[1];
254             }
255 0           push @{$self->{tables}}, $table . '_link_' . $tname;
  0            
256             }
257             } else {
258 0   0       my $fname = $field->name || $field->tag;
259 0           my $type = $field->tag;
260 0   0       my $size = $field->parameter_n(0) || '';
261 0   0       my $key = $field->is('key') || $field->parameter('key') || 0;
262 0 0         if ($size eq 'key') {
263 0   0       $size = $field->parameter_n(1) || '';
264 0           $key = 1;
265             }
266 0 0         if (defined $self->{dictionary}) {
267 0           my $dict = $self->{dictionary}->dictionary_lookup($type);
268 0 0         if (defined $dict) {
269 0           $type = $dict->{type};
270 0 0         $size = $dict->{size} unless $size;
271 0 0         $key = $dict->{key} unless $key;
272             }
273             }
274 0           my $def = {
275             type => $type,
276             size => $size,
277             key => $key,
278             };
279 0           $self->add_field($table, $fname, $def);
280 0           return ($fname, $def);
281             }
282             }
283            
284             sub build_ddict {
285 0     0 1   my $self = shift;
286 0           $self->{tables} = ['dictionary'];
287 0           $self->{table_data}->{dictionary}->{fields} = [];
288 0           $self->{table_data}->{dictionary}->{fielddata} = {};
289 0           foreach my $l ($self->nodes()) {
290 0           $self->sql_single_field('dictionary', $l);
291             }
292             }
293            
294             =head2 dictionary_lookup
295            
296             This is called by a table on its dictionary to see if the dictionary knows about a given field. If the dictionary doesn't know, and if there
297             is a higher-level data dictionary, then it gets called, and so on.
298            
299             =cut
300            
301             sub dictionary_lookup {
302 0     0 1   my ($self, $field) = @_;
303 0           my $possible = $self->{table_data}->{dictionary}->{fielddata}->{$field};
304 0 0         return $possible if defined $possible;
305 0 0         if (defined $self->{dictionary}) {
306 0           return $self->{dictionary}->dictionary_lookup($field);
307             }
308 0           return;
309             }
310            
311             =head2 default_key, add_default_key, get_table_key, get_table_field, add_field
312            
313             Table access functions.
314            
315             =cut
316            
317             sub default_key {
318 0     0 1   my ($self, $table) = @_;
319 0           $table . '_id';
320             }
321             sub add_default_key {
322 0     0 1   my ($self, $table) = @_;
323 0           my $key = $self->default_key($table);
324 0           unshift @{$self->{table_data}->{$table}->{fields}}, $key;
  0            
325 0           $self->{table_data}->{$table}->{fielddata}->{$key} = {
326             type => 'int',
327             size => 'size',
328             key => 1
329             };
330 0           return $key;
331             }
332             sub get_table_key {
333 0     0 1   my ($self, $table) = @_;
334 0           foreach (@{$self->{table_data}->{$table}->{fields}}) {
  0            
335 0 0         return $_ if $self->{table_data}->{$table}->{fielddata}->{$_}->{key};
336             }
337 0           $self->add_default_key($table);
338             }
339             sub get_table_field {
340 0     0 1   my ($self, $table, $field) = @_;
341 0           $self->{table_data}->{$table}->{fielddata}->{$field};
342             }
343            
344             sub add_field {
345 0     0 1   my ($self, $table, $field, $def) = @_;
346 0           push @{$self->{table_data}->{$table}->{fields}}, $field;
  0            
347 0           $self->{table_data}->{$table}->{fielddata}->{$field} = $def;
348             }
349            
350            
351             =head1 AUTHOR
352            
353             Michael Roberts, C<< >>
354            
355             =head1 BUGS
356            
357             Please report any bugs or feature requests to C, or through
358             the web interface at L. I will be notified, and then you'll
359             automatically be notified of progress on your bug as I make changes.
360            
361             =head1 LICENSE AND COPYRIGHT
362            
363             Copyright 2010 Michael Roberts.
364            
365             This program is free software; you can redistribute it and/or modify it
366             under the terms of either: the GNU General Public License as published
367             by the Free Software Foundation; or the Artistic License.
368            
369             See http://dev.perl.org/licenses/ for more information.
370            
371             =cut
372            
373             1; # End of Decl::Semantics::Table