use strict;
use warnings;
use base qw/DBIx::Class/;
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
use DBIx::Class::Exception;
-use Data::Page;
use DBIx::Class::ResultSetColumn;
-use DBIx::Class::ResultSourceHandle;
-use Hash::Merge ();
use Scalar::Util qw/blessed weaken/;
use Try::Tiny;
-use Storable qw/nfreeze thaw/;
# not importing first() as it will clash with our own method
use List::Util ();
-use namespace::clean;
-
-
BEGIN {
# De-duplication in _merge_attr() is disabled, but left in for reference
# (the merger is used for other things that ought not to be de-duped)
*__HM_DEDUP = sub () { 0 };
}
+use namespace::clean;
+
use overload
'0+' => "count",
'bool' => "_bool",
year => $request->param('year'),
});
- $self->apply_security_policy( $cd_rs );
+ $cd_rs = $self->apply_security_policy( $cd_rs );
return $cd_rs->all();
}
=cut
-my $callsites_warned;
sub search_rs {
my $self = shift;
} if @_;
if( @_ > 1 and ! $rsrc->result_class->isa('DBIx::Class::CDBICompat') ) {
- # determine callsite obeying Carp::Clan rules (fucking ugly but don't have better ideas)
- my $callsite = do {
- my $w;
- local $SIG{__WARN__} = sub { $w = shift };
- carp;
- $w
- };
- carp 'search( %condition ) is deprecated, use search( \%condition ) instead'
- unless $callsites_warned->{$callsite}++;
+ carp_unique 'search( %condition ) is deprecated, use search( \%condition ) instead';
}
for ($old_where, $call_cond) {
}++;
push @unique_queries, try {
- $self->_build_unique_cond ($c_name, $call_cond)
+ $self->_build_unique_cond ($c_name, $call_cond, 'croak_on_nulls')
} || ();
}
}
sub _build_unique_cond {
- my ($self, $constraint_name, $extra_cond) = @_;
+ my ($self, $constraint_name, $extra_cond, $croak_on_null) = @_;
my @c_cols = $self->result_source->unique_constraint_columns($constraint_name);
};
# trim out everything not in $columns
- $final_cond = { map { $_ => $final_cond->{$_} } @c_cols };
-
- if (my @missing = grep { ! defined $final_cond->{$_} } (@c_cols) ) {
+ $final_cond = { map {
+ exists $final_cond->{$_}
+ ? ( $_ => $final_cond->{$_} )
+ : ()
+ } @c_cols };
+
+ if (my @missing = grep
+ { ! ($croak_on_null ? defined $final_cond->{$_} : exists $final_cond->{$_}) }
+ (@c_cols)
+ ) {
$self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', no values for column(s): %s",
$constraint_name,
join (', ', map { "'$_'" } @missing),
) );
}
+ if (
+ !$croak_on_null
+ and
+ !$ENV{DBIC_NULLABLE_KEY_NOWARN}
+ and
+ my @undefs = grep { ! defined $final_cond->{$_} } (keys %$final_cond)
+ ) {
+ carp_unique ( sprintf (
+ "NULL/undef values supplied for requested unique constraint '%s' (NULL "
+ . 'values in column(s): %s). This is almost certainly not what you wanted, '
+ . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
+ $constraint_name,
+ join (', ', map { "'$_'" } @undefs),
+ ));
+ }
+
return $final_cond;
}
sub search_like {
my $class = shift;
- carp (
+ carp_unique (
'search_like() is deprecated and will be removed in DBIC version 0.09.'
.' Instead use ->search({ x => { -like => "y%" } })'
.' (note the outer pair of {}s - they are important!)'
### necessary for future development of DBIx::DS. Do *NOT* change this code
### before talking to ribasushi/mst
+ require Data::Page;
my $pager = Data::Page->new(
0, #start with an empty set
$attrs->{rows},
# subquery (since a group_by is present)
if (delete $attrs->{distinct}) {
if ($attrs->{group_by}) {
- carp ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
+ carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
}
else {
# distinct affects only the main selection part, not what prefetch may
sub _merge_attr {
$hm ||= do {
+ require Hash::Merge;
my $hm = Hash::Merge->new;
$hm->specify_behavior({
# A cursor in progress can't be serialized (and would make little sense anyway)
delete $to_serialize->{cursor};
- nfreeze($to_serialize);
+ Storable::nfreeze($to_serialize);
}
# need this hook for symmetry
sub STORABLE_thaw {
my ($self, $cloning, $serialized) = @_;
- %$self = %{ thaw($serialized) };
+ %$self = %{ Storable::thaw($serialized) };
$self;
}
column (or relationship) accessor, and 'name' is the name of the column
accessor in the related table.
+B<NOTE:> You need to explicitly quote '+columns' when defining the attribute.
+Not doing so causes Perl to incorrectly interpret +columns as a bareword with a
+unary plus operator before it.
+
=head2 include_columns
=over 4
e.g. an C<ORDER BY> clause. This is done via the C<-as> B<select function
attribute> supplied as shown in the example above.
+B<NOTE:> You need to explicitly quote '+select'/'+as' when defining the attributes.
+Not doing so causes Perl to incorrectly interpret them as a bareword with a
+unary plus operator before it.
+
=head2 +select
=over 4
identical to creating a non-pages resultset and then calling ->page($page)
on it.
-If L<rows> attribute is not specified it defaults to 10 rows per page.
+If L</rows> attribute is not specified it defaults to 10 rows per page.
When you have a paged resultset, L</count> will only return the number
of rows in the page. To get the total, use the L</pager> and call
projects / dbsrgits/DBIx-Class.git / blobdiff