line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Decl::Semantics::Database;
|
2
|
|
|
|
|
|
|
|
3
|
12
|
|
|
12
|
|
78
|
use warnings;
|
|
12
|
|
|
|
|
22
|
|
|
12
|
|
|
|
|
532
|
|
4
|
12
|
|
|
12
|
|
73
|
use strict;
|
|
12
|
|
|
|
|
24
|
|
|
12
|
|
|
|
|
512
|
|
5
|
|
|
|
|
|
|
|
6
|
12
|
|
|
12
|
|
72
|
use base qw(Decl::Node);
|
|
12
|
|
|
|
|
27
|
|
|
12
|
|
|
|
|
1206
|
|
7
|
12
|
|
|
12
|
|
75
|
use Text::ParseWords;
|
|
12
|
|
|
|
|
26
|
|
|
12
|
|
|
|
|
950
|
|
8
|
12
|
|
|
12
|
|
72
|
use Iterator::Simple qw(:all);
|
|
12
|
|
|
|
|
26
|
|
|
12
|
|
|
|
|
3239
|
|
9
|
12
|
|
|
12
|
|
78
|
use Carp;
|
|
12
|
|
|
|
|
29
|
|
|
12
|
|
|
|
|
734
|
|
10
|
12
|
|
|
12
|
|
73
|
use DBI;
|
|
12
|
|
|
|
|
20
|
|
|
12
|
|
|
|
|
7102
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Decl::Semantics::Database - implements a database handle.
|
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
|
|
|
|
|
|
|
62% of all Perl code deals with databases. (I just made that up.) This is because L is a work of beauty. But seriously, every time
|
28
|
|
|
|
|
|
|
I go to use DBI I have to cut and paste from existing code, because I I. This module is a first stab
|
29
|
|
|
|
|
|
|
at presenting databases the way I see them in my mind.
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
So. There are two ways to hit databases, essentially. The first is the query: given a database out there somewhere, I want to extract
|
32
|
|
|
|
|
|
|
data from it. The data is going to be delivered in an iterator, and in 90% of cases I'm just going to loop over the rows returned and do
|
33
|
|
|
|
|
|
|
something really simple with it.
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
I abstract that out like this (and forgive the Windows/Microsoftiness of it; that's just what I'm doing today):
|
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
database (msaccess) "mydatabase.mdb"
|
38
|
|
|
|
|
|
|
query need_invoicing "SELECT [jobs to invoice].customer as customer, Sum([jobs to invoice].value) AS total_value FROM [jobs to invoice] GROUP BY [jobs to invoice].customer ORDER BY [jobs to invoice].customer"
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
do {
|
41
|
|
|
|
|
|
|
^foreach need_invoicing {
|
42
|
|
|
|
|
|
|
print "$customer\t$total_value\n";
|
43
|
|
|
|
|
|
|
}
|
44
|
|
|
|
|
|
|
}
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Alternatively, if you don't like the long line there (neither do I), I could have specified the query as:
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
database (msaccess) "mydatabase.mdb"
|
49
|
|
|
|
|
|
|
query need_invoicing
|
50
|
|
|
|
|
|
|
select "[jobs to invoice].customer as customer, Sum([jobs to invoice].value) AS total_value"
|
51
|
|
|
|
|
|
|
from "jobs to invoice"
|
52
|
|
|
|
|
|
|
group "customer"
|
53
|
|
|
|
|
|
|
order "total_value desc"
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
This sets up all the handles for me and even builds the loop code, and I don't have the chance to screw it up. Mission accomplished.
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
More generally, I can set up a query that can take (optional) parameters, and at some point I can also do discovery of the existing
|
58
|
|
|
|
|
|
|
database upon connection. And of course I can also set up non-query queries like insert, update, and delete SQL, add tables, and so on,
|
59
|
|
|
|
|
|
|
but I'm really not worried about that right at the moment; I just want to be able to grab data from a database.
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
The second major case for database interaction is object storage. The way I see this is equally simple: I add an object, and get a key.
|
62
|
|
|
|
|
|
|
Given the key, I can then retrieve, update, or delete the object at a later date. Objects are going to end up being nodes (duh), and yes,
|
63
|
|
|
|
|
|
|
you read this correctly that this model will cover NoSQL databases just fine.
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head1 DRIVERS
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
There is just no way around a driver system for databases. We're lucky to have DBI and its driver system for most work, but sometimes there
|
68
|
|
|
|
|
|
|
will be a database that we'll want to do a little more with (MS Access being a case in point).
|
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
If this is the case, that driver can be a separate module Decl::Semantics::Database::. This uses the Perl module
|
71
|
|
|
|
|
|
|
system to provide as much flexibility in system configuration as possible without being too nasty.
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Right now, I'm going to special-case some stuff for Access and CSV because I need those and don't want to mess with the directory structure
|
74
|
|
|
|
|
|
|
today.
|
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head2 SPECIAL SUBTAGS
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
The only meaningful child right now is "query", which will macro-insert a data tag (i.e. an iterator) as a sibling of the database. When
|
79
|
|
|
|
|
|
|
the database node is built, it thus creates a data source for each query defined that can be referred to in code downstream of the database.
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
I can imagine other subtags later, perhaps "table" for database management, and certainly something for the NoSQL-like model, whatever that
|
82
|
|
|
|
|
|
|
turns out to look like. But those will come when the need arises.
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head1 FUNCTIONS DEFINED
|
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head2 defines(), tags_defined()
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=cut
|
89
|
0
|
|
|
0
|
1
|
0
|
sub defines { ('database'); }
|
90
|
12
|
|
|
12
|
1
|
94
|
sub tags_defined { Decl->new_data(<
|
91
|
|
|
|
|
|
|
database (body=vanilla)
|
92
|
|
|
|
|
|
|
EOF
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=head2 build_payload
|
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
We connect to the database for our payload. The payload itself will be our dbi handle (the one normally called C<$dbh>).
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=cut
|
99
|
|
|
|
|
|
|
sub build_payload {
|
100
|
1
|
|
|
1
|
1
|
3
|
my ($self) = @_;
|
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# Figure out what DBI driver to use and how to handle any special-case parameters. Note that CSV and Access are here.
|
103
|
1
|
|
|
|
|
3
|
my $dbi = '';
|
104
|
|
|
|
|
|
|
|
105
|
1
|
|
|
|
|
6
|
my $specials = {RaiseError => 1};
|
106
|
|
|
|
|
|
|
|
107
|
1
|
50
|
|
|
|
9
|
if (lc($self->parameter_n(1)) eq 'csv') {
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
108
|
1
|
|
|
|
|
2
|
$dbi = 'dbi:CSV:';
|
109
|
1
|
|
|
|
|
4
|
$self->{database_type} = 'csv';
|
110
|
1
|
|
|
|
|
10
|
$specials->{f_dir} = $self->label;
|
111
|
|
|
|
|
|
|
# f_ -> schema (complex), dir, ext, lock, encoding
|
112
|
|
|
|
|
|
|
# csv_ -> eol, sep_char, quote_char, escape_char, class, null, tables (complex)
|
113
|
|
|
|
|
|
|
} elsif (lc($self->parameter_n(1)) eq 'msaccess') {
|
114
|
0
|
|
|
|
|
0
|
my $l = $self->label;
|
115
|
0
|
|
|
|
|
0
|
$self->{database_type} = 'msaccess';
|
116
|
0
|
|
|
|
|
0
|
$l =~ s/\\/\\\\/g;
|
117
|
|
|
|
|
|
|
#$l =~ s/\//\\/g;
|
118
|
0
|
|
|
|
|
0
|
$dbi = 'dbi:ODBC:driver=microsoft access driver (*.mdb);dbq=' . $l;
|
119
|
|
|
|
|
|
|
} elsif (lc($self->parameter_n(1)) eq 'sqlite') {
|
120
|
0
|
|
|
|
|
0
|
$dbi = 'dbi:SQLite:' . $self->label;
|
121
|
0
|
|
|
|
|
0
|
$self->{database_type} = 'sqlite';
|
122
|
|
|
|
|
|
|
} else {
|
123
|
|
|
|
|
|
|
# We just assume vanilla DBI otherwise, nothing special.
|
124
|
0
|
0
|
|
|
|
0
|
if ($self->parameter_n(1)) {
|
125
|
0
|
|
|
|
|
0
|
$dbi = "DBI:" . $self->parameter_n(1) . ':' . $self->label;
|
126
|
0
|
|
|
|
|
0
|
$self->{database_type} = lc($self->parameter_n(1));
|
127
|
|
|
|
|
|
|
} else {
|
128
|
0
|
|
|
|
|
0
|
$self->{database_type} = $self->label;
|
129
|
0
|
|
|
|
|
0
|
$self->{database_type} =~ s/:.*$//;
|
130
|
0
|
|
|
|
|
0
|
$dbi = 'DBI:' . $self->label;
|
131
|
|
|
|
|
|
|
}
|
132
|
|
|
|
|
|
|
}
|
133
|
|
|
|
|
|
|
|
134
|
1
|
0
|
|
|
|
13
|
$self->{payload} = DBI->connect ($dbi, undef, undef, $specials) or croak $DBI::errstr;
|
135
|
|
|
|
|
|
|
}
|
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head1 DATABASE-SPECIFIC FUNCTIONS
|
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=head2 dbh
|
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
An alias to the payload (the database handle) if you want to use conventional DBI techniques:
|
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
my $dbh = ^('database')->dbh;
|
145
|
|
|
|
|
|
|
$dbh->tables or whatever
|
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=cut
|
148
|
|
|
|
|
|
|
|
149
|
0
|
|
|
0
|
1
|
|
sub dbh { $_[0]->payload }
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=head2 dbtype
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Returns the type of database.
|
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=cut
|
156
|
0
|
|
|
0
|
1
|
|
sub dbtype { $_[0]->{database_type} }
|
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=head2 table_info
|
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
Returns information about the given table. How the table is specified depends on the database type - if the database driver has
|
161
|
|
|
|
|
|
|
multiple sets of tables, the "main" one will be used. If you need the actual DBI table_info functionality, get a handle with dbh first.
|
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=cut
|
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub table_info {
|
166
|
0
|
|
|
0
|
1
|
|
my ($self, $table) = @_;
|
167
|
|
|
|
|
|
|
|
168
|
0
|
|
|
|
|
|
my $sth = $self->dbh->table_info(undef, "main", $table, undef);
|
169
|
0
|
|
|
|
|
|
my $data = $sth->fetchrow_hashref;
|
170
|
0
|
|
|
|
|
|
return $data;
|
171
|
|
|
|
|
|
|
}
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=head1 AUTHOR
|
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
Michael Roberts, C<< >>
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=head1 BUGS
|
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through
|
180
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll
|
181
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes.
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT
|
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Copyright 2010 Michael Roberts.
|
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
188
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published
|
189
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License.
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information.
|
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=cut
|
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
1; # End of Decl::Semantics::Database
|