sub MODIFY_CODE_ATTRIBUTES {
my ($class,$code,@attrs) = @_;
- $class->mk_classdata('__attr_cache' => {}) unless $class->can('__attr_cache');
+ $class->mk_classdata('__attr_cache' => {})
+ unless $class->can('__attr_cache');
$class->__attr_cache->{$code} = [@attrs];
return ();
}
package MyDB::MyTable;
use base qw/MyDB/;
- __PACKAGE__->load_components('Core'); # just load this in MyDB if it will always be there
+ __PACKAGE__->load_components('Core'); # just load this in MyDB if it will
+ # always be there
...
Executes a block of code transactionally. If this code reference
throws an exception, the transaction is rolled back and the exception
-is rethrown. See txn_do in L<DBIx::Class::Schema> for more details.
+is rethrown. See L<DBIx::Class::Schema/"txn_do"> for more details.
=cut
sub inflate_column {
my ($self, $col, $attrs) = @_;
- $self->throw_exception("No such column $col to inflate") unless $self->has_column($col);
- $self->throw_exception("inflate_column needs attr hashref") unless ref $attrs eq 'HASH';
+ $self->throw_exception("No such column $col to inflate")
+ unless $self->has_column($col);
+ $self->throw_exception("inflate_column needs attr hashref")
+ unless ref $attrs eq 'HASH';
$self->column_info($col)->{_inflate_info} = $attrs;
$self->mk_group_accessors('inflated_column' => $col);
return 1;
sub _inflated_column {
my ($self, $col, $value) = @_;
return $value unless defined $value; # NULL is NULL is NULL
- my $info = $self->column_info($col) || $self->throw_exception("No column info for $col");
+ my $info = $self->column_info($col)
+ or $self->throw_exception("No column info for $col");
return $value unless exists $info->{_inflate_info};
my $inflate = $info->{_inflate_info}{inflate};
$self->throw_exception("No inflator for $col") unless defined $inflate;
sub _deflated_column {
my ($self, $col, $value) = @_;
return $value unless ref $value; # If it's not an object, don't touch it
- my $info = $self->column_info($col) || $self->throw_exception("No column info for $col");
+ my $info = $self->column_info($col) or
+ $self->throw_exception("No column info for $col");
return $value unless exists $info->{_inflate_info};
my $deflate = $info->{_inflate_info}{deflate};
$self->throw_exception("No deflator for $col") unless defined $deflate;
sub get_inflated_column {
my ($self, $col) = @_;
- $self->throw_exception("$col is not an inflated column") unless
- exists $self->column_info($col)->{_inflate_info};
+ $self->throw_exception("$col is not an inflated column")
+ unless exists $self->column_info($col)->{_inflate_info};
return $self->{_inflated_column}{$col}
if exists $self->{_inflated_column}{$col};
my ($self) = @_;
delete $self->{_dirty_columns};
return unless $self->in_storage; # Don't reload if we aren't real!
- my ($reload) = $self->result_source->resultset->find(map { $self->$_ } $self->primary_columns);
+ my ($reload) = $self->result_source->resultset->find
+ (map { $self->$_ } $self->primary_columns);
unless ($reload) { # If we got deleted in the mean-time
$self->in_storage(0);
return $self;
sub id {
my ($self) = @_;
- $self->throw_exception( "Can't call id() as a class method" ) unless ref $self;
+ $self->throw_exception( "Can't call id() as a class method" )
+ unless ref $self;
my @pk = $self->_ident_values;
return (wantarray ? @pk : $pk[0]);
}
sub ID {
my ($self) = @_;
- $self->throw_exception( "Can't call ID() as a class method" ) unless ref $self;
+ $self->throw_exception( "Can't call ID() as a class method" )
+ unless ref $self;
return undef unless $self->in_storage;
- return $self->_create_ID(map { $_ => $self->{_column_data}{$_} } $self->primary_columns);
+ return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
+ $self->primary_columns);
}
sub _create_ID {
my ($self,%vals) = @_;
return undef unless 0 == grep { !defined } values %vals;
- return join '|', ref $self || $self, $self->result_source->name, map { $_ . '=' . $vals{$_} } sort keys %vals;
+ return join '|', ref $self || $self, $self->result_source->name,
+ map { $_ . '=' . $vals{$_} } sort keys %vals;
}
sub ident_condition {
my ($self, $alias) = @_;
my %cond;
- $cond{(defined $alias ? "${alias}.$_" : $_)} = $self->get_column($_) for $self->primary_columns;
+ $cond{(defined $alias ? "${alias}.$_" : $_)} = $self->get_column($_)
+ for $self->primary_columns;
return \%cond;
}
Since the database is not actually queried until you attempt to retrieve
the data for an actual item, no time is wasted producing them.
- my $cheapfredbooks = $schema->resultset('Author')->find({ Name => 'Fred' })->books->search_related('prices', { Price => { '<=' => '5.00' } });
+ my $cheapfredbooks = $schema->resultset('Author')->find({
+ Name => 'Fred',
+ })->books->search_related('prices', {
+ Price => { '<=' => '5.00' },
+ });
will produce a query something like:
# in an Author class (where Author has many Books)
My::DBIC::Schema::Author->has_many(books => 'Book', 'author');
my $booklist = $obj->books;
- my $booklist = $obj->books({ name => { LIKE => '%macaroni%' }, { prefetch => [qw/book/] });
+ my $booklist = $obj->books({
+ name => { LIKE => '%macaroni%' },
+ { prefetch => [qw/book/],
+ });
my @book_objs = $obj->books;
$obj->add_to_books(\%col_data);
=head2 many_to_many
My::DBIC::Schema::Actor->many_to_many( roles => 'actor_roles', 'Roles' );
- my @role_objs = $obj_a->roles;
+
+ ...
+
+ my @role_objs = $actor->roles;
Creates an accessor bridging two relationships; not strictly a relationship
in its own right, although the accessor will return a resultset or collection
sub related_resultset {
my $self = shift;
- $self->throw_exception("Can't call *_related as class methods") unless ref $self;
+ $self->throw_exception("Can't call *_related as class methods")
+ unless ref $self;
my $rel = shift;
my $rel_obj = $self->relationship_info($rel);
- $self->throw_exception( "No such relationship ${rel}" ) unless $rel_obj;
+ $self->throw_exception( "No such relationship ${rel}" )
+ unless $rel_obj;
return $self->{related_resultsets}{$rel} ||= do {
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
$attrs = { %{$rel_obj->{attrs} || {}}, %$attrs };
- $self->throw_exception( "Invalid query: @_" ) if (@_ > 1 && (@_ % 2 == 1));
+ $self->throw_exception( "Invalid query: @_" )
+ if (@_ > 1 && (@_ % 2 == 1));
my $query = ((@_ > 1) ? {@_} : shift);
- my $cond = $self->result_source->resolve_condition($rel_obj->{cond}, $rel, $self);
+ my $cond = $self->result_source->resolve_condition(
+ $rel_obj->{cond}, $rel, $self
+ );
if (ref $cond eq 'ARRAY') {
$cond = [ map { my $hash;
foreach my $key (keys %$_) {
}
}
$query = ($query ? { '-and' => [ $cond, $query ] } : $cond);
- $self->result_source->related_source($rel)->resultset->search($query, $attrs);
+ $self->result_source->related_source($rel)->resultset->search(
+ $query, $attrs
+ );
};
}
$obj->count_related('relname', $cond, $attrs);
-Returns the count of all the items in the related resultset, restricted by
-the current item or where conditions. Can be called on a L<DBIx::Classl::Manual::Glossary/"ResultSet"> or a L<DBIx::Class::Manual::Glossary/"Row"> object.
+Returns the count of all the items in the related resultset, restricted by the
+current item or where conditions. Can be called on a
+L<DBIx::Classl::Manual::Glossary/"ResultSet"> or a
+L<DBIx::Class::Manual::Glossary/"Row"> object.
=cut
my $rel_obj = $self->relationship_info($rel);
$self->throw_exception( "No such relationship ${rel}" ) unless $rel_obj;
my $cond = $rel_obj->{cond};
- $self->throw_exception( "set_from_related can only handle a hash condition; the "
- ."condition for $rel is of type ".(ref $cond ? ref $cond : 'plain scalar'))
- unless ref $cond eq 'HASH';
+ $self->throw_exception(
+ "set_from_related can only handle a hash condition; the ".
+ "condition for $rel is of type ".
+ (ref $cond ? ref $cond : 'plain scalar')
+ ) unless ref $cond eq 'HASH';
my $f_class = $self->result_source->schema->class($rel_obj->{class});
$self->throw_exception( "Object $f_obj isn't a ".$f_class )
unless $f_obj->isa($f_class);
use base 'DBIx::Class';
use Class::Inspector;
+=head1 NAME
+
+ DBIx::Class::ResultSetManager - helpful methods for managing
+ resultset classes (EXPERIMENTAL)
+
+=head1 SYNOPSIS
+
+ # in a table class
+ __PACKAGE__->load_components(qw/ResultSetManager Core/); # note order!
+ __PACKAGE__->load_resultset_components(qw/AlwaysRS/);
+
+ # will be removed from the table class and inserted into a
+ # table-specific resultset class
+ sub search_by_year_desc : ResultSet {
+ my $self = shift;
+ my $cond = shift;
+ my $attrs = shift || {};
+ $attrs->{order_by} = 'year DESC';
+ $self->next::method($cond, $attrs);
+ }
+
+ $rs = $schema->resultset('CD')->search_by_year_desc({ artist => 'Tool' });
+
+=head1 DESCRIPTION
+
+This package implements two useful features for customizing resultset
+classes. C<load_resultset_components> loads components in addition to
+C<DBIx::Class::ResultSet> (or whatever you set as
+C<base_resultset_class>). Any methods tagged with the C<ResultSet>
+attribute will be moved into a table-specific resultset class (by
+default called C<Class::_resultset>, but configurable via
+C<table_resultset_class_suffix>). Most of the magic is done when you
+call C<< __PACKAGE__->table >>.
+
+=cut
+
__PACKAGE__->mk_classdata($_)
for qw/ base_resultset_class table_resultset_class_suffix /;
__PACKAGE__->base_resultset_class('DBIx::Class::ResultSet');
1;
-__END__
-
-=head1 NAME
-
- DBIx::Class::ResultSetManager - helpful methods for managing
- resultset classes (EXPERIMENTAL)
-
-=head1 SYNOPSIS
-
- # in a table class
- __PACKAGE__->load_components(qw/ResultSetManager Core/); # note order!
- __PACKAGE__->load_resultset_components(qw/AlwaysRS/);
-
- # will be removed from the table class and inserted into a
- # table-specific resultset class
- sub search_by_year_desc : ResultSet {
- my $self = shift;
- my $cond = shift;
- my $attrs = shift || {};
- $attrs->{order_by} = 'year DESC';
- $self->next::method($cond, $attrs);
- }
-
- $rs = $schema->resultset('CD')->search_by_year_desc({ artist => 'Tool' });
-
-=head1 DESCRIPTION
-
-This package implements two useful features for customizing resultset
-classes. C<load_resultset_components> loads components in addition to
-C<DBIx::Class::ResultSet> (or whatever you set as
-C<base_resultset_class>). Any methods tagged with the C<ResultSet>
-attribute will be moved into a table-specific resultset class (by
-default called C<Class::_resultset>, but configurable via
-C<table_resultset_class_suffix>). Most of the magic is done when you
-call C<< __PACKAGE__->table >>.
-
=head1 AUTHORS
David Kamholz <dkamholz@cpan.org>
return shift->result_source_instance->columns(@_);
}
-sub set_primary_key { shift->result_source_instance->set_primary_key(@_); }
-sub primary_columns { shift->result_source_instance->primary_columns(@_); }
+sub set_primary_key {
+ shift->result_source_instance->set_primary_key(@_);
+}
+
+sub primary_columns {
+ shift->result_source_instance->primary_columns(@_);
+}
-sub add_unique_constraint { shift->result_source_instance->add_unique_constraint(@_); }
-sub unique_constraints { shift->result_source_instance->unique_constraints(@_); }
+sub add_unique_constraint {
+ shift->result_source_instance->add_unique_constraint(@_);
+}
+
+sub unique_constraints {
+ shift->result_source_instance->unique_constraints(@_);
+}
sub add_relationship {
my ($class, $rel, @rest) = @_;
=head2 load_classes
-=head3 Arguments: [<classes>, (<class>, <class>), {<namespace> => [<classes>]}]
+=head3 Arguments: @classes?, { $namespace => [ $class+ ] }+
Uses L<Module::Find> to find all classes under the database class' namespace,
or uses the classes you select. Then it loads the component (using L<use>),
}
} else {
eval "require Module::Find;";
- $class->throw_exception("No arguments to load_classes and couldn't load".
- " Module::Find ($@)") if $@;
- my @comp = map { substr $_, length "${class}::" } Module::Find::findallmod($class);
+ $class->throw_exception(
+ "No arguments to load_classes and couldn't load Module::Find ($@)"
+ ) if $@;
+ my @comp = map { substr $_, length "${class}::" }
+ Module::Find::findallmod($class);
$comps_for{$class} = \@comp;
}
my ($self, $target, @info) = @_;
my $base = 'DBIx::Class::ResultSetProxy';
eval "require ${base};";
- $self->throw_exception("No arguments to load_classes and couldn't load".
- " ${base} ($@)") if $@;
+ $self->throw_exception
+ ("No arguments to load_classes and couldn't load ${base} ($@)")
+ if $@;
if ($self eq $target) {
# Pathological case, largely caused by the docs on early C::M::DBIC::Plain
$storage_class = 'DBIx::Class::Storage'.$storage_class
if $storage_class =~ m/^::/;
eval "require ${storage_class};";
- $self->throw_exception("No arguments to load_classes and couldn't load".
- " ${storage_class} ($@)") if $@;
+ $self->throw_exception(
+ "No arguments to load_classes and couldn't load ${storage_class} ($@)"
+ ) if $@;
my $storage = $storage_class->new;
$storage->connect_info(\@info);
$self->storage($storage);
=head2 txn_do
-=head3 Arguments: <$coderef>, [@coderef_args]
+=head3 Arguments: $coderef, @coderef_args?
Executes C<$coderef> with (optional) arguments C<@coderef_args>
transactionally, returning its result (if any). If an exception is
$self->throw_exception($error) # propagate nested rollback
if $rollback_error =~ /$exception_class/;
- $self->throw_exception("Transaction aborted: $error. Rollback failed: ".
- $rollback_error);
+ $self->throw_exception(
+ "Transaction aborted: $error. Rollback failed: ${rollback_error}"
+ );
} else {
$self->throw_exception($error); # txn failed but rollback succeeded
}
my ($self, $table, $fields, $where, $order, @rest) = @_;
@rest = (-1) unless defined $rest[0];
local $self->{having_bind} = [];
- my ($sql, @ret) = $self->SUPER::select($table,
- $self->_recurse_fields($fields), $where, $order, @rest);
+ my ($sql, @ret) = $self->SUPER::select(
+ $table, $self->_recurse_fields($fields), $where, $order, @rest
+ );
return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
}
sub _make_as {
my ($self, $from) = @_;
return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ : $self->_quote($_)) }
- reverse each %{$self->_skip_options($from)});
+ reverse each %{$self->_skip_options($from)});
}
sub _skip_options {
my ($self, $cond) = @_;
if (ref $cond eq 'HASH') {
my %j;
- for (keys %$cond) { my $x = '= '.$self->_quote($cond->{$_}); $j{$_} = \$x; };
+ for (keys %$cond) {
+ my $x = '= '.$self->_quote($cond->{$_}); $j{$_} = \$x;
+ };
return $self->_recurse_where(\%j);
} elsif (ref $cond eq 'ARRAY') {
return join(' OR ', map { $self->_join_condition($_) } @$cond);
$new->transaction_depth(0);
if (defined($ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}) &&
($ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} =~ /=(.+)$/)) {
- $new->debugfh(IO::File->new($1, 'w')) || $new->throw_exception("Cannot open trace file $1");
+ $new->debugfh(IO::File->new($1, 'w'))
+ or $new->throw_exception("Cannot open trace file $1");
} else {
$new->debugfh(IO::File->new('>&STDERR'));
}
@bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
my $rv;
if ($sth) {
- $rv = $sth->execute(@bind) or $self->throw_exception("Error executing '$sql': " . $sth->errstr);
+ $rv = $sth->execute(@bind)
+ or $self->throw_exception("Error executing '$sql': " . $sth->errstr);
} else {
$self->throw_exception("'$sql' did not generate a statement.");
}
sub insert {
my ($self, $ident, $to_insert) = @_;
- $self->throw_exception( "Couldn't insert ".join(', ', map "$_ => $to_insert->{$_}", keys %$to_insert)." into ${ident}" )
- unless ($self->_execute('insert' => [], $ident, $to_insert));
+ $self->throw_exception(
+ "Couldn't insert ".join(', ',
+ map "$_ => $to_insert->{$_}", keys %$to_insert
+ )." into ${ident}"
+ ) unless ($self->_execute('insert' => [], $ident, $to_insert));
return $to_insert;
}
$order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
}
if (exists $attrs->{group_by} || $attrs->{having}) {
- $order = { group_by => $attrs->{group_by},
- having => $attrs->{having},
- ($order ? (order_by => $order) : ()) };
+ $order = {
+ group_by => $attrs->{group_by},
+ having => $attrs->{having},
+ ($order ? (order_by => $order) : ())
+ };
}
my @args = ('select', $attrs->{bind}, $ident, $select, $condition, $order);
if ($attrs->{software_limit} ||
sub deploy {
my ($self, $schema, $type, $sqltargs) = @_;
- foreach(split(";\n", $self->deployment_statements($schema, $type, $sqltargs))) {
- $self->debugfh->print("$_\n") if $self->debug;
- $self->dbh->do($_) or warn "SQL was:\n $_";
+ my @statements = $self->deployment_statements($schema, $type, $sqltargs);
+ foreach(split(";\n", @statements)) {
+ $self->debugfh->print("$_\n") if $self->debug;
+ $self->dbh->do($_) or warn "SQL was:\n $_";
}
}
projects / dbsrgits/DBIx-Class.git / commitdiff