1;
-=head1 NAME
+=head1 NAME
DBIx::Class - Extensible and flexible object <-> relational mapper.
DBIx::Class can handle multi-column primary and foreign keys, complex
queries and database-level paging, and does its best to only query the
-database in order to return something you've directly asked for. If a
-resultset is used as an iterator it only fetches rows off the statement
-handle as requested in order to minimise memory usage. It has auto-increment
+database in order to return something you've directly asked for. If a
+resultset is used as an iterator it only fetches rows off the statement
+handle as requested in order to minimise memory usage. It has auto-increment
support for SQLite, MySQL, PostgreSQL, Oracle, SQL Server and DB2 and is
known to be used in production on at least the first four, and is fork-
-and thread-safe out of the box (although your DBD may not be).
+and thread-safe out of the box (although your DBD may not be).
This project is still under rapid development, so features added in the
latest major release may not work 100% yet -- check the Changes if you run
use Carp::Clan qw/^DBIx::Class/;
-=head1 NAME
+=head1 NAME
DBIx::Class::AccessorGroup - Lets you build groups of accessors
return $self->{$get};
} else {
$get = "_$get";
- return $self->can($get) ? $self->$get : undef;
+ return $self->can($get) ? $self->$get : undef;
}
}
} else {
$set = "_$set";
return $self->can($set) ?
- $self->$set($val) :
- $self->mk_classdata($set => $val);
- }
+ $self->$set($val) :
+ $self->mk_classdata($set => $val);
+ }
}
1;
#DBIx::Class::ObjIndexStubs
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::CDBICompat - Class::DBI Compatibility layer.
DBIx::Class features a fully featured compatibility layer with L<Class::DBI>
to ease transition for existing CDBI users. In fact, this class is just a
receipe containing all the features emulated. If you like, you can choose
-which features to emulate by building your own class and loading it like
+which features to emulate by building your own class and loading it like
this:
__PACKAGE__->load_own_components(qw/CDBICompat/);
-this will automatically load the features included in My::DB::CDBICompat,
+this will automatically load the features included in My::DB::CDBICompat,
provided it looks something like this:
package My::DB::CDBICompat;
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::CDBICompat::AttributeAPI;
use strict;
sub has_many {
my ($class, $rel, $f_class, $f_key, @rest) = @_;
- return $class->next::method($rel, $f_class, ( ref($f_key) ?
- $f_key :
+ return $class->next::method($rel, $f_class, ( ref($f_key) ?
+ $f_key :
lc($f_key) ), @rest);
}
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::CDBICompat::ColumnGroups;
use strict;
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::CDBICompat::GetSet;
use strict;
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::CDBICompat::LiveObjectIndex;
use strict;
-package # hide from PAUSE\r
- DBIx::Class::CDBICompat::Pager;\r
+package # hide from PAUSE
+ DBIx::Class::CDBICompat::Pager;
\r
-use strict;\r
-use warnings FATAL => 'all';\r
+use strict;
+use warnings FATAL => 'all';
\r
-*pager = \&page;\r
+*pager = \&page;
\r
-sub page {\r
- my $class = shift;\r
+sub page {
+ my $class = shift;
\r
- my $rs = $class->search(@_);\r
- unless ($rs->{page}) {\r
- $rs = $rs->page(1);\r
- }\r
- return ( $rs->pager, $rs );\r
-}\r
+ my $rs = $class->search(@_);
+ unless ($rs->{page}) {
+ $rs = $rs->page(1);
+ }
+ return ( $rs->pager, $rs );
+}
\r
-1;\r
+1;
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::CDBICompat::Stringify;
use strict;
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::CDBICompat::TempColumns;
use strict;
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::Componentised;
use strict;
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::Core - Core set of DBIx::Class modules
return $source->resultset;
}
-=head1 NAME
+=head1 NAME
DBIx::Class::DB - Non-recommended classdata schema component
****DEPRECATED****
-Sets or gets the class to use for resolving a class. Defaults to
+Sets or gets the class to use for resolving a class. Defaults to
L<DBIx::Class::ClassResolver::Passthrough>, which returns whatever you give
it. See resolve_class below.
use base qw/DBIx::Class::Row/;
-=head1 NAME
+=head1 NAME
DBIx::Class::InflateColumn - Automatically create objects from column data
for the database.
It can be used, for example, to automatically convert to and from
-L<DateTime> objects for your date and time fields.
+L<DateTime> objects for your date and time fields.
=head1 METHODS
=head2 inflate_column
-Instruct L<DBIx::Class> to inflate the given column.
+Instruct L<DBIx::Class> to inflate the given column.
In addition to the column name, you must provide C<inflate> and
C<deflate> methods. The C<inflate> method is called when you access
use base qw/DBIx::Class::Row/;
-=head1 NAME
+=head1 NAME
DBIx::Class::PK - Primary Key class
=head1 DESCRIPTION
-This class contains methods for handling primary keys and methods
+This class contains methods for handling primary keys and methods
depending on them.
=head1 METHODS
=head2 ID
Returns a unique id string identifying a row object by primary key.
-Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
+Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
L<DBIx::Class::ObjectCache>.
=cut
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;
+ map { $_ . '=' . $vals{$_} } sort keys %vals;
}
sub ident_condition {
use strict;
use warnings;
-=head1 NAME
+=head1 NAME
DBIx::Class::PK::Auto - Automatic primary key class
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::PK::Auto::DB2 - (DEPRECATED) Automatic primary key class for DB2
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::PK::Auto::MSSQL - (DEPRECATED) Automatic primary key class for MSSQL
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::PK::Auto::MySQL - (DEPRECATED) Automatic primary key class for MySQL
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::PK::Auto::Oracle - (DEPRECATED) Automatic primary key class for Oracle
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::PK::Auto::Pg - (DEPRECATED) Automatic primary key class for Pg
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::PK::Auto::SQLite - (DEPRECATED) Automatic primary key class for SQLite
Base
/);
-=head1 NAME
+=head1 NAME
DBIx::Class::Relationship - Inter-table relationships
=head1 SYNOPSIS
- MyDB::Schema::Actor->has_many('actorroles' => 'MyDB::Schema::ActorRole',
+ MyDB::Schema::Actor->has_many('actorroles' => 'MyDB::Schema::ActorRole',
'actor');
- MyDB::Schema::Role->has_many('actorroles' => 'MyDB::Schema::ActorRole',
+ MyDB::Schema::Role->has_many('actorroles' => 'MyDB::Schema::ActorRole',
'role');
MyDB::Schema::ActorRole->belongs_to('role' => 'MyDB::Schema::Role');
MyDB::Schema::ActorRole->belongs_to('actor' => 'MyDB::Schema::Actor');
my $fredsbooks = $schema->resultset('Author')->find({ Name => 'Fred' })->books;
-Each relationship sets up an accessor method on the
+Each relationship sets up an accessor method on the
L<DBIx::Class::Manual::Glossary/"Row"> objects that represent the items
of your table. From L<DBIx::Class::Manual::Glossary/"ResultSet"> objects,
-the relationships can be searched using the "search_related" method.
+the relationships can be searched using the "search_related" method.
In list context, each returns a list of Row objects for the related class,
in scalar context, a new ResultSet representing the joined tables is
returned. Thus, the calls can be chained to produce complex queries.
will produce a query something like:
- SELECT * FROM Author me
+ SELECT * FROM Author me
LEFT JOIN Books books ON books.author = me.id
LEFT JOIN Prices prices ON prices.book = books.id
WHERE prices.Price <= 5.00
my $author_obj = $obj->author;
$obj->author($new_author_obj);
-Creates a relationship where the calling class stores the foreign class's
+Creates a relationship where the calling class stores the foreign class's
primary key in one (or more) of its columns. If $cond is a column name
instead of a join condition hash, that is used as the name of the column
holding the foreign key. If $cond is not given, the relname is used as
=head2 might_have
- My::DBIC::Schema::Author->might_have(pseudonym =>
+ My::DBIC::Schema::Author->might_have(pseudonym =>
'My::DBIC::Schema::Pseudonyms');
my $pname = $obj->pseudonym; # to get the Pseudonym object
=head2 many_to_many
- My::DBIC::Schema::Actor->has_many( actor_roles =>
+ My::DBIC::Schema::Actor->has_many( actor_roles =>
'My::DBIC::Schema::ActorRoles',
'actor' );
- My::DBIC::Schema::ActorRoles->belongs_to( role =>
+ My::DBIC::Schema::ActorRoles->belongs_to( role =>
'My::DBIC::Schema::Role' );
- My::DBIC::Schema::ActorRoles->belongs_to( actor =>
+ My::DBIC::Schema::ActorRoles->belongs_to( actor =>
'My::DBIC::Schema::Actor' );
My::DBIC::Schema::Actor->many_to_many( roles => 'actor_roles',
in its own right, although the accessor will return a resultset or collection
of objects just as a has_many would.
To use many_to_many, existing relationships from the original table to the link
-table, and from the link table to the end table must already exist, these
+table, and from the link table to the end table must already exist, these
relation names are then used in the many_to_many call.
=cut
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::Relationship::Accessor;
use strict;
use base qw/DBIx::Class/;
-=head1 NAME
+=head1 NAME
DBIx::Class::Relationship::Base - Inter-table relationships
This class provides methods to describe the relationships between the
tables in your database model. These are the "bare bones" relationships
-methods, for predefined ones, look in L<DBIx::Class::Relationship>.
+methods, for predefined ones, look in L<DBIx::Class::Relationship>.
=head1 METHODS
my ($pri, $too_many) = keys %f_primaries;
$class->throw_exception("Can't infer join condition for ${rel} on ${class}; ${f_class} has no primary keys")
- unless defined $pri;
+ unless defined $pri;
$class->throw_exception("Can't infer join condition for ${rel} on ${class}; ${f_class} has multiple primary keys")
- if $too_many;
+ if $too_many;
my $fk = defined $cond ? $cond : $rel;
$class->throw_exception("Can't infer join condition for ${rel} on ${class}; $fk is not a column")
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::Relationship::HasMany;
use strict;
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::Relationship::ManyToMany;
use strict;
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::Relationship::ProxyMethods;
use strict;
=head1 METHODS
-=head2 new
+=head2 new
=over 4
return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
} else {
return keys %{$self->{collapse}} ?
- $self->search($query)->next :
- $self->single($query);
+ $self->search($query)->next :
+ $self->single($query);
}
}
if ($where) {
if (defined $attrs->{where}) {
$attrs->{where} = {
- '-and' =>
+ '-and' =>
[ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
$where, delete $attrs->{where} ]
};
return ($self->all)[0];
}
my @row = (exists $self->{stashed_row} ?
- @{delete $self->{stashed_row}} :
- $self->cursor->next
+ @{delete $self->{stashed_row}} :
+ $self->cursor->next
);
# warn Dumper(\@row); use Data::Dumper;
return unless (@row);
my @collapse;
if (defined $prefix) {
@collapse = map {
- m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
+ m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
} keys %{$self->{collapse}}
} else {
@collapse = keys %{$self->{collapse}};
my (@final, @raw);
while ( !(grep {
!defined($tree->[0]->{$_}) ||
- $co_check{$_} ne $tree->[0]->{$_}
+ $co_check{$_} ne $tree->[0]->{$_}
} @co_key) ) {
push(@final, $tree);
last unless (@raw = $self->cursor->next);
@distinct = ($column);
last;
}
- }
+ }
}
$select = { count => { distinct => \@distinct } };
=back
-Contains one or more relationships that should be fetched along with the main
+Contains one or more relationships that should be fetched along with the main
query (when they are accessed afterwards they will have already been
"prefetched"). This is useful for when you know you will need the related
objects, because it saves at least one query:
... do stuff ...
}
- $rs->first; # without cache, this would issue a query
+ $rs->first; # without cache, this would issue a query
By default, searches are not cached.
use base 'DBIx::Class';
use Class::Inspector;
-=head1 NAME
+=head1 NAME
DBIx::Class::ResultSetManager - helpful methods for managing
resultset classes (EXPERIMENTAL)
my $ret = $self->next::method(@rest);
if (@rest) {
$self->_register_attributes;
- $self->_register_resultset_class;
+ $self->_register_resultset_class;
}
return $ret;
}
$self->result_source_instance->resultset_class($resultset_class);
} else {
$self->result_source_instance->resultset_class
- ($self->base_resultset_class);
+ ($self->base_resultset_class);
}
}
__PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
result_class/);
-=head1 NAME
+=head1 NAME
DBIx::Class::ResultSource - Result source object
=over 4
-=item accessor
+=item accessor
Use this to set the name of the accessor for this column. If unset,
the name of the column will be used.
=item size
The length of your column, if it is a column type that can have a size
-restriction. This is currently not used by DBIx::Class.
+restriction. This is currently not used by DBIx::Class.
=item is_nullable
Set this to the default value which will be inserted into a column
by the database. Can contain either a value or a function. This is
-currently not used by DBIx::Class.
+currently not used by DBIx::Class.
=item sequence
sub column_info {
my ($self, $column) = @_;
- $self->throw_exception("No such column $column")
+ $self->throw_exception("No such column $column")
unless exists $self->_columns->{$column};
#warn $self->{_columns_info_loaded}, "\n";
- if ( ! $self->_columns->{$column}{data_type}
- and ! $self->{_columns_info_loaded}
+ if ( ! $self->_columns->{$column}{data_type}
+ and ! $self->{_columns_info_loaded}
and $self->schema and $self->storage )
{
$self->{_columns_info_loaded}++;
my $info;
- # eval for the case of storage without table
+ # eval for the case of storage without table
eval { $info = $self->storage->columns_info_for($self->from) };
unless ($@) {
foreach my $col ( keys %{$self->_columns} ) {
Additionally, defines a unique constraint named C<primary>.
The primary key columns are used by L<DBIx::Class::PK::Auto> to
-retrieve automatically created values from the database.
+retrieve automatically created values from the database.
=cut
=head2 storage
-Returns the storage handle for the current schema.
+Returns the storage handle for the current schema.
See also: L<DBIx::Class::Storage>
=item accessor
Specifies the type of accessor that should be created for the
-relationship. Valid values are C<single> (for when there is only a single
-related object), C<multi> (when there can be many), and C<filter> (for
-when there is a single related object, but you also want the relationship
-accessor to double as a column accessor). For C<multi> accessors, an
-add_to_* method is also created, which calls C<create_related> for the
+relationship. Valid values are C<single> (for when there is only a single
+related object), C<multi> (when there can be many), and C<filter> (for
+when there is a single related object, but you also want the relationship
+accessor to double as a column accessor). For C<multi> accessors, an
+add_to_* method is also created, which calls C<create_related> for the
relationship.
=back
eval { $self->resolve_join($rel, 'me') };
if ($@) { # If the resolve failed, back out and re-throw the error
- delete $rels{$rel}; #
+ delete $rels{$rel}; #
$self->_relationships(\%rels);
$self->throw_exception("Error creating relationship $rel: $@");
}
sub relationship_info {
my ($self, $rel) = @_;
return $self->_relationships->{$rel};
-}
+}
=head2 has_relationship
while (my ($k, $v) = each %{$cond}) {
# XXX should probably check these are valid columns
$k =~ s/^foreign\.// ||
- $self->throw_exception("Invalid rel cond key ${k}");
+ $self->throw_exception("Invalid rel cond key ${k}");
$v =~ s/^self\.// ||
- $self->throw_exception("Invalid rel cond val ${v}");
+ $self->throw_exception("Invalid rel cond val ${v}");
if (ref $for) { # Object
#warn "$self $k $for $v";
$ret{$k} = $for->get_column($v);
# 'artist.name',
# 'producer.producerid',
# 'producer.name'
- #)
+ #)
=cut
sub throw_exception {
my $self = shift;
- if (defined $self->schema) {
+ if (defined $self->schema) {
$self->schema->throw_exception(@_);
} else {
croak(@_);
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/ResultSource/);
-=head1 NAME
+=head1 NAME
DBIx::Class::ResultSource::Table - Table object
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::ResultSourceProxy;
use strict;
}
}
-sub has_column {
- my ($self, $column) = @_;
- return $self->result_source_instance->has_column($column);
+sub has_column {
+ my ($self, $column) = @_;
+ return $self->result_source_instance->has_column($column);
}
-sub column_info {
- my ($self, $column) = @_;
- return $self->result_source_instance->column_info($column);
+sub column_info {
+ my ($self, $column) = @_;
+ return $self->result_source_instance->column_info($column);
}
-sub columns {
- return shift->result_source_instance->columns(@_);
-}
+sub columns {
+ return shift->result_source_instance->columns(@_);
+}
sub set_primary_key {
shift->result_source_instance->set_primary_key(@_);
__PACKAGE__->table_class('DBIx::Class::ResultSource::Table');
__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do
- # anything yet!
+ # anything yet!
-=head1 NAME
+=head1 NAME
DBIx::Class::ResultSourceProxy::Table - provides a classdata table
object and method proxies
unless (ref $table) {
$table = $class->table_class->new({
$class->can('result_source_instance') ?
- %{$class->result_source_instance} : (),
+ %{$class->result_source_instance} : (),
name => $table,
result_class => $class,
});
Returns the column metadata hashref for a column. For a description of
the various types of column data in this hashref, see
-L<DBIx::Class::ResultSource/add_column>
+L<DBIx::Class::ResultSource/add_column>
=cut
__PACKAGE__->mk_group_accessors('simple' => 'result_source');
-=head1 NAME
+=head1 NAME
DBIx::Class::Row - Basic row methods
unless ref($attrs) eq 'HASH';
while (my ($k, $v) = each %$attrs) {
$new->throw_exception("No such column $k on $class")
- unless $class->has_column($k);
+ unless $class->has_column($k);
$new->store_column($k => $v);
}
}
$obj->delete
-Deletes the object from the database. The object is still perfectly usable,
-but ->in_storage() will now return 0 and the object must re inserted using
+Deletes the object from the database. The object is still perfectly usable,
+but ->in_storage() will now return 0 and the object must re inserted using
->insert() before ->update() can be used on it.
=cut
$self->throw_exception("Cannot safely delete a row in a PK-less table")
if ! keys %$ident_cond;
foreach my $column (keys %$ident_cond) {
- $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
- unless exists $self->{_column_data}{$column};
+ $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
+ unless exists $self->{_column_data}{$column};
}
$self->result_source->storage->delete(
$self->result_source->from, $ident_cond);
sub store_column {
my ($self, $column, $value) = @_;
- $self->throw_exception( "No such column '${column}'" )
+ $self->throw_exception( "No such column '${column}'" )
unless exists $self->{_column_data}{$column} || $self->has_column($column);
- $self->throw_exception( "set_column called for ${column} without value" )
+ $self->throw_exception( "set_column called for ${column} without value" )
if @_ < 3;
return $self->{_column_data}{$column} = $value;
}
if (ref($pre_val->[0]) eq 'ARRAY') { # multi
my @pre_objects;
foreach my $pre_rec (@$pre_val) {
- unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
+ unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
next;
}
$new->related_resultset($pre)->set_cache(\@pre_objects);
} elsif (defined $pre_val->[0]) {
my $fetched;
- unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
+ unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
{
$fetched = $pre_source->result_class->inflate_result(
- $pre_source, @{$pre_val});
+ $pre_source, @{$pre_val});
}
my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
$class->throw_exception("No accessor for prefetched $pre")
$map{$source->result_class} = $moniker;
$self->class_mappings(\%map);
}
-}
+}
=head2 class
Example:
My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
- # etc. (anything under the My::Schema namespace)
+ # etc. (anything under the My::Schema namespace)
# loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
# not Other::Namespace::LinerNotes nor My::Schema::Track
my $comp_class = "${prefix}::${comp}";
eval "use $comp_class"; # If it fails, assume the user fixed it
if ($@) {
- $comp_class =~ s/::/\//g;
+ $comp_class =~ s/::/\//g;
die $@ unless $@ =~ /Can't locate.+$comp_class\.pm\sin\s\@INC/;
- warn $@ if $@;
+ warn $@ if $@;
}
push(@to_register, [ $comp, $comp_class ]);
}
$self->txn_begin; # If this throws an exception, no rollback is needed
my $wantarray = wantarray; # Need to save this since the context
- # inside the eval{} block is independent
- # of the context that called txn_do()
+ # inside the eval{} block is independent
+ # of the context that called txn_do()
eval {
# Need to differentiate between scalar/list context to allow for
my $rollback_error = $@;
my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
$self->throw_exception($error) # propagate nested rollback
- if $rollback_error =~ /$exception_class/;
+ if $rollback_error =~ /$exception_class/;
$self->throw_exception(
"Transaction aborted: $error. Rollback failed: ${rollback_error}"
=head2 throw_exception
-=over 4
+=over 4
=item Arguments: $message
__END__
-=head1 NAME
+=head1 NAME
DBIx::Class::Serialize::Storable - hooks for Storable freeze/thaw
-package # hide from PAUSE
+package # hide from PAUSE
DBIx::Class::Storage;
use strict;
croak($msg);
}
-=head1 NAME
+=head1 NAME
DBIx::Class::Storage::DBI - DBI storage handler
$self->dbh->commit unless $self->dbh->{AutoCommit};
}
else {
- $self->dbh->commit if --$self->{transaction_depth} == 0;
+ $self->dbh->commit if --$self->{transaction_depth} == 0;
}
}
$self->throw_exception("no sth generated via sql: $sql") unless $sth;
@bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
my $rv;
- if ($sth) {
+ if ($sth) {
$rv = $sth->execute(@bind)
or $self->throw_exception("Error executing '$sql': " . $sth->errstr);
- } else {
+ } else {
$self->throw_exception("'$sql' did not generate a statement.");
}
return (wantarray ? ($rv, $sth, @bind) : $rv);
eval "use SQL::Translator";
$self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
eval "use SQL::Translator::Parser::DBIx::Class;";
- $self->throw_exception($@) if $@;
+ $self->throw_exception($@) if $@;
eval "use SQL::Translator::Producer::${type};";
$self->throw_exception($@) if $@;
my $tr = SQL::Translator->new(%$sqltargs);
foreach(split(";\n", @statements)) {
$self->debugfh->print("$_\n") if $self->debug;
$self->dbh->do($_) or warn "SQL was:\n $_";
- }
+ }
}
sub DESTROY { shift->disconnect }
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::Storage::DBI::DB2 - Automatic primary key class for DB2
-package DBIx::Class::Storage::DBI::MSSQL;\r
+package DBIx::Class::Storage::DBI::MSSQL;
\r
-use strict;\r
-use warnings;\r
+use strict;
+use warnings;
\r
-use base qw/DBIx::Class::Storage::DBI/;\r
+use base qw/DBIx::Class::Storage::DBI/;
\r
-# __PACKAGE__->load_components(qw/PK::Auto/);\r
+# __PACKAGE__->load_components(qw/PK::Auto/);
\r
-sub last_insert_id {\r
- my( $id ) = $_[0]->_dbh->selectrow_array('SELECT @@IDENTITY' );\r
- return $id;\r
-}\r
+sub last_insert_id {
+ my( $id ) = $_[0]->_dbh->selectrow_array('SELECT @@IDENTITY' );
+ return $id;
+}
\r
-1;\r
+1;
\r
-=head1 NAME \r
+=head1 NAME
\r
-DBIx::Class::Storage::DBI::MSSQL - Automatic primary key class for MSSQL\r
+DBIx::Class::Storage::DBI::MSSQL - Automatic primary key class for MSSQL
\r
-=head1 SYNOPSIS\r
+=head1 SYNOPSIS
\r
- # In your table classes\r
- __PACKAGE__->load_components(qw/PK::Auto Core/);\r
- __PACKAGE__->set_primary_key('id');\r
+ # In your table classes
+ __PACKAGE__->load_components(qw/PK::Auto Core/);
+ __PACKAGE__->set_primary_key('id');
\r
-=head1 DESCRIPTION\r
+=head1 DESCRIPTION
\r
-This class implements autoincrements for MSSQL.\r
+This class implements autoincrements for MSSQL.
\r
-=head1 AUTHORS\r
+=head1 AUTHORS
\r
-Brian Cassidy <bricas@cpan.org>\r
+Brian Cassidy <bricas@cpan.org>
\r
-=head1 LICENSE\r
+=head1 LICENSE
\r
-You may distribute this code under the same terms as Perl itself.\r
+You may distribute this code under the same terms as Perl itself.
\r
-=cut\r
+=cut
my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
my $sql = "SELECT " . $seq . ".currval FROM DUAL";
my ($id) = $self->_dbh->selectrow_array($sql);
- return $id;
+ return $id;
}
sub get_autoinc_seq {
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::Storage::DBI::Oracle - Automatic primary key class for Oracle
: (undef,$source->name);
while (my $col = shift @pri) {
my $info = $dbh->column_info(undef,$schema,$table,$col)->fetchrow_arrayref;
- if (defined $info->[12] and $info->[12] =~
+ if (defined $info->[12] and $info->[12] =~
/^nextval\(+'([^']+)'::(?:text|regclass)\)/)
{
return $1; # may need to strip quotes -- see if this works
- }
+ }
}
}
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::PK::Auto::SQLite - Automatic primary key class for SQLite
1;
-=head1 NAME
+=head1 NAME
DBIx::Class::Storage::DBI::mysql - Automatic primary key class for MySQL
=head1 SYNOPSIS
- use base 'DBIx::Class::Test::SQLite';
-
- __PACKAGE__->set_table('test');
- __PACKAGE__->columns(All => qw/id name film salary/);
-
- sub create_sql {
- return q{
- id INTEGER PRIMARY KEY,
- name CHAR(40),
- film VARCHAR(255),
- salary INT
- }
- }
-
+ use base 'DBIx::Class::Test::SQLite';
+
+ __PACKAGE__->set_table('test');
+ __PACKAGE__->columns(All => qw/id name film salary/);
+
+ sub create_sql {
+ return q{
+ id INTEGER PRIMARY KEY,
+ name CHAR(40),
+ film VARCHAR(255),
+ salary INT
+ }
+ }
+
=head1 DESCRIPTION
This provides a simple base class for DBIx::Class::CDBICompat tests using
=head2 set_table
- __PACKAGE__->set_table('test');
+ __PACKAGE__->set_table('test');
This combines creating the table with the normal DBIx::Class table()
call.
=cut
sub set_table {
- my ($class, $table) = @_;
- $class->table($table);
- $class->_create_test_table;
+ my ($class, $table) = @_;
+ $class->table($table);
+ $class->_create_test_table;
}
sub _create_test_table {
- my $class = shift;
- my @vals = $class->sql__table_pragma->select_row;
- $class->sql__create_me($class->create_sql)->execute unless @vals;
+ my $class = shift;
+ my @vals = $class->sql__table_pragma->select_row;
+ $class->sql__create_me($class->create_sql)->execute unless @vals;
}
=head2 create_sql
This is an abstract method you must override.
- sub create_sql {
- return q{
- id INTEGER PRIMARY KEY,
- name CHAR(40),
- film VARCHAR(255),
- salary INT
- }
- }
+ sub create_sql {
+ return q{
+ id INTEGER PRIMARY KEY,
+ name CHAR(40),
+ film VARCHAR(255),
+ salary INT
+ }
+ }
This should return, as a text string, the schema for the table represented
by this class.
sub uuid_columns {
my $self = shift;
for (@_) {
- $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_);
+ $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_);
}
$self->uuid_auto_columns(\@_);
}
sub insert {
my $self = shift;
for my $column (@{$self->uuid_auto_columns}) {
- $self->store_column( $column, $self->get_uuid )
- unless defined $self->get_column( $column );
+ $self->store_column( $column, $self->get_uuid )
+ unless defined $self->get_column( $column );
}
$self->next::method(@_);
}
auto => 1,
);
-Calls validation_module(), validation_profile(), and validation_auto() if the corresponding
+Calls validation_module(), validation_profile(), and validation_auto() if the corresponding
argument is defined.
=head2 validation_module
__PACKAGE__->validation_module('Data::FormValidator');
-Sets the validation module to use. Any module that supports a check() method just like
+Sets the validation module to use. Any module that supports a check() method just like
Data::FormValidator's can be used here, such as FormValidator::Simple.
Defaults to FormValidator::Simple.
__PACKAGE__->validation_auto( 1 );
-This flag, when enabled, causes any updates or inserts of the class
+This flag, when enabled, causes any updates or inserts of the class
to call validate() before actually executing.
=head2 validate
$obj->validate();
-Validates all the data in the object against the pre-defined validation
-module and profile. If there is a problem then a hard error will be
-thrown. If you put the validation in an eval you can capture whatever
+Validates all the data in the object against the pre-defined validation
+module and profile. If there is a problem then a hard error will be
+thrown. If you put the validation in an eval you can capture whatever
the module's check() method returned.
=head2 auto_validate
__PACKAGE__->auto_validate( 0 );
-Turns on and off auto-validation. This feature makes all UPDATEs and
-INSERTs call the validate() method before doing anything. The default
+Turns on and off auto-validation. This feature makes all UPDATEs and
+INSERTs call the validate() method before doing anything. The default
is for auto-validation to be on.
Defaults to on.
-package # hide from PAUSE
+package # hide from PAUSE
SQL::Translator::Parser::DBIx::Class;
# AUTHOR: Jess Robinson
my ($refkey) = $cond =~ /^\w+\.(\w+)$/;
my ($key) = $rel_info->{cond}->{$cond} =~ /^\w+\.(\w+)$/;
if($rel_table && $refkey)
- {
+ {
$table->add_constraint(
- type => 'foreign_key',
+ type => 'foreign_key',
name => "fk_${key}",
fields => $key,
reference_fields => $refkey,
}
}
-}
+}
1;
use SQL::Translator;
- my $t = SQL::Translator->new( parser => '...',
+ my $t = SQL::Translator->new( parser => '...',
producer => 'DBIx::Class::File' );
print $translator->translate( $file );
my $output = '';
# Steal the XML producers "prefix" arg for our namespace?
- my $dbixschema = $translator->producer_args()->{prefix} ||
+ my $dbixschema = $translator->producer_args()->{prefix} ||
$schema->name || 'My::Schema';
my $pkclass = $parser2PK{$translator->parser_type} || '';
};
- my @fields = map
+ my @fields = map
{ { $_->name => {
name => $_->name,
is_auto_increment => $_->is_auto_increment,
{
local $Data::Dumper::Terse = 1;
$output .= "\n '" . (keys %$f)[0] . "' => " ;
- my $colinfo =
+ my $colinfo =
Data::Dumper->Dump([values %$f],
[''] # keys %$f]
);
# print Data::Dumper::Dumper($cont->type);
if($cont->type =~ /foreign key/i)
{
-# $output .= "\n__PACKAGE__->belongs_to('" .
+# $output .= "\n__PACKAGE__->belongs_to('" .
# $cont->fields->[0]->name . "', '" .
# "${dbixschema}::" . $cont->reference_table . "');\n";
- $tableextras{$table->name} .= "\n__PACKAGE__->belongs_to('" .
+ $tableextras{$table->name} .= "\n__PACKAGE__->belongs_to('" .
$cont->fields->[0]->name . "', '" .
"${dbixschema}::" . $cont->reference_table . "');\n";
foreach my $to (keys %tableoutput)
{
$output .= $tableoutput{$to};
- $schemaoutput .= "\n__PACKAGE__->register_class('${to}', '${dbixschema}::${to}');\n";
+ $schemaoutput .= "\n__PACKAGE__->register_class('${to}', '${dbixschema}::${to}');\n";
}
foreach my $te (keys %tableextras)
projects / dbsrgits/DBIx-Class.git / commitdiff