blib/
inc/
lib/DBIx/Class/Optional/Dependencies.pod
+lib/dbicadmin.pod
pm_to_blib
t/var/
- Fix count() with group_by aliased-function resultsets
- 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)
0.08119 2010-02-15 09:36:00 (UTC)
- Add $rs->is_ordered to test for existing order_by on a resultset
use FindBin;
use lib "$FindBin::Bin/lib";
+# adjust ENV for $AUTHOR system() calls
+use Config;
+$ENV{PERL5LIB} = join ($Config{path_sep}, @INC);
+
+
###
### DO NOT ADD OPTIONAL DEPENDENCIES HERE, EVEN AS recommends()
### All of them should go to DBIx::Class::Optional::Dependencies
my $test_requires = {
'File::Temp' => '0.22',
'Test::Builder' => '0.33',
- 'Test::Deep' => '0',
'Test::Exception' => '0',
'Test::More' => '0.92',
'Test::Warn' => '0.21',
};
my $runtime_requires = {
- # Core
- 'List::Util' => '0',
- 'Scalar::Util' => '0',
- 'Storable' => '0',
-
- # Dependencies
'Carp::Clan' => '6.0',
'Class::Accessor::Grouped' => '0.09002',
'Class::C3::Componentised' => '1.0005',
'MRO::Compat' => '0.09',
'Module::Find' => '0.06',
'Path::Class' => '0.18',
- 'Scope::Guard' => '0.03',
'SQL::Abstract' => '1.61',
'SQL::Abstract::Limit' => '0.13',
'Sub::Name' => '0.04',
test_requires => { %$test_requires },
};
-# re-build README and require extra modules for testing if we're in a checkout
-if ($Module::Install::AUTHOR) {
-
- print "Regenerating README\n";
- system('pod2text lib/DBIx/Class.pm > README');
-
- if (-f 'MANIFEST') {
- print "Removing MANIFEST\n";
- unlink 'MANIFEST';
- }
-
- print "Regenerating Optional/Dependencies.pod\n";
- require DBIx::Class::Optional::Dependencies;
- DBIx::Class::Optional::Dependencies->_gen_pod;
-
-# FIXME Disabled due to unsolved issues, ask theorbtwo
-# require Module::Install::Pod::Inherit;
-# PodInherit();
+# require extra modules for testing if we're in a checkout
+if ($Module::Install::AUTHOR) {
warn <<'EOW';
******************************************************************************
******************************************************************************
EOW
+ require DBIx::Class::Optional::Dependencies;
$reqs->{test_requires} = {
%{$reqs->{test_requires}},
%{DBIx::Class::Optional::Dependencies->_all_optional_requirements},
$rtype->($mod, $ver);
}
+auto_install();
+
+# re-create various autogenerated documentation bits
+if ($Module::Install::AUTHOR) {
+
+ print "Regenerating README\n";
+ system('pod2text lib/DBIx/Class.pm > README');
+
+ if (-f 'MANIFEST') {
+ print "Removing MANIFEST\n";
+ 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;
+
+ # FIXME Disabled due to unsolved issues, ask theorbtwo
+ # require Module::Install::Pod::Inherit;
+ # PodInherit();
+}
+
install_script (qw|
script/dbicadmin
|);
/);
-auto_install();
-
WriteAll();
--- /dev/null
+package # hide from PAUSE
+ DBIx::Class::Admin::Descriptive;
+
+use DBIx::Class::Admin::Usage;
+
+use base 'Getopt::Long::Descriptive';
+
+sub usage_class { 'DBIx::Class::Admin::Usage'; }
+
+1;
--- /dev/null
+package # hide from PAUSE
+ DBIx::Class::Admin::Usage;
+
+
+use base 'Getopt::Long::Descriptive::Usage';
+
+use base 'Class::Accessor::Grouped';
+
+use Class::C3;
+
+__PACKAGE__->mk_group_accessors('simple', 'synopsis', 'short_description');
+
+sub prog_name {
+ Getopt::Long::Descriptive::prog_name();
+}
+
+sub set_simple {
+ my ($self,$field, $value) = @_;
+ my $prog_name = prog_name();
+ $value =~ s/%c/$prog_name/g;
+ $self->next::method($field, $value);
+}
+
+
+=head2 pod
+
+This returns the usage formated as a pod document
+
+=cut
+
+
+sub pod {
+ my ($self) = @_;
+ return join qq{\n}, $self->pod_leader_text, $self->pod_option_text, $self->pod_authorlic_text;
+}
+
+sub pod_leader_text {
+ my ($self) = @_;
+
+ return qq{=head1 NAME\n\n}.prog_name()." - ".$self->short_description().qq{\n\n}.
+ qq{=head1 SYNOPSIS\n\n}.$self->leader_text().qq{\n}.$self->synopsis().qq{\n\n};
+
+}
+
+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
+EOA
+}
+
+
+sub pod_option_text {
+ my ($self) = @_;
+ my @options = @{ $self->{options} || [] };
+ my $string = q{};
+ return $string unless @options;
+
+ $string .= "=head1 OPTIONS\n\n=over\n\n";
+
+ foreach my $opt (@options) {
+ my $spec = $opt->{spec};
+ my $desc = $opt->{desc};
+ if ($desc eq 'spacer') {
+ $string .= "=back\n\n=head2 $spec\n\n=cut\n\n=over\n\n";
+ next;
+ }
+
+ $spec = Getopt::Long::Descriptive->_strip_assignment($spec);
+ $string .= "=item " . join " or ", map { length > 1 ? "B<--$_>" : "B<-$_>" }
+ split /\|/, $spec;
+ $string .= "\n\n$desc\n\n=cut\n\n";
+
+ }
+ $string .= "=back\n\n";
+ return $string;
+}
+
+1;
},
},
- author => {
+
+ test_pod => {
+ req => {
+ 'Test::Pod' => '1.41',
+ },
+ },
+
+ test_podcoverage => {
req => {
- 'Test::Pod' => '1.26',
'Test::Pod::Coverage' => '1.08',
'Pod::Coverage' => '0.20',
+ },
+ },
+
+ test_notabs => {
+ req => {
#'Test::NoTabs' => '0.9',
+ },
+ },
+
+ test_eol => {
+ req => {
#'Test::EOL' => '0.6',
},
},
- core => {
+ test_cycle => {
req => {
- # t/52cycle.t
'Test::Memory::Cycle' => '0',
'Devel::Cycle' => '1.10',
+ },
+ },
+ test_dtrelated => {
+ req => {
# t/36datetime.t
# t/60core.t
'DateTime::Format::SQLite' => '0',
# t/96_is_deteministic_value.t
'DateTime::Format::Strptime'=> '0',
+
+ # t/inflate/datetime_mysql.t
+ # (doesn't need Mysql itself)
+ 'DateTime::Format::MySQL' => '0',
+
+ # t/inflate/datetime_pg.t
+ # (doesn't need PG itself)
+ 'DateTime::Format::Pg' => '0',
},
},
? (
'Sys::SigAction' => '0',
'DBD::Pg' => '2.009002',
- 'DateTime::Format::Pg' => '0',
) : ()
},
},
req => {
$ENV{DBICTEST_MYSQL_DSN}
? (
- 'DateTime::Format::MySQL' => '0',
'DBD::mysql' => '0',
) : ()
},
) : ()
},
},
+
+ rdbms_db2 => {
+ req => {
+ $ENV{DBICTEST_DB2_DSN}
+ ? (
+ 'DBD::DB2' => 0,
+ ) : ()
+ },
+ },
+
};
use strict;
use warnings;
use Sub::Name ();
-use Class::Inspector ();
our %_pod_inherit_config =
(
sub parse {
# this is a hack to prevent schema leaks due to a retarded SQLT implementation
# DO NOT REMOVE (until SQLT2 is out, the all of this will be rewritten anyway)
- Scalar::Util::weaken ($_[1]);
+ Scalar::Util::weaken ($_[1]) if ref ($_[1]);
my ($tr, $data) = @_;
my $args = $tr->parser_args;
BEGIN {
use DBIx::Class;
- die ( "The following modules are required for the dbicadmin utility\n"
+ die ( 'The following modules are required for the dbicadmin utility: '
. DBIx::Class::Optional::Dependencies->req_missing_for ('admin_script')
+ . "\n"
) unless DBIx::Class::Optional::Dependencies->req_ok_for ('admin_script');
}
-use Getopt::Long::Descriptive;
+use DBIx::Class::Admin::Descriptive;
+#use Getopt::Long::Descriptive;
use DBIx::Class::Admin;
+my $short_description = "utility for administrating DBIx::Class schemata";
+my $synopsis_text =qq{
+ deploy a schema to a database
+ %c --schema=MyApp::Schema \
+ --connect='["dbi:SQLite:my.db", "", ""]' \
+ --deploy
+
+ update an existing record
+ %c --schema=MyApp::Schema --class=Employee \
+ --connect='["dbi:SQLite:my.db", "", ""]' \
+ --op=update --set='{ "name": "New_Employee" }'
+}
+;
+
my ($opts, $usage) = describe_options(
- "%c: %o",
+ "%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 to the database',],
+ ['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',],
['op:s' => 'compatiblity option all of the above can be suppied as --op=<action>'],
- ['help|h' => 'display this help'],
+ ['help|h' => 'display this help', { implies => { schema_class => 'main' } } ],
+ ['pod' => 'Output this usage as pod', { implies => { schema_class => 'main' } } ],
], required=> 1 }],
- ['Options'],
+ ['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',],
['version|v:i' => 'Supply a version install'],
['preversion|p:s' => 'The previous version to diff against',],
['set:s' => 'JSON data used to perform data operations' ],
- ['lib|I:s' => 'Additonal library path to search in'],
['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'],
['force' => 'Be forceful with some operations'],
die "please only use one of --config or --connect-info\n" if ($opts->{config} and $opts->{connect_info});
+if($opts->{pod}) {
+ $usage->synopsis($synopsis_text);
+ $usage->short_description($short_description);
+ print $usage->pod();
+ exit 0;
+}
+
+if($opts->{help}) {
+ $usage->die();
+}
+
# option compatability mangle
if($opts->{connect}) {
$opts->{connect_info} = delete $opts->{connect};
}
}
-=head1 AUTHOR
-
-See L<DBIx::Class/CONTRIBUTORS>.
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself
-=cut
+#__END__
+#
+#=begin pod_begin
+#
+#BEGIN MARKER FOR DYNAMIC POD
+#
+#=end pod_begin
+#
+#=begin pod_end
+#
+#END MARKER FOR DYNAMIC POD
+#
+#=end pod_end
+#
+#=head1 AUTHOR
+#
+#See L<DBIx::Class/CONTRIBUTORS>.
+#
+#=head1 LICENSE
+#
+#You may distribute this code under the same terms as Perl itself
+#
+#=cut
+
+# vim: et ft=perl
use lib qw(t/lib);
use DBICTest;
-my @MODULES = (
- 'Test::Pod 1.26',
-);
-
# Don't run tests for installs
unless ( DBICTest::AuthorCheck->is_author || $ENV{AUTOMATED_TESTING} || $ENV{RELEASE_TESTING} ) {
plan( skip_all => "Author tests not required for installation" );
}
-# Load the testing modules
-foreach my $MODULE ( @MODULES ) {
- eval "use $MODULE";
- if ( $@ ) {
- $ENV{RELEASE_TESTING}
- ? die( "Failed to load required release-testing module $MODULE" )
- : plan( skip_all => "$MODULE not available for testing" );
- }
+require DBIx::Class;
+unless ( DBIx::Class::Optional::Dependencies->req_ok_for ('test_pod') ) {
+ my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('test_pod');
+ $ENV{RELEASE_TESTING} || DBICTest::AuthorCheck->is_author
+ ? die ("Failed to load release-testing module requirements: $missing")
+ : plan skip_all => "Test needs: $missing"
}
-all_pod_files_ok();
+Test::Pod::all_pod_files_ok();
use lib qw(t/lib);
use DBICTest;
-my @MODULES = (
- 'Test::Pod::Coverage 1.08',
- 'Pod::Coverage 0.20',
-);
-
# Don't run tests for installs
unless ( DBICTest::AuthorCheck->is_author || $ENV{AUTOMATED_TESTING} || $ENV{RELEASE_TESTING} ) {
plan( skip_all => "Author tests not required for installation" );
}
-# Load the testing modules
-foreach my $MODULE ( @MODULES ) {
- eval "use $MODULE";
- if ( $@ ) {
- $ENV{RELEASE_TESTING}
- ? die( "Failed to load required release-testing module $MODULE" )
- : plan( skip_all => "$MODULE not available for testing" );
- }
+require DBIx::Class;
+unless ( DBIx::Class::Optional::Dependencies->req_ok_for ('test_podcoverage') ) {
+ my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('test_podcoverage');
+ $ENV{RELEASE_TESTING} || DBICTest::AuthorCheck->is_author
+ ? die ("Failed to load release-testing module requirements: $missing")
+ : plan skip_all => "Test needs: $missing"
}
# Since this is about checking documentation, a little documentation
/]
},
- 'DBIx::Class::Admin::Types' => { skip => 1 },
+ 'DBIx::Class::Admin::*' => { skip => 1 },
'DBIx::Class::ClassResolver::PassThrough' => { skip => 1 },
'DBIx::Class::Componentised' => { skip => 1 },
'DBIx::Class::Relationship::*' => { skip => 1 },
if exists($ex->{ignore});
# run the test with the potentially modified parm set
- pod_coverage_ok($module, $parms, "$module POD coverage");
+ Test::Pod::Coverage::pod_coverage_ok($module, $parms, "$module POD coverage");
}
}
use lib qw(t/lib);
BEGIN {
- eval { require Test::Memory::Cycle; require Devel::Cycle };
- if ($@ or Devel::Cycle->VERSION < 1.10) {
- plan skip_all => "leak test needs Test::Memory::Cycle and Devel::Cycle >= 1.10";
- };
+ require DBIx::Class;
+ plan skip_all => 'Test needs: ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_cycle')
+ unless ( DBIx::Class::Optional::Dependencies->req_ok_for ('test_cycle') );
}
use DBICTest;
my $schema = DBICTest->init_schema();
-BEGIN {
- eval "use DBD::SQLite";
- plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 6);
-}
-
my $art = $schema->resultset("Artist")->find(1);
isa_ok $art => 'DBICTest::Artist';
ok($art->name($name) eq $name, 'update');
-{
+{
my @changed_keys = $art->is_changed;
is( scalar (@changed_keys), 0, 'field changed but same value' );
-}
+}
$art->discard_changes;
my $art_100 = $schema->resultset("Artist")->find(100);
$art_100->artistid(101);
ok($art_100->update(), 'update allows pk mutation via column accessor');
+
+done_testing;
my $schema = DBICTest->init_schema();
-BEGIN {
- eval "use DBD::SQLite";
- plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 10);
-}
-
# test LIMIT
my $it = $schema->resultset("CD")->search( {},
{ rows => 3,
);
is( $it->count, 1, "complex abstract count ok" );
+done_testing;
my $orig_debug = $schema->storage->debug;
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 33 );
-}
-
# test the abstract join => SQL generator
my $sa = new DBIx::Class::SQLAHacks;
is(cd_count(), 5, '5 rows in table cd');
is(tk_count(), 3, '3 rows in table twokeys');
}
+
+done_testing;
# Test for SQLT-related leaks
{
my $s = DBICTest::Schema->clone;
- create_schema ({ schema => $s });
+ my $sqlt_schema = create_schema ({ schema => $s });
Scalar::Util::weaken ($s);
ok (!$s, 'Schema not leaked');
+
+ isa_ok ($sqlt_schema, 'SQL::Translator::Schema', 'SQLT schema object produced');
}
+# make sure classname-style works
+lives_ok { isa_ok (create_schema ({ schema => 'DBICTest::Schema' }), 'SQL::Translator::Schema', 'SQLT schema object produced') };
+
my $schema = DBICTest->init_schema();
# Dummy was yanked out by the sqlt hook test
use Path::Class;
-use ok 'DBIx::Class::Admin';
+use_ok 'DBIx::Class::Admin';
my $sql_dir = dir(qw/t var/);
use Test::More;
use Test::Exception;
-use Test::Deep;
BEGIN {
require DBIx::Class;
use lib 't/lib';
use DBICTest;
-use ok 'DBIx::Class::Admin';
+use_ok 'DBIx::Class::Admin';
{ # test data maniplulation functions
];
my $data;
lives_ok { $data = $admin->select('Employee')} 'can retrive data from database';
- cmp_deeply($data, $expected_data, 'DB matches whats expected');
+ is_deeply($data, $expected_data, 'DB matches whats expected');
$admin->delete('Employee', {name=>'Trout'});
my $del_rs = $employees->search({name => 'Trout'});
my $schema = DBICTest->init_schema;
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 13 );
-}
-
my $where_bind = {
where => \'name like ?',
bind => [ 'Cat%' ],
bind => [ 'Spoon%' ] });
is ( $rs->count, 1, '...cookbook + chained search with extra bind' );
}
+
+done_testing;
use lib qw(t/lib);
use DBIC::SqlMakerTest;
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 7 );
-}
-
use_ok('DBICTest');
use_ok('DBIC::DebugObj');
$schema->storage->sql_maker->name_sep('.');
is($schema->storage->sql_maker->update('group', \%data), 'UPDATE `group` SET `name` = ?, `order` = ?', 'quoted table names for UPDATE');
+
+done_testing;
use lib qw(t/lib);
use DBIC::SqlMakerTest;
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 7 );
-}
-
use_ok('DBICTest');
use_ok('DBIC::DebugObj');
);
is($schema->storage->sql_maker->update('group', \%data), 'UPDATE `group` SET `name` = ?, `order` = ?', 'quoted table names for UPDATE');
+
+done_testing;
-use Class::C3;
use strict;
-use Test::More;
use warnings;
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 4 );
-}
+use Test::More;
+use Test::Warn;
+use Test::Exception;
use lib qw(t/lib);
-
use_ok( 'DBICTest' );
use_ok( 'DBICTest::Schema' );
+
my $schema = DBICTest->init_schema;
-{
- my $warnings;
- local $SIG{__WARN__} = sub { $warnings .= $_[0] };
- eval {
- $schema->resultset('CD')
- ->create({ title => 'vacation in antarctica' })
- };
- like $@, qr/NULL/; # as opposed to some other error
- unlike( $warnings, qr/uninitialized value/, "No warning from Storage" );
-}
+warnings_are ( sub {
+ throws_ok (sub {
+ $schema->resultset('CD')->create({ title => 'vacation in antarctica' });
+ }, qr/NULL/); # as opposed to some other error
+}, [], 'No warnings besides exception' );
+done_testing;
projects / dbsrgits/DBIx-Class.git / commitdiff