1package Oryx::DBI;
2
3use Oryx::DBI::Class;
4
5use base qw(Oryx Oryx::MetaClass Ima::DBI);
6
7our $DEBUG = 0;
8
9=head1 NAME
10
11Oryx::DBI - DBI Storage interface for Oryx
12
13=head1 SYNOPSIS
14
15 my $storage = Oryx::DBI->new;
16
17 $storage->connect([ 'dbi:Pg:dbname=mydb', $usname, $passwd]);
18 $storage->connect([ 'dbi:Pg:dbname=mydb', $usname, $passwd], $schema);
19
20 $storage->dbh;
21 $storage->db_name;
22 $storage->ping;
23 $storage->schema;
24 $storage->util;
25 $storage->set_util;
26 $storage->deploy_class;
27 $storage->deploy_schema;
28
29=head1 DESCRIPTION
30
31DBI Storage interface for Oryx. You should not need to instantiate
32this directly, use C<< Oryx->connect() >> instead.
33
34=head1 METHODS
35
36=over
37
38=item new
39
40Simple constructor
41
42=cut
43
44sub new {
45    my $class = shift;
46    return bless { }, $class;
47}
48
49=item connect( \@conn, [$schema] )
50
51Called by C<< Oryx->connect() >>. You shouldn't need to be doing this.
52
53=cut
54
55sub connect {
56    my ($self, $conn, $schema) = @_;
57
58    eval "use $schema"; $self->_croak($@) if $@;
59
60    my $db_name = $schema->name;
61    $self->_croak("no schema name '$db_name'")
62        unless $db_name;
63
64    ref($self)->set_db($db_name, @$conn)
65        unless UNIVERSAL::can($self, "db_$db_name");
66
67    $self->init('Oryx::DBI::Class', $conn, $schema);
68    return $self;
69}
70
71=item dbh
72
73returns the cached L<DBI> handle object
74
75=cut
76
77sub dbh {
78    my $class = shift;
79    my $db_name = $class->db_name;
80    eval { $class->$db_name };
81    $class->_croak($@) if $@;
82    return $class->$db_name();
83}
84
85=item db_name
86
87Shortcut for C<< "db_".$self->schema->name >> used for passing
88a name to L<Ima::DBI>'s C<set_db> method.
89
90=cut
91
92sub db_name {
93    my $self = shift;
94    return "db_".$self->schema->name;
95}
96
97=item ping
98
99ping the database
100
101=cut
102
103sub ping {
104    my $self = shift;
105    my $sth = $self->dbh->prepare('SELECT 1+1');
106    $sth->execute;
107    $sth->finish;
108}
109
110=item schema
111
112returns the schema if called with no arguments, otherwise
113sets if called with a L<Oryx::Schema> instance.
114
115=cut
116
117sub schema {
118    my $self = shift;
119    $self->{schema} = shift if @_;
120    $self->{schema};
121}
122
123=item util
124
125simple mutator for accessing the oryx::dbi::util::x instance
126
127=cut
128
129sub util {
130    my $self = shift;
131    $self->{util} = shift if @_;
132    $self->{util};
133}
134
135=item set_util
136
137determines which L<Oryx::DBI::Util> class to instantiate
138by looking at the dsn passed to C<connect> and sets it
139
140=cut
141
142sub set_util {
143    my ($self, $dsn) = @_;
144    $dsn =~ /^dbi:(\w+)/i;
145    my $utilClass = __PACKAGE__."\::Util\::$1";
146
147    eval "use $utilClass";
148    $self->_carp($@) if $@;
149
150    # Can't construct the utilClass: fallback to Generic and pray it works
151    unless (UNIVERSAL::can($utilClass, 'new')) {
152        $utilClass = __PACKAGE__."\::Util::Generic";
153
154        eval "use $utilClass";
155        $self->_croak($@) if $@;
156    }
157
158    $self->util($utilClass->new);
159}
160
161
162=item deploy_schema( $schema )
163
164Takes a L<Oryx::Schema> instance and deploys all classes seen by that
165schema instance to the database building all tables needed for storing
166your persistent objects.
167
168=cut
169
170sub deploy_schema {
171    my ($self, $schema) = @_;
172    $schema = $self->schema unless defined $schema;
173
174    $DEBUG && $self->_carp(
175	"deploy_schema $schema : classes => "
176        .join(",\n", $schema->classes)
177    );
178
179    foreach my $class ($schema->classes) {
180	$self->deploy_class($class);
181    }
182}
183
184=item deploy_class( $class )
185
186does the work of deploying a given class' tables and link tables to
187the database; called by C<deploy_schema>
188
189=cut
190
191sub deploy_class {
192    my $self = shift;
193    my $class = shift;
194    $DEBUG && $self->_carp("DEPLOYING $class");
195
196    eval "use $class"; $self->_croak($@) if $@;
197
198    my $dbh   = $class->dbh;
199    my $table = $class->table;
200
201    my $int = $self->util->type2sql('Integer');
202    my $oid = $self->util->type2sql('Oid');
203
204    my @columns = ('id');
205    my @types   = ($oid);
206    if ($class->is_abstract) {
207	$DEBUG && $self->_carp("CLASS $class IS ABSTRACT");
208	push @columns, '_isa';
209	push @types, $self->util->type2sql('String');
210    }
211
212    foreach my $attrib (values %{$class->attributes}) {
213	$DEBUG && $self->_carp("GOT ATTRIBUTE => $attrib");
214	push @columns, $attrib->name;
215	push @types, $self->util->type2sql($attrib->primitive, $attrib->size);
216    }
217
218    foreach my $assoc (values %{$class->associations}) {
219	my $target_class = $assoc->class;
220	eval "use $target_class"; $self->_croak($@) if $@;
221	if ($assoc->type ne 'Reference') {
222	    # create a link table
223	    my $lt_name = $assoc->link_table;
224	    my @lt_cols = $assoc->link_fields;
225	    my @lt_types = ($int) x 2;
226
227	    # set up the meta column (3rd entry in @lt_cols) to store
228	    # indicies or keys depeding on the type of Association
229	    if (lc($assoc->type) eq 'array') {
230		push @lt_types, $int;
231	    }
232	    elsif (lc($assoc->type) eq 'hash') {
233		push @lt_types, $self->util->type2sql('String');
234	    }
235
236	    $self->util->table_create(
237                $dbh, $lt_name, \@lt_cols, \@lt_types
238            );
239	}
240        elsif (not $assoc->is_weak) {
241	    push @types,   $int;
242	    push @columns, $assoc->role;
243	}
244    }
245
246    if (@{$class->parents}) {
247	my @lt_cols  = (lc($class->name.'_id'));
248	my @lt_types = ($int) x (scalar(@{$class->parents}) + 1);
249	my $lt_name  = lc($class->name."_parents");
250	push @lt_cols, map { lc($_->class->name) } @{$class->parents};
251
252	$DEBUG && $self->_carp(
253            "PARENT $_, lt_name => $lt_name, lt_cols => "
254	    .join("|", @lt_cols).", lt_types => "
255	    .join("|", @lt_types));
256
257	# create the link table
258	$self->util->table_create(
259            $dbh, $lt_name, \@lt_cols, \@lt_types
260        );
261    }
262
263    $self->util->table_create($dbh, $table, \@columns, \@types);
264#    $self->util->sequence_create($dbh, $table);
265
266    $dbh->commit;
267}
268
2691;
270
271=head1 SEE ALSO
272
273L<Oryx>, L<Oryx::Class>, L<Oryx::DBI::Util>
274
275=head1 AUTHOR
276
277Copyright (C) 2005 Richard Hundt <richard NO SPAM AT protea-systems.com>
278
279=head1 LICENSE
280
281This library is free software and may be used under the same terms as Perl itself.
282
283=cut
284