1 package DBIx::Class::Storage::DBI;
2 # -*- mode: cperl; cperl-indent-level: 2 -*-
4 use base 'DBIx::Class::Storage';
9 use SQL::Abstract::Limit;
10 use DBIx::Class::Storage::DBI::Cursor;
11 use DBIx::Class::Storage::Statistics;
13 use Carp::Clan qw/DBIx::Class/;
15 __PACKAGE__->mk_group_accessors(
17 qw/_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid _conn_tid
18 cursor on_connect_do transaction_depth/
23 package DBIC::SQL::Abstract; # Would merge upstream, but nate doesn't reply :(
25 use base qw/SQL::Abstract::Limit/;
27 # This prevents the caching of $dbh in S::A::L, I believe
29 my $self = shift->SUPER::new(@_);
31 # If limit_dialect is a ref (like a $dbh), go ahead and replace
32 # it with what it resolves to:
33 $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
34 if ref $self->{limit_dialect};
39 # While we're at it, this should make LIMIT queries more efficient,
40 # without digging into things too deeply
42 my ($self, $syntax) = @_;
43 $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
47 my ($self, $table, $fields, $where, $order, @rest) = @_;
48 $table = $self->_quote($table) unless ref($table);
49 local $self->{rownum_hack_count} = 1
50 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
51 @rest = (-1) unless defined $rest[0];
52 die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
53 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
54 local $self->{having_bind} = [];
55 my ($sql, @ret) = $self->SUPER::select(
56 $table, $self->_recurse_fields($fields), $where, $order, @rest
58 return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
64 $table = $self->_quote($table) unless ref($table);
65 $self->SUPER::insert($table, @_);
71 $table = $self->_quote($table) unless ref($table);
72 $self->SUPER::update($table, @_);
78 $table = $self->_quote($table) unless ref($table);
79 $self->SUPER::delete($table, @_);
85 return $_[1].$self->_order_by($_[2]);
87 return $self->SUPER::_emulate_limit(@_);
92 my ($self, $fields) = @_;
93 my $ref = ref $fields;
94 return $self->_quote($fields) unless $ref;
95 return $$fields if $ref eq 'SCALAR';
97 if ($ref eq 'ARRAY') {
98 return join(', ', map {
99 $self->_recurse_fields($_)
100 .(exists $self->{rownum_hack_count}
101 ? ' AS col'.$self->{rownum_hack_count}++
104 } elsif ($ref eq 'HASH') {
105 foreach my $func (keys %$fields) {
106 return $self->_sqlcase($func)
107 .'( '.$self->_recurse_fields($fields->{$func}).' )';
116 if (ref $_[0] eq 'HASH') {
117 if (defined $_[0]->{group_by}) {
118 $ret = $self->_sqlcase(' group by ')
119 .$self->_recurse_fields($_[0]->{group_by});
121 if (defined $_[0]->{having}) {
123 ($frag, @extra) = $self->_recurse_where($_[0]->{having});
124 push(@{$self->{having_bind}}, @extra);
125 $ret .= $self->_sqlcase(' having ').$frag;
127 if (defined $_[0]->{order_by}) {
128 $ret .= $self->_order_by($_[0]->{order_by});
130 } elsif (ref $_[0] eq 'SCALAR') {
131 $ret = $self->_sqlcase(' order by ').${ $_[0] };
132 } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
133 my @order = @{+shift};
134 $ret = $self->_sqlcase(' order by ')
136 my $r = $self->_order_by($_, @_);
137 $r =~ s/^ ?ORDER BY //i;
141 $ret = $self->SUPER::_order_by(@_);
146 sub _order_directions {
147 my ($self, $order) = @_;
148 $order = $order->{order_by} if ref $order eq 'HASH';
149 return $self->SUPER::_order_directions($order);
153 my ($self, $from) = @_;
154 if (ref $from eq 'ARRAY') {
155 return $self->_recurse_from(@$from);
156 } elsif (ref $from eq 'HASH') {
157 return $self->_make_as($from);
159 return $from; # would love to quote here but _table ends up getting called
160 # twice during an ->select without a limit clause due to
161 # the way S::A::Limit->select works. should maybe consider
162 # bypassing this and doing S::A::select($self, ...) in
163 # our select method above. meantime, quoting shims have
164 # been added to select/insert/update/delete here
169 my ($self, $from, @join) = @_;
171 push(@sqlf, $self->_make_as($from));
172 foreach my $j (@join) {
175 # check whether a join type exists
176 my $join_clause = '';
177 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
178 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
179 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
181 $join_clause = ' JOIN ';
183 push(@sqlf, $join_clause);
185 if (ref $to eq 'ARRAY') {
186 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
188 push(@sqlf, $self->_make_as($to));
190 push(@sqlf, ' ON ', $self->_join_condition($on));
192 return join('', @sqlf);
196 my ($self, $from) = @_;
197 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ : $self->_quote($_)) }
198 reverse each %{$self->_skip_options($from)});
202 my ($self, $hash) = @_;
204 $clean_hash->{$_} = $hash->{$_}
205 for grep {!/^-/} keys %$hash;
209 sub _join_condition {
210 my ($self, $cond) = @_;
211 if (ref $cond eq 'HASH') {
214 my $x = '= '.$self->_quote($cond->{$_}); $j{$_} = \$x;
216 return $self->_recurse_where(\%j);
217 } elsif (ref $cond eq 'ARRAY') {
218 return join(' OR ', map { $self->_join_condition($_) } @$cond);
220 die "Can't handle this yet!";
225 my ($self, $label) = @_;
226 return '' unless defined $label;
227 return "*" if $label eq '*';
228 return $label unless $self->{quote_char};
229 if(ref $self->{quote_char} eq "ARRAY"){
230 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
231 if !defined $self->{name_sep};
232 my $sep = $self->{name_sep};
233 return join($self->{name_sep},
234 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
235 split(/\Q$sep\E/,$label));
237 return $self->SUPER::_quote($label);
242 $self->{limit_dialect} = shift if @_;
243 return $self->{limit_dialect};
248 $self->{quote_char} = shift if @_;
249 return $self->{quote_char};
254 $self->{name_sep} = shift if @_;
255 return $self->{name_sep};
258 } # End of BEGIN block
262 DBIx::Class::Storage::DBI - DBI storage handler
268 This class represents the connection to an RDBMS via L<DBI>. See
269 L<DBIx::Class::Storage> for general information. This pod only
270 documents DBI-specific methods and behaviors.
277 my $new = shift->next::method(@_);
279 $new->cursor("DBIx::Class::Storage::DBI::Cursor");
280 $new->transaction_depth(0);
281 $new->_sql_maker_opts({});
288 The arguments of C<connect_info> are always a single array reference.
290 This is normally accessed via L<DBIx::Class::Schema/connection>, which
291 encapsulates its argument list in an arrayref before calling
292 C<connect_info> here.
294 The arrayref can either contain the same set of arguments one would
295 normally pass to L<DBI/connect>, or a lone code reference which returns
296 a connected database handle.
298 In either case, if the final argument in your connect_info happens
299 to be a hashref, C<connect_info> will look there for several
300 connection-specific options:
306 This can be set to an arrayref of literal sql statements, which will
307 be executed immediately after making the connection to the database
308 every time we [re-]connect.
312 Sets the limit dialect. This is useful for JDBC-bridge among others
313 where the remote SQL-dialect cannot be determined by the name of the
318 Specifies what characters to use to quote table and column names. If
319 you use this you will want to specify L<name_sep> as well.
321 quote_char expects either a single character, in which case is it is placed
322 on either side of the table/column, or an arrayref of length 2 in which case the
323 table/column name is placed between the elements.
325 For example under MySQL you'd use C<quote_char =E<gt> '`'>, and user SQL Server you'd
326 use C<quote_char =E<gt> [qw/[ ]/]>.
330 This only needs to be used in conjunction with L<quote_char>, and is used to
331 specify the charecter that seperates elements (schemas, tables, columns) from
332 each other. In most cases this is simply a C<.>.
336 These options can be mixed in with your other L<DBI> connection attributes,
337 or placed in a seperate hashref after all other normal L<DBI> connection
340 Every time C<connect_info> is invoked, any previous settings for
341 these options will be cleared before setting the new ones, regardless of
342 whether any options are specified in the new C<connect_info>.
344 Important note: DBIC expects the returned database handle provided by
345 a subref argument to have RaiseError set on it. If it doesn't, things
346 might not work very well, YMMV. If you don't use a subref, DBIC will
347 force this setting for you anyways. Setting HandleError to anything
348 other than simple exception object wrapper might cause problems too.
352 # Simple SQLite connection
353 ->connect_info([ 'dbi:SQLite:./foo.db' ]);
356 ->connect_info([ sub { DBI->connect(...) } ]);
358 # A bit more complicated
365 { quote_char => q{"}, name_sep => q{.} },
369 # Equivalent to the previous example
375 { AutoCommit => 0, quote_char => q{"}, name_sep => q{.} },
379 # Subref + DBIC-specific connection options
382 sub { DBI->connect(...) },
386 on_connect_do => ['SET search_path TO myschema,otherschema,public'],
394 my ($self, $info_arg) = @_;
396 return $self->_connect_info if !$info_arg;
398 # Kill sql_maker/_sql_maker_opts, so we get a fresh one with only
399 # the new set of options
400 $self->_sql_maker(undef);
401 $self->_sql_maker_opts({});
403 my $info = [ @$info_arg ]; # copy because we can alter it
404 my $last_info = $info->[-1];
405 if(ref $last_info eq 'HASH') {
406 if(my $on_connect_do = delete $last_info->{on_connect_do}) {
407 $self->on_connect_do($on_connect_do);
409 for my $sql_maker_opt (qw/limit_dialect quote_char name_sep/) {
410 if(my $opt_val = delete $last_info->{$sql_maker_opt}) {
411 $self->_sql_maker_opts->{$sql_maker_opt} = $opt_val;
415 # Get rid of any trailing empty hashref
416 pop(@$info) if !keys %$last_info;
419 $self->_connect_info($info);
424 This method is deprecated in favor of setting via L</connect_info>.
428 Arguments: $subref, @extra_coderef_args?
430 Execute the given subref with the underlying database handle as its
431 first argument, using the new exception-based connection management.
433 Any additional arguments will be passed verbatim to the called subref
434 as arguments 2 and onwards.
438 my @stuff = $schema->storage->dbh_do(
441 my $cols = join(q{, }, @_);
442 shift->selectrow_array("SELECT $cols FROM foo")
453 return $coderef->($self->_dbh, @_) if $self->{_in_txn_do};
455 ref $coderef eq 'CODE' or $self->throw_exception
456 ('$coderef must be a CODE reference');
459 my $want_array = wantarray;
462 $self->_verify_pid if $self->_dbh;
463 $self->_populate_dbh if !$self->_dbh;
465 @result = $coderef->($self->_dbh, @_);
467 elsif(defined $want_array) {
468 $result[0] = $coderef->($self->_dbh, @_);
471 $coderef->($self->_dbh, @_);
476 if(!$exception) { return $want_array ? @result : $result[0] }
478 $self->throw_exception($exception) if $self->connected;
480 # We were not connected - reconnect and retry, but let any
481 # exception fall right through this time
482 $self->_populate_dbh;
483 $coderef->($self->_dbh, @_);
486 # This is basically a blend of dbh_do above and DBIx::Class::Storage::txn_do.
487 # It also informs dbh_do to bypass itself while under the direction of txn_do,
488 # via $self->{_in_txn_do} (this saves some redundant eval and errorcheck, etc)
493 ref $coderef eq 'CODE' or $self->throw_exception
494 ('$coderef must be a CODE reference');
496 local $self->{_in_txn_do} = 1;
501 my $want_array = wantarray;
504 $self->_verify_pid if $self->_dbh;
505 $self->_populate_dbh if !$self->_dbh;
509 @result = $coderef->(@_);
511 elsif(defined $want_array) {
512 $result[0] = $coderef->(@_);
521 if(!$exception) { return $want_array ? @result : $result[0] }
523 if($tried++ > 0 || $self->connected) {
524 eval { $self->txn_rollback };
525 my $rollback_exception = $@;
526 if($rollback_exception) {
527 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
528 $self->throw_exception($exception) # propagate nested rollback
529 if $rollback_exception =~ /$exception_class/;
531 $self->throw_exception(
532 "Transaction aborted: ${exception}. "
533 . "Rollback failed: ${rollback_exception}"
536 $self->throw_exception($exception)
539 # We were not connected, and was first try - reconnect and retry
540 # XXX I know, gotos are evil. If you can find a better way
541 # to write this that doesn't duplicate a lot of code/structure,
542 # and behaves identically, feel free...
544 $self->_populate_dbh;
550 Our C<disconnect> method also performs a rollback first if the
551 database is not in C<AutoCommit> mode.
558 if( $self->connected ) {
559 $self->_dbh->rollback unless $self->_dbh->{AutoCommit};
560 $self->_dbh->disconnect;
568 if(my $dbh = $self->_dbh) {
569 if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
570 return $self->_dbh(undef);
575 return ($dbh->FETCH('Active') && $dbh->ping);
581 # handle pid changes correctly
582 # NOTE: assumes $self->_dbh is a valid $dbh
586 return if $self->_conn_pid == $$;
588 $self->_dbh->{InactiveDestroy} = 1;
594 sub ensure_connected {
597 unless ($self->connected) {
598 $self->_populate_dbh;
604 Returns the dbh - a data base handle of class L<DBI>.
611 $self->ensure_connected;
615 sub _sql_maker_args {
618 return ( limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
623 unless ($self->_sql_maker) {
624 $self->_sql_maker(new DBIC::SQL::Abstract( $self->_sql_maker_args ));
626 return $self->_sql_maker;
631 my @info = @{$self->_connect_info || []};
632 $self->_dbh($self->_connect(@info));
634 if(ref $self eq 'DBIx::Class::Storage::DBI') {
635 my $driver = $self->_dbh->{Driver}->{Name};
636 if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) {
637 bless $self, "DBIx::Class::Storage::DBI::${driver}";
638 $self->_rebless() if $self->can('_rebless');
642 # if on-connect sql statements are given execute them
643 foreach my $sql_statement (@{$self->on_connect_do || []}) {
644 $self->debugobj->query_start($sql_statement) if $self->debug();
645 $self->_dbh->do($sql_statement);
646 $self->debugobj->query_end($sql_statement) if $self->debug();
649 $self->_conn_pid($$);
650 $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
654 my ($self, @info) = @_;
656 $self->throw_exception("You failed to provide any connection info")
659 my ($old_connect_via, $dbh);
661 if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
662 $old_connect_via = $DBI::connect_via;
663 $DBI::connect_via = 'connect';
667 if(ref $info[0] eq 'CODE') {
671 $dbh = DBI->connect(@info);
672 $dbh->{RaiseError} = 1;
673 $dbh->{PrintError} = 0;
677 $DBI::connect_via = $old_connect_via if $old_connect_via;
680 $self->throw_exception("DBI Connection failed: " . ($@ || $DBI::errstr));
687 my ($dbh, $self) = @_;
688 if ($dbh->{AutoCommit}) {
689 $self->debugobj->txn_begin()
697 $self->dbh_do(\&__txn_begin, $self)
698 if $self->{transaction_depth}++ == 0;
702 my ($dbh, $self) = @_;
703 if ($self->{transaction_depth} == 0) {
704 unless ($dbh->{AutoCommit}) {
705 $self->debugobj->txn_commit()
711 if (--$self->{transaction_depth} == 0) {
712 $self->debugobj->txn_commit()
721 $self->dbh_do(\&__txn_commit, $self);
725 my ($dbh, $self) = @_;
726 if ($self->{transaction_depth} == 0) {
727 unless ($dbh->{AutoCommit}) {
728 $self->debugobj->txn_rollback()
734 if (--$self->{transaction_depth} == 0) {
735 $self->debugobj->txn_rollback()
740 die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new;
747 eval { $self->dbh_do(\&__txn_rollback, $self) };
750 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
751 $error =~ /$exception_class/ and $self->throw_exception($error);
752 $self->{transaction_depth} = 0; # ensure that a failed rollback
753 $self->throw_exception($error); # resets the transaction depth
758 my ($self, $op, $extra_bind, $ident, @args) = @_;
759 my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
760 unshift(@bind, @$extra_bind) if $extra_bind;
762 my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
763 $self->debugobj->query_start($sql, @debug_bind);
765 my $sth = eval { $self->sth($sql,$op) };
768 $self->throw_exception(
769 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
772 @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
776 $rv = eval { $sth->execute(@bind) };
779 $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr));
782 $self->throw_exception("'$sql' did not generate a statement.");
785 my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
786 $self->debugobj->query_end($sql, @debug_bind);
788 return (wantarray ? ($rv, $sth, @bind) : $rv);
792 my ($self, $ident, $to_insert) = @_;
793 $self->throw_exception(
794 "Couldn't insert ".join(', ',
795 map "$_ => $to_insert->{$_}", keys %$to_insert
797 ) unless ($self->_execute('insert' => [], $ident, $to_insert));
802 return shift->_execute('update' => [], @_);
806 return shift->_execute('delete' => [], @_);
810 my ($self, $ident, $select, $condition, $attrs) = @_;
811 my $order = $attrs->{order_by};
812 if (ref $condition eq 'SCALAR') {
813 $order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
815 if (exists $attrs->{group_by} || $attrs->{having}) {
817 group_by => $attrs->{group_by},
818 having => $attrs->{having},
819 ($order ? (order_by => $order) : ())
822 my @args = ('select', $attrs->{bind}, $ident, $select, $condition, $order);
823 if ($attrs->{software_limit} ||
824 $self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
825 $attrs->{software_limit} = 1;
827 $self->throw_exception("rows attribute must be positive if present")
828 if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
829 push @args, $attrs->{rows}, $attrs->{offset};
831 return $self->_execute(@args);
836 my ($ident, $select, $condition, $attrs) = @_;
837 return $self->cursor->new($self, \@_, $attrs);
842 my ($rv, $sth, @bind) = $self->_select(@_);
843 my @row = $sth->fetchrow_array;
844 # Need to call finish() to work round broken DBDs
851 Returns a L<DBI> sth (statement handle) for the supplied SQL.
856 my ($dbh, $sql) = @_;
857 # 3 is the if_active parameter which avoids active sth re-use
858 $dbh->prepare_cached($sql, {}, 3);
862 my ($self, $sql) = @_;
863 $self->dbh_do(\&__sth, $sql);
867 sub __columns_info_for {
868 my ($dbh, $self, $table) = @_;
870 if ($dbh->can('column_info')) {
873 my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
874 my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
876 while ( my $info = $sth->fetchrow_hashref() ){
878 $column_info{data_type} = $info->{TYPE_NAME};
879 $column_info{size} = $info->{COLUMN_SIZE};
880 $column_info{is_nullable} = $info->{NULLABLE} ? 1 : 0;
881 $column_info{default_value} = $info->{COLUMN_DEF};
882 my $col_name = $info->{COLUMN_NAME};
883 $col_name =~ s/^\"(.*)\"$/$1/;
885 $result{$col_name} = \%column_info;
888 return \%result if !$@;
892 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0");
894 my @columns = @{$sth->{NAME_lc}};
895 for my $i ( 0 .. $#columns ){
897 my $type_num = $sth->{TYPE}->[$i];
899 if(defined $type_num && $dbh->can('type_info')) {
900 my $type_info = $dbh->type_info($type_num);
901 $type_name = $type_info->{TYPE_NAME} if $type_info;
903 $column_info{data_type} = $type_name ? $type_name : $type_num;
904 $column_info{size} = $sth->{PRECISION}->[$i];
905 $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
907 if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) {
908 $column_info{data_type} = $1;
909 $column_info{size} = $2;
912 $result{$columns[$i]} = \%column_info;
918 sub columns_info_for {
919 my ($self, $table) = @_;
920 $self->dbh_do(\&__columns_info_for, $self, $table);
923 =head2 last_insert_id
925 Return the row id of the last insert.
930 my ($self, $row) = @_;
932 $self->dbh_do(sub { shift->func('last_insert_rowid') });
937 Returns the database driver name.
941 sub sqlt_type { shift->dbh_do(sub { shift->{Driver}->{Name} }) }
943 =head2 create_ddl_dir (EXPERIMENTAL)
947 =item Arguments: $schema \@databases, $version, $directory, $sqlt_args
951 Creates an SQL file based on the Schema, for each of the specified
952 database types, in the given directory.
954 Note that this feature is currently EXPERIMENTAL and may not work correctly
955 across all databases, or fully handle complex relationships.
961 my ($self, $schema, $databases, $version, $dir, $sqltargs) = @_;
963 if(!$dir || !-d $dir)
965 warn "No directory given, using ./\n";
968 $databases ||= ['MySQL', 'SQLite', 'PostgreSQL'];
969 $databases = [ $databases ] if(ref($databases) ne 'ARRAY');
970 $version ||= $schema->VERSION || '1.x';
971 $sqltargs = { ( add_drop_table => 1 ), %{$sqltargs || {}} };
973 eval "use SQL::Translator";
974 $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
976 my $sqlt = SQL::Translator->new($sqltargs);
977 foreach my $db (@$databases)
980 $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
981 # $sqlt->parser_args({'DBIx::Class' => $schema);
982 $sqlt->data($schema);
983 $sqlt->producer($db);
986 my $filename = $schema->ddl_filename($db, $dir, $version);
989 $self->throw_exception("$filename already exists, skipping $db");
992 open($file, ">$filename")
993 or $self->throw_exception("Can't open $filename for writing ($!)");
994 my $output = $sqlt->translate;
996 # print join(":", keys %{$schema->source_registrations});
997 # print Dumper($sqlt->schema);
1000 $self->throw_exception("Failed to translate to $db. (" . $sqlt->error . ")");
1003 print $file $output;
1009 =head2 deployment_statements
1011 Create the statements for L</deploy> and
1012 L<DBIx::Class::Schema/deploy>.
1016 sub deployment_statements {
1017 my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
1018 # Need to be connected to get the correct sqlt_type
1019 $self->ensure_connected() unless $type;
1020 $type ||= $self->sqlt_type;
1021 $version ||= $schema->VERSION || '1.x';
1023 eval "use SQL::Translator";
1026 eval "use SQL::Translator::Parser::DBIx::Class;";
1027 $self->throw_exception($@) if $@;
1028 eval "use SQL::Translator::Producer::${type};";
1029 $self->throw_exception($@) if $@;
1030 my $tr = SQL::Translator->new(%$sqltargs);
1031 SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
1032 return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
1035 my $filename = $schema->ddl_filename($type, $dir, $version);
1038 # $schema->create_ddl_dir([ $type ], $version, $dir, $sqltargs);
1039 $self->throw_exception("No SQL::Translator, and no Schema file found, aborting deploy");
1043 open($file, "<$filename")
1044 or $self->throw_exception("Can't open $filename ($!)");
1048 return join('', @rows);
1053 my ($self, $schema, $type, $sqltargs) = @_;
1054 foreach my $statement ( $self->deployment_statements($schema, $type, undef, undef, { no_comments => 1, %{ $sqltargs || {} } } ) ) {
1055 for ( split(";\n", $statement)) {
1056 next if($_ =~ /^--/);
1058 # next if($_ =~ /^DROP/m);
1059 next if($_ =~ /^BEGIN TRANSACTION/m);
1060 next if($_ =~ /^COMMIT/m);
1061 next if $_ =~ /^\s+$/; # skip whitespace only
1062 $self->debugobj->query_start($_) if $self->debug;
1063 $self->dbh->do($_) or warn "SQL was:\n $_"; # XXX exceptions?
1064 $self->debugobj->query_end($_) if $self->debug;
1069 =head2 datetime_parser
1071 Returns the datetime parser class
1075 sub datetime_parser {
1077 return $self->{datetime_parser} ||= $self->build_datetime_parser(@_);
1080 =head2 datetime_parser_type
1082 Defines (returns) the datetime parser class - currently hardwired to
1083 L<DateTime::Format::MySQL>
1087 sub datetime_parser_type { "DateTime::Format::MySQL"; }
1089 =head2 build_datetime_parser
1091 See L</datetime_parser>
1095 sub build_datetime_parser {
1097 my $type = $self->datetime_parser_type(@_);
1099 $self->throw_exception("Couldn't load ${type}: $@") if $@;
1105 return if !$self->_dbh;
1115 The module defines a set of methods within the DBIC::SQL::Abstract
1116 namespace. These build on L<SQL::Abstract::Limit> to provide the
1117 SQL query functions.
1119 The following methods are extended:-
1133 See L</connect_info> for details.
1134 For setting, this method is deprecated in favor of L</connect_info>.
1138 See L</connect_info> for details.
1139 For setting, this method is deprecated in favor of L</connect_info>.
1143 See L</connect_info> for details.
1144 For setting, this method is deprecated in favor of L</connect_info>.
1150 Matt S. Trout <mst@shadowcatsystems.co.uk>
1152 Andy Grundman <andy@hybridized.org>
1156 You may distribute this code under the same terms as Perl itself.