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 local $self->{rownum_hack_count} = 1
43 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
44 @rest = (-1) unless defined $rest[0];
45 die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
46 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
47 local $self->{having_bind} = [];
48 my ($sql, @ret) = $self->SUPER::select(
49 $table, $self->_recurse_fields($fields), $where, $order, @rest
51 return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
57 $table = $self->_quote($table) unless ref($table);
58 $self->SUPER::insert($table, @_);
64 $table = $self->_quote($table) unless ref($table);
65 $self->SUPER::update($table, @_);
71 $table = $self->_quote($table) unless ref($table);
72 $self->SUPER::delete($table, @_);
78 return $_[1].$self->_order_by($_[2]);
80 return $self->SUPER::_emulate_limit(@_);
85 my ($self, $fields) = @_;
86 my $ref = ref $fields;
87 return $self->_quote($fields) unless $ref;
88 return $$fields if $ref eq 'SCALAR';
90 if ($ref eq 'ARRAY') {
91 return join(', ', map {
92 $self->_recurse_fields($_)
93 .(exists $self->{rownum_hack_count}
94 ? ' AS col'.$self->{rownum_hack_count}++
97 } elsif ($ref eq 'HASH') {
98 foreach my $func (keys %$fields) {
99 return $self->_sqlcase($func)
100 .'( '.$self->_recurse_fields($fields->{$func}).' )';
109 if (ref $_[0] eq 'HASH') {
110 if (defined $_[0]->{group_by}) {
111 $ret = $self->_sqlcase(' group by ')
112 .$self->_recurse_fields($_[0]->{group_by});
114 if (defined $_[0]->{having}) {
116 ($frag, @extra) = $self->_recurse_where($_[0]->{having});
117 push(@{$self->{having_bind}}, @extra);
118 $ret .= $self->_sqlcase(' having ').$frag;
120 if (defined $_[0]->{order_by}) {
121 $ret .= $self->_order_by($_[0]->{order_by});
123 } elsif (ref $_[0] eq 'SCALAR') {
124 $ret = $self->_sqlcase(' order by ').${ $_[0] };
125 } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
126 my @order = @{+shift};
127 $ret = $self->_sqlcase(' order by ')
129 my $r = $self->_order_by($_, @_);
130 $r =~ s/^ ?ORDER BY //i;
134 $ret = $self->SUPER::_order_by(@_);
139 sub _order_directions {
140 my ($self, $order) = @_;
141 $order = $order->{order_by} if ref $order eq 'HASH';
142 return $self->SUPER::_order_directions($order);
146 my ($self, $from) = @_;
147 if (ref $from eq 'ARRAY') {
148 return $self->_recurse_from(@$from);
149 } elsif (ref $from eq 'HASH') {
150 return $self->_make_as($from);
152 return $from; # would love to quote here but _table ends up getting called
153 # twice during an ->select without a limit clause due to
154 # the way S::A::Limit->select works. should maybe consider
155 # bypassing this and doing S::A::select($self, ...) in
156 # our select method above. meantime, quoting shims have
157 # been added to select/insert/update/delete here
162 my ($self, $from, @join) = @_;
164 push(@sqlf, $self->_make_as($from));
165 foreach my $j (@join) {
168 # check whether a join type exists
169 my $join_clause = '';
170 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
171 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
172 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
174 $join_clause = ' JOIN ';
176 push(@sqlf, $join_clause);
178 if (ref $to eq 'ARRAY') {
179 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
181 push(@sqlf, $self->_make_as($to));
183 push(@sqlf, ' ON ', $self->_join_condition($on));
185 return join('', @sqlf);
189 my ($self, $from) = @_;
190 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ : $self->_quote($_)) }
191 reverse each %{$self->_skip_options($from)});
195 my ($self, $hash) = @_;
197 $clean_hash->{$_} = $hash->{$_}
198 for grep {!/^-/} keys %$hash;
202 sub _join_condition {
203 my ($self, $cond) = @_;
204 if (ref $cond eq 'HASH') {
207 my $x = '= '.$self->_quote($cond->{$_}); $j{$_} = \$x;
209 return $self->_recurse_where(\%j);
210 } elsif (ref $cond eq 'ARRAY') {
211 return join(' OR ', map { $self->_join_condition($_) } @$cond);
213 die "Can't handle this yet!";
218 my ($self, $label) = @_;
219 return '' unless defined $label;
220 return "*" if $label eq '*';
221 return $label unless $self->{quote_char};
222 if(ref $self->{quote_char} eq "ARRAY"){
223 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
224 if !defined $self->{name_sep};
225 my $sep = $self->{name_sep};
226 return join($self->{name_sep},
227 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
228 split(/\Q$sep\E/,$label));
230 return $self->SUPER::_quote($label);
235 $self->{limit_dialect} = shift if @_;
236 return $self->{limit_dialect};
241 $self->{quote_char} = shift if @_;
242 return $self->{quote_char};
247 $self->{name_sep} = shift if @_;
248 return $self->{name_sep};
251 } # End of BEGIN block
253 use base qw/DBIx::Class/;
255 __PACKAGE__->load_components(qw/AccessorGroup/);
257 __PACKAGE__->mk_group_accessors('simple' =>
258 qw/_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid _conn_tid
259 debug debugobj cursor on_connect_do transaction_depth/);
263 DBIx::Class::Storage::DBI - DBI storage handler
269 This class represents the connection to the database
278 my $new = bless({}, ref $_[0] || $_[0]);
279 $new->cursor("DBIx::Class::Storage::DBI::Cursor");
280 $new->transaction_depth(0);
282 $new->debugobj(new DBIx::Class::Storage::Statistics());
286 my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
289 if (defined($debug_env) && ($debug_env =~ /=(.+)$/)) {
290 $fh = IO::File->new($1, 'w')
291 or $new->throw_exception("Cannot open trace file $1");
293 $fh = IO::File->new('>&STDERR');
296 $new->debug(1) if $debug_env;
297 $new->_sql_maker_opts({});
301 =head2 throw_exception
303 Throws an exception - croaks.
307 sub throw_exception {
308 my ($self, $msg) = @_;
314 The arguments of C<connect_info> are always a single array reference.
316 This is normally accessed via L<DBIx::Class::Schema/connection>, which
317 encapsulates its argument list in an arrayref before calling
318 C<connect_info> here.
320 The arrayref can either contain the same set of arguments one would
321 normally pass to L<DBI/connect>, or a lone code reference which returns
322 a connected database handle.
324 In either case, if the final argument in your connect_info happens
325 to be a hashref, C<connect_info> will look there for several
326 connection-specific options:
332 This can be set to an arrayref of literal sql statements, which will
333 be executed immediately after making the connection to the database
334 every time we [re-]connect.
338 Sets the limit dialect. This is useful for JDBC-bridge among others
339 where the remote SQL-dialect cannot be determined by the name of the
344 Specifies what characters to use to quote table and column names. If
345 you use this you will want to specify L<name_sep> as well.
347 quote_char expects either a single character, in which case is it is placed
348 on either side of the table/column, or an arrayref of length 2 in which case the
349 table/column name is placed between the elements.
351 For example under MySQL you'd use C<quote_char =E<gt> '`'>, and user SQL Server you'd
352 use C<quote_char =E<gt> [qw/[ ]/]>.
356 This only needs to be used in conjunction with L<quote_char>, and is used to
357 specify the charecter that seperates elements (schemas, tables, columns) from
358 each other. In most cases this is simply a C<.>.
362 These options can be mixed in with your other L<DBI> connection attributes,
363 or placed in a seperate hashref after all other normal L<DBI> connection
366 Every time C<connect_info> is invoked, any previous settings for
367 these options will be cleared before setting the new ones, regardless of
368 whether any options are specified in the new C<connect_info>.
372 # Simple SQLite connection
373 ->connect_info([ 'dbi:SQLite:./foo.db' ]);
376 ->connect_info([ sub { DBI->connect(...) } ]);
378 # A bit more complicated
385 { quote_char => q{"}, name_sep => q{.} },
389 # Equivalent to the previous example
395 { AutoCommit => 0, quote_char => q{"}, name_sep => q{.} },
399 # Subref + DBIC-specific connection options
402 sub { DBI->connect(...) },
406 on_connect_do => ['SET search_path TO myschema,otherschema,public'],
413 This method is deprecated in favor of setting via L</connect_info>.
417 Causes SQL trace information to be emitted on the C<debugobj> object.
418 (or C<STDERR> if C<debugobj> has not specifically been set).
420 This is the equivalent to setting L</DBIC_TRACE> in your
425 Set or retrieve the filehandle used for trace/debug output. This should be
426 an IO::Handle compatible ojbect (only the C<print> method is used. Initially
427 set to be STDERR - although see information on the
428 L<DBIC_TRACE> environment variable.
435 if ($self->debugobj->can('debugfh')) {
436 return $self->debugobj->debugfh(@_);
442 Sets or retrieves the object used for metric collection. Defaults to an instance
443 of L<DBIx::Class::Storage::Statistics> that is campatible with the original
444 method of using a coderef as a callback. See the aforementioned Statistics
445 class for more information.
449 Sets a callback to be executed each time a statement is run; takes a sub
450 reference. Callback is executed as $sub->($op, $info) where $op is
451 SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
453 See L<debugobj> for a better way.
460 if ($self->debugobj->can('callback')) {
461 return $self->debugobj->callback(@_);
467 Disconnect the L<DBI> handle, performing a rollback first if the
468 database is not in C<AutoCommit> mode.
475 if( $self->connected ) {
476 $self->_dbh->rollback unless $self->_dbh->{AutoCommit};
477 $self->_dbh->disconnect;
484 Check if the L<DBI> handle is connected. Returns true if the handle
489 sub connected { my ($self) = @_;
491 if(my $dbh = $self->_dbh) {
492 if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
493 return $self->_dbh(undef);
495 elsif($self->_conn_pid != $$) {
496 $self->_dbh->{InactiveDestroy} = 1;
497 return $self->_dbh(undef);
499 return ($dbh->FETCH('Active') && $dbh->ping);
505 =head2 ensure_connected
507 Check whether the database handle is connected - if not then make a
512 sub ensure_connected {
515 unless ($self->connected) {
516 $self->_populate_dbh;
522 Returns the dbh - a data base handle of class L<DBI>.
529 $self->ensure_connected;
533 sub _sql_maker_args {
536 return ( limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
541 Returns a C<sql_maker> object - normally an object of class
542 C<DBIC::SQL::Abstract>.
548 unless ($self->_sql_maker) {
549 $self->_sql_maker(new DBIC::SQL::Abstract( $self->_sql_maker_args ));
551 return $self->_sql_maker;
555 my ($self, $info_arg) = @_;
558 # Kill sql_maker/_sql_maker_opts, so we get a fresh one with only
559 # the new set of options
560 $self->_sql_maker(undef);
561 $self->_sql_maker_opts({});
563 my $info = [ @$info_arg ]; # copy because we can alter it
564 my $last_info = $info->[-1];
565 if(ref $last_info eq 'HASH') {
566 if(my $on_connect_do = delete $last_info->{on_connect_do}) {
567 $self->on_connect_do($on_connect_do);
569 for my $sql_maker_opt (qw/limit_dialect quote_char name_sep/) {
570 if(my $opt_val = delete $last_info->{$sql_maker_opt}) {
571 $self->_sql_maker_opts->{$sql_maker_opt} = $opt_val;
575 # Get rid of any trailing empty hashref
576 pop(@$info) if !keys %$last_info;
579 $self->_connect_info($info);
582 $self->_connect_info;
587 my @info = @{$self->_connect_info || []};
588 $self->_dbh($self->_connect(@info));
590 if(ref $self eq 'DBIx::Class::Storage::DBI') {
591 my $driver = $self->_dbh->{Driver}->{Name};
592 if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) {
593 bless $self, "DBIx::Class::Storage::DBI::${driver}";
594 $self->_rebless() if $self->can('_rebless');
598 # if on-connect sql statements are given execute them
599 foreach my $sql_statement (@{$self->on_connect_do || []}) {
600 $self->debugobj->query_start($sql_statement) if $self->debug();
601 $self->_dbh->do($sql_statement);
602 $self->debugobj->query_end($sql_statement) if $self->debug();
605 $self->_conn_pid($$);
606 $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
610 my ($self, @info) = @_;
612 $self->throw_exception("You failed to provide any connection info")
615 my ($old_connect_via, $dbh);
617 if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
618 $old_connect_via = $DBI::connect_via;
619 $DBI::connect_via = 'connect';
623 $dbh = ref $info[0] eq 'CODE'
625 : DBI->connect(@info);
628 $DBI::connect_via = $old_connect_via if $old_connect_via;
631 $self->throw_exception("DBI Connection failed: " . ($@ || $DBI::errstr));
639 Calls begin_work on the current dbh.
641 See L<DBIx::Class::Schema> for the txn_do() method, which allows for
642 an entire code block to be executed transactionally.
648 if ($self->{transaction_depth}++ == 0) {
649 my $dbh = $self->dbh;
650 if ($dbh->{AutoCommit}) {
651 $self->debugobj->txn_begin()
660 Issues a commit against the current dbh.
666 my $dbh = $self->dbh;
667 if ($self->{transaction_depth} == 0) {
668 unless ($dbh->{AutoCommit}) {
669 $self->debugobj->txn_commit()
675 if (--$self->{transaction_depth} == 0) {
676 $self->debugobj->txn_commit()
685 Issues a rollback against the current dbh. A nested rollback will
686 throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception,
687 which allows the rollback to propagate to the outermost transaction.
695 my $dbh = $self->dbh;
696 if ($self->{transaction_depth} == 0) {
697 unless ($dbh->{AutoCommit}) {
698 $self->debugobj->txn_rollback()
704 if (--$self->{transaction_depth} == 0) {
705 $self->debugobj->txn_rollback()
710 die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new;
717 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
718 $error =~ /$exception_class/ and $self->throw_exception($error);
719 $self->{transaction_depth} = 0; # ensure that a failed rollback
720 $self->throw_exception($error); # resets the transaction depth
725 my ($self, $op, $extra_bind, $ident, @args) = @_;
726 my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
727 unshift(@bind, @$extra_bind) if $extra_bind;
729 my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
730 $self->debugobj->query_start($sql, @debug_bind);
732 my $sth = eval { $self->sth($sql,$op) };
735 $self->throw_exception(
736 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
739 @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
743 $rv = eval { $sth->execute(@bind) };
746 $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr));
749 $self->throw_exception("'$sql' did not generate a statement.");
752 my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
753 $self->debugobj->query_end($sql, @debug_bind);
755 return (wantarray ? ($rv, $sth, @bind) : $rv);
759 my ($self, $ident, $to_insert) = @_;
760 $self->throw_exception(
761 "Couldn't insert ".join(', ',
762 map "$_ => $to_insert->{$_}", keys %$to_insert
764 ) unless ($self->_execute('insert' => [], $ident, $to_insert));
769 return shift->_execute('update' => [], @_);
773 return shift->_execute('delete' => [], @_);
777 my ($self, $ident, $select, $condition, $attrs) = @_;
778 my $order = $attrs->{order_by};
779 if (ref $condition eq 'SCALAR') {
780 $order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
782 if (exists $attrs->{group_by} || $attrs->{having}) {
784 group_by => $attrs->{group_by},
785 having => $attrs->{having},
786 ($order ? (order_by => $order) : ())
789 my @args = ('select', $attrs->{bind}, $ident, $select, $condition, $order);
790 if ($attrs->{software_limit} ||
791 $self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
792 $attrs->{software_limit} = 1;
794 $self->throw_exception("rows attribute must be positive if present")
795 if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
796 push @args, $attrs->{rows}, $attrs->{offset};
798 return $self->_execute(@args);
803 Handle a SQL select statement.
809 my ($ident, $select, $condition, $attrs) = @_;
810 return $self->cursor->new($self, \@_, $attrs);
815 Performs a select, fetch and return of data - handles a single row
820 # Need to call finish() to work round broken DBDs
824 my ($rv, $sth, @bind) = $self->_select(@_);
825 my @row = $sth->fetchrow_array;
832 Returns a L<DBI> sth (statement handle) for the supplied SQL.
837 my ($self, $sql) = @_;
838 # 3 is the if_active parameter which avoids active sth re-use
839 return $self->dbh->prepare_cached($sql, {}, 3);
842 =head2 columns_info_for
844 Returns database type info for a given table columns.
848 sub columns_info_for {
849 my ($self, $table) = @_;
851 my $dbh = $self->dbh;
853 if ($dbh->can('column_info')) {
855 local $dbh->{RaiseError} = 1;
856 local $dbh->{PrintError} = 0;
858 my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
859 my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
862 # Some error occured or there is no information:
864 die "column_info returned no rows for $schema, $tab";
867 while ( my $info = $sth->fetchrow_hashref() ){
869 $column_info{data_type} = $info->{TYPE_NAME};
870 $column_info{size} = $info->{COLUMN_SIZE};
871 $column_info{is_nullable} = $info->{NULLABLE} ? 1 : 0;
872 $column_info{default_value} = $info->{COLUMN_DEF};
873 my $col_name = $info->{COLUMN_NAME};
874 $col_name =~ s/^\"(.*)\"$/$1/;
876 $result{$col_name} = \%column_info;
879 return \%result if !$@;
883 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0");
885 my @columns = @{$sth->{NAME_lc}};
886 for my $i ( 0 .. $#columns ){
888 my $type_num = $sth->{TYPE}->[$i];
890 if(defined $type_num && $dbh->can('type_info')) {
891 my $type_info = $dbh->type_info($type_num);
892 $type_name = $type_info->{TYPE_NAME} if $type_info;
894 $column_info{data_type} = $type_name ? $type_name : $type_num;
895 $column_info{size} = $sth->{PRECISION}->[$i];
896 $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
898 if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) {
899 $column_info{data_type} = $1;
900 $column_info{size} = $2;
903 $result{$columns[$i]} = \%column_info;
909 =head2 last_insert_id
911 Return the row id of the last insert.
916 my ($self, $row) = @_;
918 return $self->dbh->func('last_insert_rowid');
924 Returns the database driver name.
928 sub sqlt_type { shift->dbh->{Driver}->{Name} }
930 =head2 create_ddl_dir (EXPERIMENTAL)
934 =item Arguments: $schema \@databases, $version, $directory, $sqlt_args
938 Creates an SQL file based on the Schema, for each of the specified
939 database types, in the given directory.
941 Note that this feature is currently EXPERIMENTAL and may not work correctly
942 across all databases, or fully handle complex relationships.
948 my ($self, $schema, $databases, $version, $dir, $sqltargs) = @_;
950 if(!$dir || !-d $dir)
952 warn "No directory given, using ./\n";
955 $databases ||= ['MySQL', 'SQLite', 'PostgreSQL'];
956 $databases = [ $databases ] if(ref($databases) ne 'ARRAY');
957 $version ||= $schema->VERSION || '1.x';
958 $sqltargs = { ( add_drop_table => 1 ), %{$sqltargs || {}} };
960 eval "use SQL::Translator";
961 $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
963 my $sqlt = SQL::Translator->new($sqltargs);
964 foreach my $db (@$databases)
967 $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
968 # $sqlt->parser_args({'DBIx::Class' => $schema);
969 $sqlt->data($schema);
970 $sqlt->producer($db);
973 my $filename = $schema->ddl_filename($db, $dir, $version);
976 $self->throw_exception("$filename already exists, skipping $db");
979 open($file, ">$filename")
980 or $self->throw_exception("Can't open $filename for writing ($!)");
981 my $output = $sqlt->translate;
983 # print join(":", keys %{$schema->source_registrations});
984 # print Dumper($sqlt->schema);
987 $self->throw_exception("Failed to translate to $db. (" . $sqlt->error . ")");
996 =head2 deployment_statements
998 Create the statements for L</deploy> and
999 L<DBIx::Class::Schema/deploy>.
1003 sub deployment_statements {
1004 my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
1005 # Need to be connected to get the correct sqlt_type
1006 $self->ensure_connected() unless $type;
1007 $type ||= $self->sqlt_type;
1008 $version ||= $schema->VERSION || '1.x';
1010 eval "use SQL::Translator";
1013 eval "use SQL::Translator::Parser::DBIx::Class;";
1014 $self->throw_exception($@) if $@;
1015 eval "use SQL::Translator::Producer::${type};";
1016 $self->throw_exception($@) if $@;
1017 my $tr = SQL::Translator->new(%$sqltargs);
1018 SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
1019 return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
1022 my $filename = $schema->ddl_filename($type, $dir, $version);
1025 # $schema->create_ddl_dir([ $type ], $version, $dir, $sqltargs);
1026 $self->throw_exception("No SQL::Translator, and no Schema file found, aborting deploy");
1030 open($file, "<$filename")
1031 or $self->throw_exception("Can't open $filename ($!)");
1035 return join('', @rows);
1041 Sends the appropriate statements to create or modify tables to the
1042 db. This would normally be called through
1043 L<DBIx::Class::Schema/deploy>.
1048 my ($self, $schema, $type, $sqltargs) = @_;
1049 foreach my $statement ( $self->deployment_statements($schema, $type, undef, undef, { no_comments => 1, %{ $sqltargs || {} } } ) ) {
1050 for ( split(";\n", $statement)) {
1051 next if($_ =~ /^--/);
1053 # next if($_ =~ /^DROP/m);
1054 next if($_ =~ /^BEGIN TRANSACTION/m);
1055 next if($_ =~ /^COMMIT/m);
1056 next if $_ =~ /^\s+$/; # skip whitespace only
1057 $self->debugobj->query_start($_) if $self->debug;
1058 $self->dbh->do($_) or warn "SQL was:\n $_";
1059 $self->debugobj->query_end($_) if $self->debug;
1064 =head2 datetime_parser
1066 Returns the datetime parser class
1070 sub datetime_parser {
1072 return $self->{datetime_parser} ||= $self->build_datetime_parser(@_);
1075 =head2 datetime_parser_type
1077 Defines (returns) the datetime parser class - currently hardwired to
1078 L<DateTime::Format::MySQL>
1082 sub datetime_parser_type { "DateTime::Format::MySQL"; }
1084 =head2 build_datetime_parser
1086 See L</datetime_parser>
1090 sub build_datetime_parser {
1092 my $type = $self->datetime_parser_type(@_);
1094 $self->throw_exception("Couldn't load ${type}: $@") if $@;
1098 sub DESTROY { shift->disconnect }
1104 The module defines a set of methods within the DBIC::SQL::Abstract
1105 namespace. These build on L<SQL::Abstract::Limit> to provide the
1106 SQL query functions.
1108 The following methods are extended:-
1122 See L</connect_info> for details.
1123 For setting, this method is deprecated in favor of L</connect_info>.
1127 See L</connect_info> for details.
1128 For setting, this method is deprecated in favor of L</connect_info>.
1132 See L</connect_info> for details.
1133 For setting, this method is deprecated in favor of L</connect_info>.
1137 =head1 ENVIRONMENT VARIABLES
1141 If C<DBIC_TRACE> is set then SQL trace information
1142 is produced (as when the L<debug> method is set).
1144 If the value is of the form C<1=/path/name> then the trace output is
1145 written to the file C</path/name>.
1147 This environment variable is checked when the storage object is first
1148 created (when you call connect on your schema). So, run-time changes
1149 to this environment variable will not take effect unless you also
1150 re-connect on your schema.
1152 =head2 DBIX_CLASS_STORAGE_DBI_DEBUG
1154 Old name for DBIC_TRACE
1158 Matt S. Trout <mst@shadowcatsystems.co.uk>
1160 Andy Grundman <andy@hybridized.org>
1164 You may distribute this code under the same terms as Perl itself.