use List::Util qw/first/;
use Context::Preserve 'preserve_context';
use Try::Tiny;
-use Data::Compare (); # no imports!!! guard against insane architecture
use SQL::Abstract qw(is_plain_value is_literal_value);
-use DBIx::Class::_Util qw(quote_sub perlstring);
+use DBIx::Class::_Util qw(quote_sub perlstring serialize detected_reinvoked_destructor);
use namespace::clean;
# default cursor class, overridable in connect_info attributes
my $orig = __PACKAGE__->can ($meth)
or die "$meth is not a ::Storage::DBI method!";
- my $is_getter = $storage_accessor_idx->{$meth} ? 0 : 1;
+ my $possibly_a_setter = $storage_accessor_idx->{$meth} ? 1 : 0;
quote_sub
- __PACKAGE__ ."::$meth", sprintf( <<'EOC', $is_getter, perlstring $meth ), { '$orig' => \$orig };
+ __PACKAGE__ ."::$meth", sprintf( <<'EOC', $possibly_a_setter, perlstring $meth ), { '$orig' => \$orig };
if (
+ # if this is an actual *setter* - just set it, no need to connect
+ # and determine the driver
+ !( %1$s and @_ > 1 )
+ and
# only fire when invoked on an instance, a valid class-based invocation
# would e.g. be setting a default for an inherited accessor
ref $_[0]
and
! $_[0]->{_in_determine_driver}
and
- # if this is a known *setter* - just set it, no need to connect
- # and determine the driver
- ( %1$s or @_ <= 1 )
- and
# Only try to determine stuff if we have *something* that either is or can
# provide a DSN. Allows for bare $schema's generated with a plain ->connect()
# to still be marginally useful
}
sub DESTROY {
- my $self = shift;
+ return if &detected_reinvoked_destructor;
+ $_[0]->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
# some databases spew warnings on implicit disconnect
- $self->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
local $SIG{__WARN__} = sub {};
- $self->_dbh(undef);
+ $_[0]->_dbh(undef);
# this op is necessary, since the very last perl runtime statement
# triggers a global destruction shootout, and the $SIG localization
# handle pid changes correctly - do not destroy parent's connection
sub _verify_pid {
- my $self = shift;
- my $pid = $self->_conn_pid;
- if( defined $pid and $pid != $$ and my $dbh = $self->_dbh ) {
+ my $pid = $_[0]->_conn_pid;
+
+ if( defined $pid and $pid != $$ and my $dbh = $_[0]->_dbh ) {
$dbh->{InactiveDestroy} = 1;
- $self->_dbh(undef);
- $self->transaction_depth(0);
- $self->savepoints([]);
+ $_[0]->_dbh(undef);
+ $_[0]->transaction_depth(0);
+ $_[0]->savepoints([]);
}
return;
=cut
sub disconnect {
- my ($self) = @_;
- if( $self->_dbh ) {
- my @actions;
+ if( my $dbh = $_[0]->_dbh ) {
- push @actions, ( $self->on_disconnect_call || () );
- push @actions, $self->_parse_connect_do ('on_disconnect_do');
-
- $self->_do_connection_actions(disconnect_call_ => $_) for @actions;
+ $_[0]->_do_connection_actions(disconnect_call_ => $_) for (
+ ( $_[0]->on_disconnect_call || () ),
+ $_[0]->_parse_connect_do ('on_disconnect_do')
+ );
# stops the "implicit rollback on disconnect" warning
- $self->_exec_txn_rollback unless $self->_dbh_autocommit;
+ $_[0]->_exec_txn_rollback unless $_[0]->_dbh_autocommit;
- %{ $self->_dbh->{CachedKids} } = ();
- $self->_dbh->disconnect;
- $self->_dbh(undef);
+ %{ $dbh->{CachedKids} } = ();
+ $dbh->disconnect;
+ $_[0]->_dbh(undef);
}
}
# Storage subclasses should override this
sub with_deferred_fk_checks {
- my ($self, $sub) = @_;
- $sub->();
+ #my ($self, $sub) = @_;
+ $_[1]->();
}
=head2 connected
=cut
sub connected {
- my $self = shift;
- return 0 unless $self->_seems_connected;
+ return 0 unless $_[0]->_seems_connected;
#be on the safe side
- local $self->_dbh->{RaiseError} = 1;
+ local $_[0]->_dbh->{RaiseError} = 1;
- return $self->_ping;
+ return $_[0]->_ping;
}
sub _seems_connected {
- my $self = shift;
-
- $self->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
-
- my $dbh = $self->_dbh
- or return 0;
+ $_[0]->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
- return $dbh->FETCH('Active');
+ ($_[0]->_dbh || return 0)->FETCH('Active');
}
sub _ping {
- my $self = shift;
-
- my $dbh = $self->_dbh or return 0;
-
- return $dbh->ping;
+ ($_[0]->_dbh || return 0)->ping;
}
sub ensure_connected {
- my ($self) = @_;
-
- unless ($self->connected) {
- $self->_populate_dbh;
- }
+ $_[0]->connected || ( $_[0]->_populate_dbh && 1 );
}
=head2 dbh
=cut
sub dbh {
- my ($self) = @_;
-
- if (not $self->_dbh) {
- $self->_populate_dbh;
- } else {
- $self->ensure_connected;
- }
- return $self->_dbh;
+ # maybe save a ping call
+ $_[0]->_dbh
+ ? ( $_[0]->ensure_connected and $_[0]->_dbh )
+ : $_[0]->_populate_dbh
+ ;
}
# this is the internal "get dbh or connect (don't check)" method
sub _get_dbh {
- my $self = shift;
- $self->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
- $self->_populate_dbh unless $self->_dbh;
- return $self->_dbh;
+ $_[0]->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
+ $_[0]->_dbh || $_[0]->_populate_dbh;
}
# *DELIBERATELY* not a setter (for the time being)
sub _init {}
sub _populate_dbh {
- my ($self) = @_;
- $self->_dbh(undef); # in case ->connected failed we might get sent here
- $self->_dbh_details({}); # reset everything we know
- $self->_sql_maker(undef); # this may also end up being different
+ $_[0]->_dbh(undef); # in case ->connected failed we might get sent here
- $self->_dbh($self->_connect);
+ $_[0]->_dbh_details({}); # reset everything we know
- $self->_conn_pid($$) unless DBIx::Class::_ENV_::BROKEN_FORK; # on win32 these are in fact threads
+ # FIXME - this needs reenabling with the proper "no reset on same DSN" check
+ #$_[0]->_sql_maker(undef); # this may also end up being different
- $self->_determine_driver;
+ $_[0]->_dbh($_[0]->_connect);
+
+ $_[0]->_conn_pid($$) unless DBIx::Class::_ENV_::BROKEN_FORK; # on win32 these are in fact threads
+
+ $_[0]->_determine_driver;
# Always set the transaction depth on connect, since
# there is no transaction in progress by definition
- $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
+ $_[0]->{transaction_depth} = $_[0]->_dbh_autocommit ? 0 : 1;
+
+ $_[0]->_run_connection_actions unless $_[0]->{_in_determine_driver};
- $self->_run_connection_actions unless $self->{_in_determine_driver};
+ $_[0]->_dbh;
}
sub _run_connection_actions {
- my $self = shift;
- my @actions;
-
- push @actions, ( $self->on_connect_call || () );
- push @actions, $self->_parse_connect_do ('on_connect_do');
- $self->_do_connection_actions(connect_call_ => $_) for @actions;
+ $_[0]->_do_connection_actions(connect_call_ => $_) for (
+ ( $_[0]->on_connect_call || () ),
+ $_[0]->_parse_connect_do ('on_connect_do'),
+ );
}
sub _server_info {
my $self = shift;
- my $info;
- unless ($info = $self->_dbh_details->{info}) {
+ # FIXME - ideally this needs to be an ||= assignment, and the final
+ # assignment at the end of this do{} should be gone entirely. However
+ # this confuses CXSA: https://rt.cpan.org/Ticket/Display.html?id=103296
+ $self->_dbh_details->{info} || do {
- $info = {};
+ # this guarantees that problematic conninfo won't be hidden
+ # by the try{} below
+ $self->ensure_connected;
+
+ my $info = {};
my $server_version = try {
$self->_get_server_version
}
$self->_dbh_details->{info} = $info;
- }
-
- return $info;
+ };
}
sub _get_server_version {
sub _determine_connector_driver {
my ($self, $conn) = @_;
- my $dbtype = $self->_dbh_get_info('SQL_DBMS_NAME');
+ my $dbtype = $self->_get_rdbms_name;
if (not $dbtype) {
$self->_warn_undetermined_driver(
}
}
+sub _get_rdbms_name { shift->_dbh_get_info('SQL_DBMS_NAME') }
+
sub _warn_undetermined_driver {
my ($self, $msg) = @_;
}
sub _do_connection_actions {
- my $self = shift;
- my $method_prefix = shift;
- my $call = shift;
-
- if (not ref($call)) {
- my $method = $method_prefix . $call;
- $self->$method(@_);
- } elsif (ref($call) eq 'CODE') {
- $self->$call(@_);
- } elsif (ref($call) eq 'ARRAY') {
- if (ref($call->[0]) ne 'ARRAY') {
- $self->_do_connection_actions($method_prefix, $_) for @$call;
- } else {
- $self->_do_connection_actions($method_prefix, @$_) for @$call;
+ my ($self, $method_prefix, $call, @args) = @_;
+
+ try {
+ if (not ref($call)) {
+ my $method = $method_prefix . $call;
+ $self->$method(@args);
+ }
+ elsif (ref($call) eq 'CODE') {
+ $self->$call(@args);
+ }
+ elsif (ref($call) eq 'ARRAY') {
+ if (ref($call->[0]) ne 'ARRAY') {
+ $self->_do_connection_actions($method_prefix, $_) for @$call;
+ }
+ else {
+ $self->_do_connection_actions($method_prefix, @$_) for @$call;
+ }
+ }
+ else {
+ $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) );
}
- } else {
- $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) );
}
+ catch {
+ if ( $method_prefix =~ /^connect/ ) {
+ # this is an on_connect cycle - we can't just throw while leaving
+ # a handle in an undefined state in our storage object
+ # kill it with fire and rethrow
+ $self->_dbh(undef);
+ $self->throw_exception( $_[0] );
+ }
+ else {
+ carp "Disconnect action failed: $_[0]";
+ }
+ };
return $self;
}
$self->_do_query(@_);
}
-# override in db-specific backend when necessary
+=head2 connect_call_datetime_setup
+
+A no-op stub method, provided so that one can always safely supply the
+L<connection option|/DBIx::Class specific connection attributes>
+
+ on_connect_call => 'datetime_setup'
+
+This way one does not need to know in advance whether the underlying
+storage requires any sort of hand-holding when dealing with calendar
+data.
+
+=cut
+
sub connect_call_datetime_setup { 1 }
sub _do_query {
}
sub txn_begin {
- my $self = shift;
-
# this means we have not yet connected and do not know the AC status
# (e.g. coderef $dbh), need a full-fledged connection check
- if (! defined $self->_dbh_autocommit) {
- $self->ensure_connected;
+ if (! defined $_[0]->_dbh_autocommit) {
+ $_[0]->ensure_connected;
}
# Otherwise simply connect or re-connect on pid changes
else {
- $self->_get_dbh;
+ $_[0]->_get_dbh;
}
- $self->next::method(@_);
+ shift->next::method(@_);
}
sub _exec_txn_begin {
sub txn_commit {
my $self = shift;
- $self->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
$self->throw_exception("Unable to txn_commit() on a disconnected storage")
- unless $self->_dbh;
+ unless $self->_seems_connected;
# esoteric case for folks using external $dbh handles
if (! $self->transaction_depth and ! $self->_dbh->FETCH('AutoCommit') ) {
sub txn_rollback {
my $self = shift;
- $self->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
$self->throw_exception("Unable to txn_rollback() on a disconnected storage")
- unless $self->_dbh;
+ unless $self->_seems_connected;
# esoteric case for folks using external $dbh handles
if (! $self->transaction_depth and ! $self->_dbh->FETCH('AutoCommit') ) {
# generate the DBI-specific stubs, which then fallback to ::Storage proper
quote_sub __PACKAGE__ . "::$_" => sprintf (<<'EOS', $_) for qw(svp_begin svp_release svp_rollback);
- $_[0]->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
$_[0]->throw_exception('Unable to %s() on a disconnected storage')
- unless $_[0]->_dbh;
+ unless $_[0]->_seems_connected;
shift->next::method(@_);
EOS
) {
carp_unique 'DateTime objects passed to search() are not supported '
. 'properly (InflateColumn::DateTime formats and settings are not '
- . 'respected.) See "Formatting DateTime objects in queries" in '
- . 'DBIx::Class::Manual::Cookbook. To disable this warning for good '
+ . 'respected.) See ".. format a DateTime object for searching?" in '
+ . 'DBIx::Class::Manual::FAQ. To disable this warning for good '
. 'set $ENV{DBIC_DT_SEARCH_OK} to true'
}
}
sub _dbi_attrs_for_bind {
- my ($self, $ident, $bind) = @_;
+ #my ($self, $ident, $bind) = @_;
- my @attrs;
+ return [ map {
- for (map { $_->[0] } @$bind) {
- push @attrs, do {
- if (exists $_->{dbd_attrs}) {
- $_->{dbd_attrs}
- }
- elsif($_->{sqlt_datatype}) {
- # cache the result in the dbh_details hash, as it can not change unless
- # we connect to something else
- my $cache = $self->_dbh_details->{_datatype_map_cache} ||= {};
- if (not exists $cache->{$_->{sqlt_datatype}}) {
- $cache->{$_->{sqlt_datatype}} = $self->bind_attribute_by_data_type($_->{sqlt_datatype}) || undef;
- }
- $cache->{$_->{sqlt_datatype}};
- }
- else {
- undef; # always push something at this position
- }
- }
- }
+ exists $_->{dbd_attrs} ? $_->{dbd_attrs}
+
+ : ! $_->{sqlt_datatype} ? undef
+
+ : do {
+
+ # cache the result in the dbh_details hash, as it (usually) can not change
+ # unless we connect to something else
+ # FIXME: for the time being Oracle is an exception, pending a rewrite of
+ # the LOB storage
+ my $cache = $_[0]->_dbh_details->{_datatype_map_cache} ||= {};
+
+ $cache->{$_->{sqlt_datatype}} = $_[0]->bind_attribute_by_data_type($_->{sqlt_datatype})
+ if ! exists $cache->{$_->{sqlt_datatype}};
+
+ $cache->{$_->{sqlt_datatype}};
- return \@attrs;
+ } } map { $_->[0] } @{$_[2]} ];
}
sub _execute {
# can't just hand SQLA a set of some known "values" (e.g. hashrefs that
# can be later matched up by address), because we want to supply a real
# value on which perhaps e.g. datatype checks will be performed
- my ($proto_data, $value_type_by_col_idx);
+ my ($proto_data, $serialized_bind_type_by_col_idx);
for my $col_idx (0..$#$cols) {
my $colname = $cols->[$col_idx];
if (ref $data->[0][$col_idx] eq 'SCALAR') {
# store value-less (attrs only) bind info - we will be comparing all
# supplied binds against this for sanity
- $value_type_by_col_idx->{$col_idx} = [ map { $_->[0] } @$resolved_bind ];
+ $serialized_bind_type_by_col_idx->{$col_idx} = serialize [ map { $_->[0] } @$resolved_bind ];
$proto_data->{$colname} = \[ $sql, map { [
# inject slice order to use for $proto_bind construction
];
}
else {
- $value_type_by_col_idx->{$col_idx} = undef;
+ $serialized_bind_type_by_col_idx->{$col_idx} = undef;
$proto_data->{$colname} = \[ '?', [
{ dbic_colname => $colname, _bind_data_slice_idx => $col_idx }
[ $proto_data ],
);
- if (! @$proto_bind and keys %$value_type_by_col_idx) {
+ if (! @$proto_bind and keys %$serialized_bind_type_by_col_idx) {
# if the bindlist is empty and we had some dynamic binds, this means the
# storage ate them away (e.g. the NoBindVars component) and interpolated
# them directly into the SQL. This obviously can't be good for multi-inserts
for my $row_idx (1..$#$data) { # we are comparing against what we got from [0] above, hence start from 1
my $val = $data->[$row_idx][$col_idx];
- if (! exists $value_type_by_col_idx->{$col_idx}) { # literal no binds
+ if (! exists $serialized_bind_type_by_col_idx->{$col_idx}) { # literal no binds
if (ref $val ne 'SCALAR') {
$bad_slice_report_cref->(
"Incorrect value (expecting SCALAR-ref \\'$$reference_val')",
);
}
}
- elsif (! defined $value_type_by_col_idx->{$col_idx} ) { # regular non-literal value
+ elsif (! defined $serialized_bind_type_by_col_idx->{$col_idx} ) { # regular non-literal value
if (is_literal_value($val)) {
$bad_slice_report_cref->("Literal SQL found where a plain bind value is expected", $row_idx, $col_idx);
}
}
# need to check the bind attrs - a bind will happen only once for
# the entire dataset, so any changes further down will be ignored.
- elsif (! Data::Compare::Compare(
- $value_type_by_col_idx->{$col_idx},
- [
+ elsif (
+ $serialized_bind_type_by_col_idx->{$col_idx}
+ ne
+ serialize [
map
{ $_->[0] }
@{$self->_resolve_bindattrs(
$source, [ @{$$val}[1 .. $#$$val] ], $colinfos,
)}
- ],
- )) {
+ ]
+ ) {
$bad_slice_report_cref->(
'Differing bind attributes on literal/bind values not supported',
$row_idx,
# scope guard
my $guard = $self->txn_scope_guard;
- $self->_query_start( $sql, @$proto_bind ? [[undef => '__BULK_INSERT__' ]] : () );
+ $self->_query_start( $sql, @$proto_bind ? [[ {} => '__BULK_INSERT__' ]] : () );
my $sth = $self->_prepare_sth($self->_dbh, $sql);
my $rv = do {
if (@$proto_bind) {
}
};
- $self->_query_end( $sql, @$proto_bind ? [[ undef => '__BULK_INSERT__' ]] : () );
+ $self->_query_end( $sql, @$proto_bind ? [[ {} => '__BULK_INSERT__' ]] : () );
$guard->commit;
sub _dbh_columns_info_for {
my ($self, $dbh, $table) = @_;
- if ($dbh->can('column_info')) {
- my %result;
- my $caught;
+ my %result;
+
+ if (! DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE and $dbh->can('column_info')) {
try {
my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
$result{$col_name} = \%column_info;
}
} catch {
- $caught = 1;
+ %result = ();
};
- return \%result if !$caught && scalar keys %result;
+
+ return \%result if keys %result;
}
- my %result;
my $sth = $dbh->prepare($self->sql_maker->select($table, undef, \'1 = 0'));
$sth->execute;
- my @columns = @{$sth->{NAME_lc}};
- for my $i ( 0 .. $#columns ){
- my %column_info;
- $column_info{data_type} = $sth->{TYPE}->[$i];
- $column_info{size} = $sth->{PRECISION}->[$i];
- $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
-
- if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) {
- $column_info{data_type} = $1;
- $column_info{size} = $2;
+
+### The acrobatics with lc names is necessary to support both the legacy
+### API that used NAME_lc exclusively, *AND* at the same time work properly
+### with column names differing in cas eonly (thanks pg!)
+
+ my ($columns, $seen_lcs);
+
+ ++$seen_lcs->{lc($_)} and $columns->{$_} = {
+ idx => scalar keys %$columns,
+ name => $_,
+ lc_name => lc($_),
+ } for @{$sth->{NAME}};
+
+ $seen_lcs->{$_->{lc_name}} == 1
+ and
+ $_->{name} = $_->{lc_name}
+ for values %$columns;
+
+ for ( values %$columns ) {
+ my $inf = {
+ data_type => $sth->{TYPE}->[$_->{idx}],
+ size => $sth->{PRECISION}->[$_->{idx}],
+ is_nullable => $sth->{NULLABLE}->[$_->{idx}] ? 1 : 0,
+ };
+
+ if ($inf->{data_type} =~ m/^(.*?)\((.*?)\)$/) {
+ @{$inf}{qw( data_type size)} = ($1, $2);
}
- $result{$columns[$i]} = \%column_info;
+ $result{$_->{name}} = $inf;
}
+
$sth->finish;
- foreach my $col (keys %result) {
- my $colinfo = $result{$col};
- my $type_num = $colinfo->{data_type};
- my $type_name;
- if(defined $type_num && $dbh->can('type_info')) {
- my $type_info = $dbh->type_info($type_num);
- $type_name = $type_info->{TYPE_NAME} if $type_info;
- $colinfo->{data_type} = $type_name if $type_name;
+ if ($dbh->can('type_info')) {
+ for my $inf (values %result) {
+ next if ! defined $inf->{data_type};
+
+ $inf->{data_type} = (
+ (
+ (
+ $dbh->type_info( $inf->{data_type} )
+ ||
+ next
+ )
+ ||
+ next
+ )->{TYPE_NAME}
+ ||
+ next
+ );
+
+ # FIXME - this may be an artifact of the DBD::Pg implmentation alone
+ # needs more testing in the future...
+ $inf->{size} -= 4 if (
+ ( $inf->{size}||0 > 4 )
+ and
+ $inf->{data_type} =~ qr/^text$/i
+ );
}
+
}
return \%result;
%{$sqltargs || {}}
};
- unless (DBIx::Class::Optional::Dependencies->req_ok_for ('deploy')) {
- $self->throw_exception("Can't create a ddl file without " . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') );
+ if (my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('deploy')) {
+ $self->throw_exception("Can't create a ddl file without $missing");
}
my $sqlt = SQL::Translator->new( $sqltargs );
=back
-Returns the statements used by L</deploy> and L<DBIx::Class::Schema/deploy>.
+Returns the statements used by L<DBIx::Class::Storage/deploy>
+and L<DBIx::Class::Schema/deploy>.
The L<SQL::Translator> (not L<DBI>) database driver name can be explicitly
provided in C<$type>, otherwise the result of L</sqlt_type> is used as default.
return join('', @rows);
}
- unless (DBIx::Class::Optional::Dependencies->req_ok_for ('deploy') ) {
- $self->throw_exception("Can't deploy without a ddl_dir or " . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') );
+ if (my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') ) {
+ $self->throw_exception("Can't deploy without a pregenerated 'ddl_dir' directory or $missing");
}
# sources needs to be a parser arg, but for simplicity allow at top level
cases if you choose the C<< AutoCommit => 0 >> path, just as you would
be with raw DBI.
+=head1 FURTHER QUESTIONS?
-=head1 AUTHOR AND CONTRIBUTORS
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
-See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
+=head1 COPYRIGHT AND LICENSE
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.