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/;
16 package DBIC::SQL::Abstract; # Would merge upstream, but nate doesn't reply :(
18 use base qw/SQL::Abstract::Limit/;
20 # This prevents the caching of $dbh in S::A::L, I believe
22 my $self = shift->SUPER::new(@_);
24 # If limit_dialect is a ref (like a $dbh), go ahead and replace
25 # it with what it resolves to:
26 $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
27 if ref $self->{limit_dialect};
32 # While we're at it, this should make LIMIT queries more efficient,
33 # without digging into things too deeply
35 my ($self, $syntax) = @_;
36 $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
40 my ($self, $table, $fields, $where, $order, @rest) = @_;
41 $table = $self->_quote($table) unless ref($table);
42 @rest = (-1) unless defined $rest[0];
43 die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
44 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
45 local $self->{having_bind} = [];
46 my ($sql, @ret) = $self->SUPER::select(
47 $table, $self->_recurse_fields($fields), $where, $order, @rest
49 return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
55 $table = $self->_quote($table) unless ref($table);
56 $self->SUPER::insert($table, @_);
62 $table = $self->_quote($table) unless ref($table);
63 $self->SUPER::update($table, @_);
69 $table = $self->_quote($table) unless ref($table);
70 $self->SUPER::delete($table, @_);
76 return $_[1].$self->_order_by($_[2]);
78 return $self->SUPER::_emulate_limit(@_);
83 my ($self, $fields) = @_;
84 my $ref = ref $fields;
85 return $self->_quote($fields) unless $ref;
86 return $$fields if $ref eq 'SCALAR';
88 if ($ref eq 'ARRAY') {
89 return join(', ', map { $self->_recurse_fields($_) } @$fields);
90 } elsif ($ref eq 'HASH') {
91 foreach my $func (keys %$fields) {
92 return $self->_sqlcase($func)
93 .'( '.$self->_recurse_fields($fields->{$func}).' )';
102 if (ref $_[0] eq 'HASH') {
103 if (defined $_[0]->{group_by}) {
104 $ret = $self->_sqlcase(' group by ')
105 .$self->_recurse_fields($_[0]->{group_by});
107 if (defined $_[0]->{having}) {
109 ($frag, @extra) = $self->_recurse_where($_[0]->{having});
110 push(@{$self->{having_bind}}, @extra);
111 $ret .= $self->_sqlcase(' having ').$frag;
113 if (defined $_[0]->{order_by}) {
114 $ret .= $self->SUPER::_order_by($_[0]->{order_by});
116 } elsif (ref $_[0] eq 'SCALAR') {
117 $ret = $self->_sqlcase(' order by ').${ $_[0] };
118 } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
119 my @order = @{+shift};
120 $ret = $self->_sqlcase(' order by ')
122 my $r = $self->_order_by($_, @_);
123 $r =~ s/^ ?ORDER BY //i;
127 $ret = $self->SUPER::_order_by(@_);
132 sub _order_directions {
133 my ($self, $order) = @_;
134 $order = $order->{order_by} if ref $order eq 'HASH';
135 return $self->SUPER::_order_directions($order);
139 my ($self, $from) = @_;
140 if (ref $from eq 'ARRAY') {
141 return $self->_recurse_from(@$from);
142 } elsif (ref $from eq 'HASH') {
143 return $self->_make_as($from);
145 return $from; # would love to quote here but _table ends up getting called
146 # twice during an ->select without a limit clause due to
147 # the way S::A::Limit->select works. should maybe consider
148 # bypassing this and doing S::A::select($self, ...) in
149 # our select method above. meantime, quoting shims have
150 # been added to select/insert/update/delete here
155 my ($self, $from, @join) = @_;
157 push(@sqlf, $self->_make_as($from));
158 foreach my $j (@join) {
161 # check whether a join type exists
162 my $join_clause = '';
163 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
164 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
165 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
167 $join_clause = ' JOIN ';
169 push(@sqlf, $join_clause);
171 if (ref $to eq 'ARRAY') {
172 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
174 push(@sqlf, $self->_make_as($to));
176 push(@sqlf, ' ON ', $self->_join_condition($on));
178 return join('', @sqlf);
182 my ($self, $from) = @_;
183 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ : $self->_quote($_)) }
184 reverse each %{$self->_skip_options($from)});
188 my ($self, $hash) = @_;
190 $clean_hash->{$_} = $hash->{$_}
191 for grep {!/^-/} keys %$hash;
195 sub _join_condition {
196 my ($self, $cond) = @_;
197 if (ref $cond eq 'HASH') {
200 my $x = '= '.$self->_quote($cond->{$_}); $j{$_} = \$x;
202 return $self->_recurse_where(\%j);
203 } elsif (ref $cond eq 'ARRAY') {
204 return join(' OR ', map { $self->_join_condition($_) } @$cond);
206 die "Can't handle this yet!";
211 my ($self, $label) = @_;
212 return '' unless defined $label;
213 return "*" if $label eq '*';
214 return $label unless $self->{quote_char};
215 if(ref $self->{quote_char} eq "ARRAY"){
216 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
217 if !defined $self->{name_sep};
218 my $sep = $self->{name_sep};
219 return join($self->{name_sep},
220 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
221 split(/\Q$sep\E/,$label));
223 return $self->SUPER::_quote($label);
229 $_[0] =~ s/SELECT (.*?) FROM/
230 'SELECT '.join(', ', map { $_.' AS col'.++$c } split(', ', $1)).' FROM'/e;
231 $self->SUPER::_RowNum(@_);
236 $self->{limit_dialect} = shift if @_;
237 return $self->{limit_dialect};
242 $self->{quote_char} = shift if @_;
243 return $self->{quote_char};
248 $self->{name_sep} = shift if @_;
249 return $self->{name_sep};
252 } # End of BEGIN block
254 use base qw/DBIx::Class/;
256 __PACKAGE__->load_components(qw/AccessorGroup/);
258 __PACKAGE__->mk_group_accessors('simple' =>
259 qw/_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid _conn_tid
260 debug debugobj cursor on_connect_do transaction_depth/);
264 DBIx::Class::Storage::DBI - DBI storage handler
270 This class represents the connection to the database
279 my $new = bless({}, ref $_[0] || $_[0]);
280 $new->cursor("DBIx::Class::Storage::DBI::Cursor");
281 $new->transaction_depth(0);
283 $new->debugobj(new DBIx::Class::Storage::Statistics());
287 my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
290 if (defined($debug_env) && ($debug_env =~ /=(.+)$/)) {
291 $fh = IO::File->new($1, 'w')
292 or $new->throw_exception("Cannot open trace file $1");
294 $fh = IO::File->new('>&STDERR');
297 $new->debug(1) if $debug_env;
298 $new->_sql_maker_opts({});
302 =head2 throw_exception
304 Throws an exception - croaks.
308 sub throw_exception {
309 my ($self, $msg) = @_;
315 The arguments of C<connect_info> are always a single array reference.
317 This is normally accessed via L<DBIx::Class::Schema/connection>, which
318 encapsulates its argument list in an arrayref before calling
319 C<connect_info> here.
321 The arrayref can either contain the same set of arguments one would
322 normally pass to L<DBI/connect>, or a lone code reference which returns
323 a connected database handle.
325 In either case, if the final argument in your connect_info happens
326 to be a hashref, C<connect_info> will look there for several
327 connection-specific options:
333 This can be set to an arrayref of literal sql statements, which will
334 be executed immediately after making the connection to the database
335 every time we [re-]connect.
339 Sets the limit dialect. This is useful for JDBC-bridge among others
340 where the remote SQL-dialect cannot be determined by the name of the
345 Specifies what characters to use to quote table and column names. If
346 you use this you will want to specify L<name_sep> as well.
348 quote_char expects either a single character, in which case is it is placed
349 on either side of the table/column, or an arrayref of length 2 in which case the
350 table/column name is placed between the elements.
352 For example under MySQL you'd use C<quote_char =E<gt> '`'>, and user SQL Server you'd
353 use C<quote_char =E<gt> [qw/[ ]/]>.
357 This only needs to be used in conjunction with L<quote_char>, and is used to
358 specify the charecter that seperates elements (schemas, tables, columns) from
359 each other. In most cases this is simply a C<.>.
363 These options can be mixed in with your other L<DBI> connection attributes,
364 or placed in a seperate hashref after all other normal L<DBI> connection
367 Every time C<connect_info> is invoked, any previous settings for
368 these options will be cleared before setting the new ones, regardless of
369 whether any options are specified in the new C<connect_info>.
373 # Simple SQLite connection
374 ->connect_info([ 'dbi:SQLite:./foo.db' ]);
377 ->connect_info([ sub { DBI->connect(...) } ]);
379 # A bit more complicated
386 { quote_char => q{"}, name_sep => q{.} },
390 # Equivalent to the previous example
396 { AutoCommit => 0, quote_char => q{"}, name_sep => q{.} },
400 # Subref + DBIC-specific connection options
403 sub { DBI->connect(...) },
407 on_connect_do => ['SET search_path TO myschema,otherschema,public'],
414 This method is deprecated in favor of setting via L</connect_info>.
418 Causes SQL trace information to be emitted on the C<debugobj> object.
419 (or C<STDERR> if C<debugobj> has not specifically been set).
423 Set or retrieve the filehandle used for trace/debug output. This should be
424 an IO::Handle compatible ojbect (only the C<print> method is used. Initially
425 set to be STDERR - although see information on the
426 L<DBIC_TRACE> environment variable.
433 if ($self->debugobj->can('debugfh')) {
434 return $self->debugobj->debugfh(@_);
440 Sets or retrieves the object used for metric collection. Defaults to an instance
441 of L<DBIx::Class::Storage::Statistics> that is campatible with the original
442 method of using a coderef as a callback. See the aforementioned Statistics
443 class for more information.
447 Sets a callback to be executed each time a statement is run; takes a sub
448 reference. Callback is executed as $sub->($op, $info) where $op is
449 SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
451 See L<debugobj> for a better way.
458 if ($self->debugobj->can('callback')) {
459 return $self->debugobj->callback(@_);
465 Disconnect the L<DBI> handle, performing a rollback first if the
466 database is not in C<AutoCommit> mode.
473 if( $self->connected ) {
474 $self->_dbh->rollback unless $self->_dbh->{AutoCommit};
475 $self->_dbh->disconnect;
482 Check if the L<DBI> handle is connected. Returns true if the handle
487 sub connected { my ($self) = @_;
489 if(my $dbh = $self->_dbh) {
490 if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
491 return $self->_dbh(undef);
493 elsif($self->_conn_pid != $$) {
494 $self->_dbh->{InactiveDestroy} = 1;
495 return $self->_dbh(undef);
497 return ($dbh->FETCH('Active') && $dbh->ping);
503 =head2 ensure_connected
505 Check whether the database handle is connected - if not then make a
510 sub ensure_connected {
513 unless ($self->connected) {
514 $self->_populate_dbh;
520 Returns the dbh - a data base handle of class L<DBI>.
527 $self->ensure_connected;
531 sub _sql_maker_args {
534 return ( limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
539 Returns a C<sql_maker> object - normally an object of class
540 C<DBIC::SQL::Abstract>.
546 unless ($self->_sql_maker) {
547 $self->_sql_maker(new DBIC::SQL::Abstract( $self->_sql_maker_args ));
549 return $self->_sql_maker;
553 my ($self, $info_arg) = @_;
556 # Kill sql_maker/_sql_maker_opts, so we get a fresh one with only
557 # the new set of options
558 $self->_sql_maker(undef);
559 $self->_sql_maker_opts({});
561 my $info = [ @$info_arg ]; # copy because we can alter it
562 my $last_info = $info->[-1];
563 if(ref $last_info eq 'HASH') {
564 if(my $on_connect_do = delete $last_info->{on_connect_do}) {
565 $self->on_connect_do($on_connect_do);
567 for my $sql_maker_opt (qw/limit_dialect quote_char name_sep/) {
568 if(my $opt_val = delete $last_info->{$sql_maker_opt}) {
569 $self->_sql_maker_opts->{$sql_maker_opt} = $opt_val;
573 # Get rid of any trailing empty hashref
574 pop(@$info) if !keys %$last_info;
577 $self->_connect_info($info);
580 $self->_connect_info;
585 my @info = @{$self->_connect_info || []};
586 $self->_dbh($self->_connect(@info));
588 if(ref $self eq 'DBIx::Class::Storage::DBI') {
589 my $driver = $self->_dbh->{Driver}->{Name};
590 if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) {
591 bless $self, "DBIx::Class::Storage::DBI::${driver}";
592 $self->_rebless() if $self->can('_rebless');
596 # if on-connect sql statements are given execute them
597 foreach my $sql_statement (@{$self->on_connect_do || []}) {
598 $self->debugobj->query_start($sql_statement) if $self->debug();
599 $self->_dbh->do($sql_statement);
600 $self->debugobj->query_end($sql_statement) if $self->debug();
603 $self->_conn_pid($$);
604 $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
608 my ($self, @info) = @_;
610 $self->throw_exception("You failed to provide any connection info")
613 my ($old_connect_via, $dbh);
615 if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
616 $old_connect_via = $DBI::connect_via;
617 $DBI::connect_via = 'connect';
621 $dbh = ref $info[0] eq 'CODE'
623 : DBI->connect(@info);
626 $DBI::connect_via = $old_connect_via if $old_connect_via;
629 $self->throw_exception("DBI Connection failed: " . ($@ || $DBI::errstr));
637 Calls begin_work on the current dbh.
639 See L<DBIx::Class::Schema> for the txn_do() method, which allows for
640 an entire code block to be executed transactionally.
646 if ($self->{transaction_depth}++ == 0) {
647 my $dbh = $self->dbh;
648 if ($dbh->{AutoCommit}) {
649 $self->debugobj->txn_begin()
658 Issues a commit against the current dbh.
664 my $dbh = $self->dbh;
665 if ($self->{transaction_depth} == 0) {
666 unless ($dbh->{AutoCommit}) {
667 $self->debugobj->txn_commit()
673 if (--$self->{transaction_depth} == 0) {
674 $self->debugobj->txn_commit()
683 Issues a rollback against the current dbh. A nested rollback will
684 throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception,
685 which allows the rollback to propagate to the outermost transaction.
693 my $dbh = $self->dbh;
694 if ($self->{transaction_depth} == 0) {
695 unless ($dbh->{AutoCommit}) {
696 $self->debugobj->txn_rollback()
702 if (--$self->{transaction_depth} == 0) {
703 $self->debugobj->txn_rollback()
708 die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new;
715 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
716 $error =~ /$exception_class/ and $self->throw_exception($error);
717 $self->{transaction_depth} = 0; # ensure that a failed rollback
718 $self->throw_exception($error); # resets the transaction depth
723 my ($self, $op, $extra_bind, $ident, @args) = @_;
724 my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
725 unshift(@bind, @$extra_bind) if $extra_bind;
727 my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
728 $self->debugobj->query_start($sql, @debug_bind);
730 my $sth = eval { $self->sth($sql,$op) };
733 $self->throw_exception(
734 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
737 @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
741 $rv = eval { $sth->execute(@bind) };
744 $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr));
747 $self->throw_exception("'$sql' did not generate a statement.");
750 my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
751 $self->debugobj->query_end($sql, @debug_bind);
753 return (wantarray ? ($rv, $sth, @bind) : $rv);
757 my ($self, $ident, $to_insert) = @_;
758 $self->throw_exception(
759 "Couldn't insert ".join(', ',
760 map "$_ => $to_insert->{$_}", keys %$to_insert
762 ) unless ($self->_execute('insert' => [], $ident, $to_insert));
767 return shift->_execute('update' => [], @_);
771 return shift->_execute('delete' => [], @_);
775 my ($self, $ident, $select, $condition, $attrs) = @_;
776 my $order = $attrs->{order_by};
777 if (ref $condition eq 'SCALAR') {
778 $order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
780 if (exists $attrs->{group_by} || $attrs->{having}) {
782 group_by => $attrs->{group_by},
783 having => $attrs->{having},
784 ($order ? (order_by => $order) : ())
787 my @args = ('select', $attrs->{bind}, $ident, $select, $condition, $order);
788 if ($attrs->{software_limit} ||
789 $self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
790 $attrs->{software_limit} = 1;
792 $self->throw_exception("rows attribute must be positive if present")
793 if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
794 push @args, $attrs->{rows}, $attrs->{offset};
796 return $self->_execute(@args);
801 Handle a SQL select statement.
807 my ($ident, $select, $condition, $attrs) = @_;
808 return $self->cursor->new($self, \@_, $attrs);
813 Performs a select, fetch and return of data - handles a single row
818 # Need to call finish() to work round broken DBDs
822 my ($rv, $sth, @bind) = $self->_select(@_);
823 my @row = $sth->fetchrow_array;
830 Returns a L<DBI> sth (statement handle) for the supplied SQL.
835 my ($self, $sql) = @_;
836 # 3 is the if_active parameter which avoids active sth re-use
837 return $self->dbh->prepare_cached($sql, {}, 3);
840 =head2 columns_info_for
842 Returns database type info for a given table columns.
846 sub columns_info_for {
847 my ($self, $table) = @_;
849 my $dbh = $self->dbh;
851 if ($dbh->can('column_info')) {
853 my $old_raise_err = $dbh->{RaiseError};
854 my $old_print_err = $dbh->{PrintError};
855 $dbh->{RaiseError} = 1;
856 $dbh->{PrintError} = 0;
858 my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
859 my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
861 while ( my $info = $sth->fetchrow_hashref() ){
863 $column_info{data_type} = $info->{TYPE_NAME};
864 $column_info{size} = $info->{COLUMN_SIZE};
865 $column_info{is_nullable} = $info->{NULLABLE} ? 1 : 0;
866 $column_info{default_value} = $info->{COLUMN_DEF};
867 my $col_name = $info->{COLUMN_NAME};
868 $col_name =~ s/^\"(.*)\"$/$1/;
870 $result{$col_name} = \%column_info;
873 $dbh->{RaiseError} = $old_raise_err;
874 $dbh->{PrintError} = $old_print_err;
875 return \%result if !$@;
879 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0");
881 my @columns = @{$sth->{NAME_lc}};
882 for my $i ( 0 .. $#columns ){
884 my $type_num = $sth->{TYPE}->[$i];
886 if(defined $type_num && $dbh->can('type_info')) {
887 my $type_info = $dbh->type_info($type_num);
888 $type_name = $type_info->{TYPE_NAME} if $type_info;
890 $column_info{data_type} = $type_name ? $type_name : $type_num;
891 $column_info{size} = $sth->{PRECISION}->[$i];
892 $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
894 if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) {
895 $column_info{data_type} = $1;
896 $column_info{size} = $2;
899 $result{$columns[$i]} = \%column_info;
905 =head2 last_insert_id
907 Return the row id of the last insert.
912 my ($self, $row) = @_;
914 return $self->dbh->func('last_insert_rowid');
920 Returns the database driver name.
924 sub sqlt_type { shift->dbh->{Driver}->{Name} }
926 =head2 create_ddl_dir (EXPERIMENTAL)
930 =item Arguments: $schema \@databases, $version, $directory, $sqlt_args
934 Creates an SQL file based on the Schema, for each of the specified
935 database types, in the given directory.
937 Note that this feature is currently EXPERIMENTAL and may not work correctly
938 across all databases, or fully handle complex relationships.
944 my ($self, $schema, $databases, $version, $dir, $sqltargs) = @_;
946 if(!$dir || !-d $dir)
948 warn "No directory given, using ./\n";
951 $databases ||= ['MySQL', 'SQLite', 'PostgreSQL'];
952 $databases = [ $databases ] if(ref($databases) ne 'ARRAY');
953 $version ||= $schema->VERSION || '1.x';
955 eval "use SQL::Translator";
956 $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
958 my $sqlt = SQL::Translator->new({
962 foreach my $db (@$databases)
965 $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
966 # $sqlt->parser_args({'DBIx::Class' => $schema);
967 $sqlt->data($schema);
968 $sqlt->producer($db);
971 my $filename = $schema->ddl_filename($db, $dir, $version);
974 $self->throw_exception("$filename already exists, skipping $db");
977 open($file, ">$filename")
978 or $self->throw_exception("Can't open $filename for writing ($!)");
979 my $output = $sqlt->translate;
981 # print join(":", keys %{$schema->source_registrations});
982 # print Dumper($sqlt->schema);
985 $self->throw_exception("Failed to translate to $db. (" . $sqlt->error . ")");
994 =head2 deployment_statements
996 Create the statements for L</deploy> and
997 L<DBIx::Class::Schema/deploy>.
1001 sub deployment_statements {
1002 my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
1003 # Need to be connected to get the correct sqlt_type
1004 $self->ensure_connected() unless $type;
1005 $type ||= $self->sqlt_type;
1006 $version ||= $schema->VERSION || '1.x';
1008 eval "use SQL::Translator";
1011 eval "use SQL::Translator::Parser::DBIx::Class;";
1012 $self->throw_exception($@) if $@;
1013 eval "use SQL::Translator::Producer::${type};";
1014 $self->throw_exception($@) if $@;
1015 my $tr = SQL::Translator->new(%$sqltargs);
1016 SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
1017 return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
1020 my $filename = $schema->ddl_filename($type, $dir, $version);
1023 # $schema->create_ddl_dir([ $type ], $version, $dir, $sqltargs);
1024 $self->throw_exception("No SQL::Translator, and no Schema file found, aborting deploy");
1028 open($file, "<$filename")
1029 or $self->throw_exception("Can't open $filename ($!)");
1033 return join('', @rows);
1039 Sends the appropriate statements to create or modify tables to the
1040 db. This would normally be called through
1041 L<DBIx::Class::Schema/deploy>.
1046 my ($self, $schema, $type, $sqltargs) = @_;
1047 foreach my $statement ( $self->deployment_statements($schema, $type, undef, undef, { no_comments => 1, %$sqltargs }) ) {
1048 for ( split(";\n", $statement)) {
1049 next if($_ =~ /^--/);
1051 # next if($_ =~ /^DROP/m);
1052 next if($_ =~ /^BEGIN TRANSACTION/m);
1053 next if($_ =~ /^COMMIT/m);
1054 $self->debugobj->query_start($_) if $self->debug;
1055 $self->dbh->do($_) or warn "SQL was:\n $_";
1056 $self->debugobj->query_end($_) if $self->debug;
1061 =head2 datetime_parser
1063 Returns the datetime parser class
1067 sub datetime_parser {
1069 return $self->{datetime_parser} ||= $self->build_datetime_parser(@_);
1072 =head2 datetime_parser_type
1074 Defines (returns) the datetime parser class - currently hardwired to
1075 L<DateTime::Format::MySQL>
1079 sub datetime_parser_type { "DateTime::Format::MySQL"; }
1081 =head2 build_datetime_parser
1083 See L</datetime_parser>
1087 sub build_datetime_parser {
1089 my $type = $self->datetime_parser_type(@_);
1091 $self->throw_exception("Couldn't load ${type}: $@") if $@;
1095 sub DESTROY { shift->disconnect }
1101 The module defines a set of methods within the DBIC::SQL::Abstract
1102 namespace. These build on L<SQL::Abstract::Limit> to provide the
1103 SQL query functions.
1105 The following methods are extended:-
1119 See L</connect_info> for details.
1120 For setting, this method is deprecated in favor of L</connect_info>.
1124 See L</connect_info> for details.
1125 For setting, this method is deprecated in favor of L</connect_info>.
1129 See L</connect_info> for details.
1130 For setting, this method is deprecated in favor of L</connect_info>.
1134 =head1 ENVIRONMENT VARIABLES
1138 If C<DBIC_TRACE> is set then SQL trace information
1139 is produced (as when the L<debug> method is set).
1141 If the value is of the form C<1=/path/name> then the trace output is
1142 written to the file C</path/name>.
1144 This environment variable is checked when the storage object is first
1145 created (when you call connect on your schema). So, run-time changes
1146 to this environment variable will not take effect unless you also
1147 re-connect on your schema.
1149 =head2 DBIX_CLASS_STORAGE_DBI_DEBUG
1151 Old name for DBIC_TRACE
1155 Matt S. Trout <mst@shadowcatsystems.co.uk>
1157 Andy Grundman <andy@hybridized.org>
1161 You may distribute this code under the same terms as Perl itself.