Revision history for DBIx::Class
+0.08120 2010-02-24 08:58:00 (UTC)
- Make sure possibly overwritten deployment_statements methods in
schemas get called on $schema->deploy
- Fix count() with group_by aliased-function resultsets
+ - with_deferred_fk_checks() Oracle support
- Massive refactor and cleanup of primary key handling
- Fixed regression losing custom result_class (really this time)
(RT#54697)
- Fixed regression in DBIC SQLT::Parser failing with a classname
(as opposed to a schema object)
+ - Changes to Storage::DBI::Oracle to accomodate changes in latest
+ SQL::Translator (quote handling)
+ - Make sure deployment_statements is per-storage overridable
+ - Fix dbicadmin's (lack of) POD
0.08119 2010-02-15 09:36:00 (UTC)
- Add $rs->is_ordered to test for existing order_by on a resultset
unlink 'MANIFEST';
}
- print "Regenerating dbicadmin.pod\n";
- system('perl script/dbicadmin --pod > lib/dbicadmin.pod');
-
print "Regenerating Optional/Dependencies.pod\n";
require DBIx::Class::Optional::Dependencies;
DBIx::Class::Optional::Dependencies->_gen_pod;
# PodInherit();
}
+tests_recursive (qw|
+ t
+|);
+
install_script (qw|
script/dbicadmin
|);
-tests_recursive (qw|
- t
-|);
+
+### Mangle makefile - read the comments for more info
+#
+postamble <<"EOP";
+
+# This will add an extra dep-spec for the distdir target,
+# which `make` will fold together in a first-come first-serve
+# fashion. What we do here is essentially adding extra
+# commands to execute once the distdir is assembled (via
+# create_distdir), but before control is returned to a higher
+# calling rule.
+distdir : dbicadmin_pod_inject
+
+# The pod self-injection code is in fact a hidden option in
+# dbicadmin itself
+dbicadmin_pod_inject :
+\tcd \$(DISTVNAME) && \$(ABSPERL) -Ilib script/dbicadmin --selfinject-pod
+
+# Regenerate manifest before running create_distdir.
+create_distdir : manifest
+
+EOP
+
+
resources 'IRC' => 'irc://irc.perl.org/#dbix-class';
resources 'license' => 'http://dev.perl.org/licenses/';
# Deprecated/internal modules need no exposure
no_index directory => $_ for (qw|
+ lib/DBIx/Class/Admin
lib/DBIx/Class/SQLAHacks
lib/DBIx/Class/PK/Auto
+ lib/DBIx/Class/CDBICompat
|);
no_index package => $_ for (qw/
DBIx::Class::SQLAHacks DBIx::Class::Storage::DBIHacks
# Always remember to do all digits for the version even if they're 0
# i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
# brain damage and presumably various other packaging systems too
-$VERSION = '0.08119_1';
+$VERSION = '0.08120_1';
-$VERSION = eval $VERSION; # numify for warning-free dev releases
+$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
sub MODIFY_CODE_ATTRIBUTES {
my ($class,$code,@attrs) = @_;
}
-=head2 pod
-
-This returns the usage formated as a pod document
-
-=cut
-
+# This returns the usage formated as a pod document
sub pod {
my ($self) = @_;
return join qq{\n}, $self->pod_leader_text, $self->pod_option_text, $self->pod_authorlic_text;
sub pod_authorlic_text {
- return <<'EOA'
-=head1 AUTHORS
-
-See L<DBIx::Class/CONTRIBUTORS>
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself
-
-=cut
-EOA
+ return join ("\n\n",
+ '=head1 AUTHORS',
+ 'See L<DBIx::Class/CONTRIBUTORS>',
+ '=head1 LICENSE',
+ 'You may distribute this code under the same terms as Perl itself',
+ '=cut',
+ );
}
foreach my $opt (@options) {
my $spec = $opt->{spec};
my $desc = $opt->{desc};
+ next if ($desc eq 'hidden');
if ($desc eq 'spacer') {
$string .= "=back\n\n=head2 $spec\n\n=cut\n\n=over\n\n";
next;
deploy => {
req => {
- 'SQL::Translator' => '0.11002',
+ 'SQL::Translator' => '0.11005',
},
pod => {
title => 'Storage::DBI::deploy()',
# Each of these methods need _determine_driver called before itself
# in order to function reliably. This is a purely DRY optimization
my @rdbms_specific_methods = qw/
+ deployment_statements
sqlt_type
build_datetime_parser
datetime_parser_type
This hook is to allow specific L<DBIx::Class::Storage> drivers to change the
way these aliases are named.
-The default behavior is C<"$relname_$join_count" if $join_count > 1>, otherwise
-C<"$relname">.
+The default behavior is C<< "$relname_$join_count" if $join_count > 1 >>,
+otherwise C<"$relname">.
=cut
use base qw/DBIx::Class::Storage::DBI/;
use mro 'c3';
+sub deployment_statements {
+ my $self = shift;;
+ my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_;
+
+ $sqltargs ||= {};
+ my $quote_char = $self->schema->storage->sql_maker->quote_char;
+ $sqltargs->{quote_table_names} = $quote_char ? 1 : 0;
+ $sqltargs->{quote_field_names} = $quote_char ? 1 : 0;
+
+ my $oracle_version = eval { $self->_get_dbh->get_info(18) };
+
+ $sqltargs->{producer_args}{oracle_version} = $oracle_version;
+
+ $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest);
+}
+
sub _dbh_last_insert_id {
my ($self, $dbh, $source, @columns) = @_;
my @ids = ();
sub _dbh_get_autoinc_seq {
my ($self, $dbh, $source, $col) = @_;
- # look up the correct sequence automatically
- my $sql = q{
- SELECT trigger_body FROM ALL_TRIGGERS t
- WHERE t.table_name = ?
- AND t.triggering_event = 'INSERT'
- AND t.status = 'ENABLED'
- };
-
- # trigger_body is a LONG
- local $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
-
- my $sth;
+ my $sql_maker = $self->sql_maker;
my $source_name;
- if ( ref $source->name ne 'SCALAR' ) {
- $source_name = $source->name;
+ if ( ref $source->name eq 'SCALAR' ) {
+ $source_name = ${$source->name};
}
else {
- $source_name = ${$source->name};
+ $source_name = $source->name;
}
+ $source_name = uc($source_name) unless $sql_maker->quote_char;
+
+ # trigger_body is a LONG
+ local $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
+
+ # disable default bindtype
+ local $sql_maker->{bindtype} = 'normal';
+
+ # look up the correct sequence automatically
+ my ( $schema, $table ) = $source_name =~ /(\w+)\.(\w+)/;
+ my ($sql, @bind) = $sql_maker->select (
+ 'ALL_TRIGGERS',
+ ['trigger_body'],
+ {
+ $schema ? (owner => $schema) : (),
+ table_name => $table || $source_name,
+ triggering_event => 'INSERT',
+ status => 'ENABLED',
+ },
+ );
+ my $sth = $dbh->prepare($sql);
+ $sth->execute (@bind);
- # check for fully-qualified name (eg. SCHEMA.TABLENAME)
- if ( my ( $schema, $table ) = $source_name =~ /(\w+)\.(\w+)/ ) {
- $sql = q{
- SELECT trigger_body FROM ALL_TRIGGERS t
- WHERE t.owner = ? AND t.table_name = ?
- AND t.triggering_event = 'INSERT'
- AND t.status = 'ENABLED'
- };
- $sth = $dbh->prepare($sql);
- $sth->execute( uc($schema), uc($table) );
- }
- else {
- $sth = $dbh->prepare($sql);
- $sth->execute( uc( $source_name ) );
- }
while (my ($insert_trigger) = $sth->fetchrow_array) {
- return uc($1) if $insert_trigger =~ m!(\w+)\.nextval!i; # col name goes here???
+ return $1 if $insert_trigger =~ m!("?\w+"?)\.nextval!i; # col name goes here???
}
- $self->throw_exception("Unable to find a sequence INSERT trigger on table '" . $source->name . "'.");
+ $self->throw_exception("Unable to find a sequence INSERT trigger on table '$source_name'.");
}
sub _sequence_fetch {
sub columns_info_for {
my ($self, $table) = @_;
- $self->next::method(uc($table));
+ $self->next::method($table);
}
=head2 datetime_parser_type
--- /dev/null
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use CPANDB;
+use DBIx::Class::Schema::Loader 0.05;
+use Data::Dumper::Concise;
+
+{
+ package CPANDB::Schema;
+ use base qw/DBIx::Class::Schema::Loader/;
+
+ __PACKAGE__->loader_options (
+ naming => 'v5',
+ );
+}
+
+my $s = CPANDB::Schema->connect (sub { CPANDB->dbh } );
+
+# reference names are unstable - just create rels manually
+# is there a saner way to do that?
+my $distclass = $s->class('Distribution');
+$distclass->has_many (
+ 'deps',
+ $s->class('Dependency'),
+ 'distribution',
+);
+$s->unregister_source ('Distribution');
+$s->register_class ('Distribution', $distclass);
+
+
+# a proof of concept how to find out who uses us *AND* SQLT
+my $us_and_sqlt = $s->resultset('Distribution')->search (
+ {
+ 'deps.dependency' => 'DBIx-Class',
+ 'deps_2.dependency' => 'SQL-Translator',
+ },
+ {
+ join => [qw/deps deps/],
+ order_by => 'me.author',
+ select => [ 'me.distribution', 'me.author', map { "$_.phase" } (qw/deps deps_2/)],
+ as => [qw/dist_name dist_author req_dbic_at req_sqlt_at/],
+ result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+ },
+);
+
+print Dumper [$us_and_sqlt->all];
use DBIx::Class::Admin;
my $short_description = "utility for administrating DBIx::Class schemata";
-my $synopsis_text =qq{
+my $synopsis_text =q|
deploy a schema to a database
%c --schema=MyApp::Schema \
--connect='["dbi:SQLite:my.db", "", ""]' \
%c --schema=MyApp::Schema --class=Employee \
--connect='["dbi:SQLite:my.db", "", ""]' \
--op=update --set='{ "name": "New_Employee" }'
-}
-;
+|;
my ($opts, $usage) = describe_options(
"%c: %o",
(
['Actions'],
["action" => hidden => { one_of => [
- ['create|c' => 'Create version diffs needs preversion',],
- ['upgrade|U' => 'Upgrade the database to the current schema '],
- ['install|I' => 'Install the schema version tables to an existing database',],
- ['deploy|d' => 'Deploy the schema to the database',],
- ['select|s' => 'Select data from the schema', ],
- ['insert|i' => 'Insert data into the schema', ],
- ['update|u' => 'Update data in the schema', ],
- ['delete|D' => 'Delete data from the schema',],
+ ['create' => 'Create version diffs needs preversion',],
+ ['upgrade' => 'Upgrade the database to the current schema '],
+ ['install' => 'Install the schema version tables to an existing database',],
+ ['deploy' => 'Deploy the schema to the database',],
+ ['select' => 'Select data from the schema', ],
+ ['insert' => 'Insert data into the schema', ],
+ ['update' => 'Update data in the schema', ],
+ ['delete' => 'Delete data from the schema',],
['op:s' => 'compatiblity option all of the above can be suppied as --op=<action>'],
- ['help|h' => 'display this help', { implies => { schema_class => '__dummy__' } } ],
+ ['help' => 'display this help', { implies => { schema_class => '__dummy__' } } ],
['selfinject-pod' => 'hidden', { implies => { schema_class => '__dummy__' } } ],
], required=> 1 }],
['Arguments'],
- ['schema-class|schema|C:s' => 'The class of the schema to load', { required => 1 } ],
- ['resultset|resultset_class|class|r:s' => 'The resultset to operate on for data manipulation' ],
- ['config-stanza|S:s' => 'Where in the config to find the connection_info, supply in form MyApp::Model::DB',],
- ['config|f:s' => 'Supply the config file for parsing by Config::Any', { depends => 'config_stanza'} ],
- ['connect-info|n:s%' => 'Supply the connect info as additonal options ie -I dsn=<dsn> user=<user> password=<pass> '],
+ ['schema-class:s' => 'The class of the schema to load', { required => 1 } ],
+ ['resultset|resultset-class|class:s' => 'The resultset to operate on for data manipulation' ],
+ ['config-stanza:s' => 'Where in the config to find the connection_info, supply in form MyApp::Model::DB',],
+ ['config:s' => 'Supply the config file for parsing by Config::Any', { depends => 'config_stanza'} ],
+ ['connect-info:s%' => 'Supply the connect info as additonal options ie -I dsn=<dsn> user=<user> password=<pass> '],
['connect:s' => 'Supply the connect info as a json string' ],
- ['sql-dir|q:s' => 'The directory where sql diffs will be created'],
- ['sql-type|t:s' => 'The RDBMs flavour you wish to use'],
- ['version|v:i' => 'Supply a version install'],
- ['preversion|p:s' => 'The previous version to diff against',],
+ ['sql-dir:s' => 'The directory where sql diffs will be created'],
+ ['sql-type:s' => 'The RDBMs flavour you wish to use'],
+ ['version:i' => 'Supply a version install'],
+ ['preversion:s' => 'The previous version to diff against',],
['set:s' => 'JSON data used to perform data operations' ],
['attrs:s' => 'JSON string to be used for the second argument for search'],
['where:s' => 'JSON string to be used for the where clause of search'],
die "please only use one of --config or --connect-info\n" if ($opts->{config} and $opts->{connect_info});
if($opts->{selfinject_pod}) {
+
+ die "This is an internal method, do not call!!!\n"
+ unless $ENV{MAKELEVEL};
+
$usage->synopsis($synopsis_text);
$usage->short_description($short_description);
exec (
projects / dbsrgits/DBIx-Class.git / commitdiff