[Bast-commits] r3138 - in trunk/DBIx-Class-TimeStamp: .
lib/DBIx/Class t t/lib/DBIC t/lib/DBIC/Test t/lib/DBIC/Test/Schema
jshirley at dev.catalyst.perl.org
jshirley at dev.catalyst.perl.org
Fri Mar 23 23:17:12 GMT 2007
Author: jshirley
Date: 2007-03-23 23:17:11 +0000 (Fri, 23 Mar 2007)
New Revision: 3138
Added:
trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test.pm
trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/
trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema.pm
trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/
Removed:
trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Schema.pm
trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Schema/
Modified:
trunk/DBIx-Class-TimeStamp/MANIFEST
trunk/DBIx-Class-TimeStamp/Makefile.PL
trunk/DBIx-Class-TimeStamp/lib/DBIx/Class/TimeStamp.pm
trunk/DBIx-Class-TimeStamp/t/05datetime.t
trunk/DBIx-Class-TimeStamp/t/06timestamp.t
trunk/DBIx-Class-TimeStamp/t/07date.t
trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/Test.pm
trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/TestDate.pm
trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/TestDatetime.pm
trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/TestTime.pm
Log:
Finished with the test cases being more inline with DBIC::Test.
Modified: trunk/DBIx-Class-TimeStamp/MANIFEST
===================================================================
--- trunk/DBIx-Class-TimeStamp/MANIFEST 2007-03-23 21:26:44 UTC (rev 3137)
+++ trunk/DBIx-Class-TimeStamp/MANIFEST 2007-03-23 23:17:11 UTC (rev 3138)
@@ -1,4 +1,15 @@
Changes
+inc/Module/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
lib/DBIx/Class/TimeStamp.pm
Makefile.PL
MANIFEST This list of files
Modified: trunk/DBIx-Class-TimeStamp/Makefile.PL
===================================================================
--- trunk/DBIx-Class-TimeStamp/Makefile.PL 2007-03-23 21:26:44 UTC (rev 3137)
+++ trunk/DBIx-Class-TimeStamp/Makefile.PL 2007-03-23 23:17:11 UTC (rev 3138)
@@ -6,6 +6,9 @@
requires 'DateTime';
requires 'DBIx::Class';
+build_requires 'Time::Warp';
+build_requires 'Time::HiRes';
+
auto_install;
WriteAll;
Modified: trunk/DBIx-Class-TimeStamp/lib/DBIx/Class/TimeStamp.pm
===================================================================
--- trunk/DBIx-Class-TimeStamp/lib/DBIx/Class/TimeStamp.pm 2007-03-23 21:26:44 UTC (rev 3137)
+++ trunk/DBIx-Class-TimeStamp/lib/DBIx/Class/TimeStamp.pm 2007-03-23 23:17:11 UTC (rev 3138)
@@ -5,10 +5,9 @@
use warnings;
use strict;
-use Data::Dump qw(dump);
use DateTime;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
__PACKAGE__->load_components( qw/InflateColumn::DateTime/ );
__PACKAGE__->mk_classdata(
Modified: trunk/DBIx-Class-TimeStamp/t/05datetime.t
===================================================================
--- trunk/DBIx-Class-TimeStamp/t/05datetime.t 2007-03-23 21:26:44 UTC (rev 3137)
+++ trunk/DBIx-Class-TimeStamp/t/05datetime.t 2007-03-23 23:17:11 UTC (rev 3138)
@@ -1,23 +1,34 @@
use strict;
use warnings;
-use Test::More tests => 3;
+use Test::More tests => 4;
+use DateTime;
+use Time::HiRes;
+use Time::Warp qw|to time|;
+
+# Redefine "now" so that we can warp it.
+no warnings 'redefine';
+local *DateTime::now = sub { shift->from_epoch( epoch => (scalar time), @_ ) };
+use warnings 'redefine';
+
use lib qw(t/lib);
-use TimeStampTest;
+use DBIC::Test;
-my $schema = TimeStampTest->init_schema;
+my $schema = DBIC::Test->init_schema;
my $row;
-$row = $schema->resultset('TestDatetime')
+$row = $schema->resultset('DBIC::Test::Schema::TestDatetime')
->create({ display_name => 'test record' });
my $time = $row->t_updated;
ok $row->t_created, 'created timestamp';
is $row->t_updated, $row->t_created, 'update and create timestamp';
-sleep(60);
-$row->display_name('test record again');
-$row->update;
-isnt $row->t_updated, $time, 'update timestamp';
+to(time + 60);
+$row->update({ display_name => 'updating test record' });
+
+is $row->display_name, 'updating test record', 'update record';
+isnt $row->t_updated, $time, 'timestamp update';
+
Modified: trunk/DBIx-Class-TimeStamp/t/06timestamp.t
===================================================================
--- trunk/DBIx-Class-TimeStamp/t/06timestamp.t 2007-03-23 21:26:44 UTC (rev 3137)
+++ trunk/DBIx-Class-TimeStamp/t/06timestamp.t 2007-03-23 23:17:11 UTC (rev 3138)
@@ -1,21 +1,31 @@
use strict;
use warnings;
+use DateTime;
+use Time::HiRes;
+use Time::Warp qw|to time|;
use Test::More tests => 3;
+# Redefine "now" so that we can warp it.
+no warnings 'redefine';
+local *DateTime::now = sub { shift->from_epoch( epoch => (scalar time), @_ ) };
+use warnings 'redefine';
+
use lib qw(t/lib);
-use TimeStampTest;
+use DBIC::Test;
-my $schema = TimeStampTest->init_schema;
+my $schema = DBIC::Test->init_schema;
my $row;
-$row = $schema->resultset('TestTime')
+$row = $schema->resultset('DBIC::Test::Schema::TestTime')
->create({ display_name => 'test record' });
my $time = $row->t_updated;
ok $row->t_created, 'created timestamp';
is $row->t_updated, $row->t_created, 'update and create timestamp';
-sleep(60);
+
+to(time + 60);
+
$row->display_name('test record again');
$row->update;
Modified: trunk/DBIx-Class-TimeStamp/t/07date.t
===================================================================
--- trunk/DBIx-Class-TimeStamp/t/07date.t 2007-03-23 21:26:44 UTC (rev 3137)
+++ trunk/DBIx-Class-TimeStamp/t/07date.t 2007-03-23 23:17:11 UTC (rev 3138)
@@ -1,21 +1,31 @@
use strict;
use warnings;
+use DateTime;
+use Time::HiRes;
+use Time::Warp qw|to time|;
use Test::More tests => 3;
+# Redefine "now" so that we can warp it.
+no warnings 'redefine';
+local *DateTime::now = sub { shift->from_epoch( epoch => (scalar time), @_ ) };
+use warnings 'redefine';
+
use lib qw(t/lib);
-use TimeStampTest;
+use DBIC::Test;
-my $schema = TimeStampTest->init_schema;
+my $schema = DBIC::Test->init_schema;
my $row;
-$row = $schema->resultset('TestDate')
+$row = $schema->resultset('DBIC::Test::Schema::TestDate')
->create({ display_name => 'test record' });
my $time = $row->t_updated;
ok $row->t_created, 'created timestamp';
is $row->t_updated, $row->t_created, 'update and create timestamp';
-sleep(60);
+
+to(time + 60);
+
$row->display_name('test record again');
$row->update;
Deleted: trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Schema.pm
===================================================================
--- trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Schema.pm 2007-03-23 21:26:44 UTC (rev 3137)
+++ trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Schema.pm 2007-03-23 23:17:11 UTC (rev 3138)
@@ -1,10 +0,0 @@
-package # hide from PAUSE
- TimeStampTest::Schema;
-
-use base qw/DBIx::Class::Schema/;
-
-no warnings qw/qw/;
-
-__PACKAGE__->load_classes(qw/TestDatetime TestDate TestTime/);
-
-1;
Copied: trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema (from rev 3137, trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Schema)
Modified: trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/Test.pm
===================================================================
--- trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Schema/Test.pm 2007-03-23 21:26:44 UTC (rev 3137)
+++ trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/Test.pm 2007-03-23 23:17:11 UTC (rev 3138)
@@ -1,5 +1,5 @@
package #
- TimeStampTest::Schema::Test;
+ DBIC::Test::Schema::Test;
use base 'DBIx::Class::Core';
Modified: trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/TestDate.pm
===================================================================
--- trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Schema/TestDate.pm 2007-03-23 21:26:44 UTC (rev 3137)
+++ trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/TestDate.pm 2007-03-23 23:17:11 UTC (rev 3138)
@@ -1,5 +1,5 @@
package #
- TimeStampTest::Schema::TestDate;
+ DBIC::Test::Schema::TestDate;
use base 'DBIx::Class::Core';
Modified: trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/TestDatetime.pm
===================================================================
--- trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Schema/TestDatetime.pm 2007-03-23 21:26:44 UTC (rev 3137)
+++ trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/TestDatetime.pm 2007-03-23 23:17:11 UTC (rev 3138)
@@ -1,10 +1,10 @@
package #
- TimeStampTest::Schema::TestDatetime;
+ DBIC::Test::Schema::TestDatetime;
use base 'DBIx::Class::Core';
__PACKAGE__->load_components(qw/TimeStamp PK::Auto Core/);
-__PACKAGE__->table('test');
+__PACKAGE__->table('test_datetime');
__PACKAGE__->add_columns(
'pk1' => {
Modified: trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/TestTime.pm
===================================================================
--- trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Schema/TestTime.pm 2007-03-23 21:26:44 UTC (rev 3137)
+++ trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema/TestTime.pm 2007-03-23 23:17:11 UTC (rev 3138)
@@ -1,5 +1,5 @@
package #
- TimeStampTest::Schema::TestTime;
+ DBIC::Test::Schema::TestTime;
use base 'DBIx::Class::Core';
Copied: trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema.pm (from rev 3137, trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Schema.pm)
===================================================================
--- trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema.pm (rev 0)
+++ trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test/Schema.pm 2007-03-23 23:17:11 UTC (rev 3138)
@@ -0,0 +1,14 @@
+package # hide from PAUSE
+ DBIC::Test::Schema;
+
+use base qw/DBIx::Class::Schema/;
+
+no warnings qw/qw/;
+
+__PACKAGE__->load_classes;
+
+sub dsn {
+ return shift->storage->connect_info->[0];
+}
+
+1;
Copied: trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test.pm (from rev 3137, trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Schema.pm)
===================================================================
--- trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test.pm (rev 0)
+++ trunk/DBIx-Class-TimeStamp/t/lib/DBIC/Test.pm 2007-03-23 23:17:11 UTC (rev 3138)
@@ -0,0 +1,106 @@
+package #
+ DBIC::Test;
+
+use strict;
+use warnings;
+
+BEGIN {
+ # little trick by Ovid to pretend to subclass+exporter Test::More
+ use base qw/Test::Builder::Module Class::Accessor::Grouped/;
+ use Test::More;
+ use File::Spec::Functions qw/catfile catdir/;
+
+ @DBIC::Test::EXPORT = @Test::More::EXPORT;
+
+ __PACKAGE__->mk_group_accessors('inherited', qw/db_dir db_file/);
+};
+
+__PACKAGE__->db_dir(catdir('t', 'var'));
+__PACKAGE__->db_file('test.db');
+
+sub init_schema {
+ my ( $self, %args ) = @_;
+
+ my $db_dir = $args{'db_dir'} || $self->db_dir;
+ my $db_file = $args{'db_file'} || $self->db_file;
+
+ my $namespace = $args{'namespace'} || 'DBIC::TestSchema';
+ my $db = catfile($db_dir, $db_file);
+
+ eval 'use DBD::SQLite';
+ if ( $@ ) {
+ BAIL_OUT('DBD::SQLite not installed');
+ return;
+ }
+
+ eval 'use DBIC::Test::Schema';
+ if ( $@ ) {
+ BAIL_OUT("Could not load test schema DBIC::Test::Schema: $@");
+ return;
+ }
+
+ unlink($db) if -e $db;
+ unlink($db . '-journal') if -e $db . '-journal';
+ mkdir($db_dir) unless -d $db_dir;
+
+ my $dsn = 'dbi:SQLite:' . $db;
+ my $schema = DBIC::Test::Schema
+ ->compose_namespace($namespace)->connect($dsn);
+ $schema->storage->on_connect_do([
+ 'PRAGMA synchronous = OFF',
+ 'PRAGMA temp_store = MEMORY'
+ ]);
+
+ __PACKAGE__->deploy_schema($schema, %args);
+ __PACKAGE__->populate_schema($schema, %args) unless $args{'no_populate'};
+
+ return $schema;
+}
+
+sub deploy_schema {
+ my ( $self, $schema, %options ) = @_;
+ my $eval = $options{'eval_deploy'};
+
+ eval 'use SQL::Translator';
+
+ if ( !$@ && !$options{'no_deploy'} ) {
+ eval {
+ $schema->deploy();
+ };
+ if ( $@ && !$eval ) {
+ die $@;
+ }
+ } else {
+ open IN, catfile('t', 'sql', 'test.sqlite.sql' );
+ my $sql;
+ { local $/ = undef; $sql = <IN>; }
+ close IN;
+ eval {
+ ($schema->storage->dbh->do($_) || print "Error on SQL: $_\n")
+ for split(/;\n/, $sql);
+ };
+ if ( $@ && !$eval ) {
+ die $@;
+ }
+ }
+
+}
+
+sub clear_schema {
+ my ( $self, $schema, %options ) = @_;
+
+ foreach my $source ( $schema->sources ) {
+ $schema->resultset($source)->delete_all;
+ }
+}
+
+sub populate_schema {
+ my ( $self, $schema, %options ) = @_;
+
+ if ( $options{'clear'} ) {
+ $self->clear_schema($schema, %options);
+ }
+ # We don't need any data, but if we did, put it here.
+}
+
+1;
More information about the Bast-commits
mailing list