[Bast-commits] r3930 - in
DBIx-Class/0.08/branches/versioned_enhancements: . lib/DBIx
lib/DBIx/Class lib/DBIx/Class/Storage/DBI/ODBC script t
ash at dev.catalyst.perl.org
ash at dev.catalyst.perl.org
Fri Jan 11 23:45:03 GMT 2008
Author: ash
Date: 2008-01-11 23:45:03 +0000 (Fri, 11 Jan 2008)
New Revision: 3930
Added:
DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
DBIx-Class/0.08/branches/versioned_enhancements/t/746mssql.t
Modified:
DBIx-Class/0.08/branches/versioned_enhancements/
DBIx-Class/0.08/branches/versioned_enhancements/Changes
DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class.pm
DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/ResultSet.pm
DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/ResultSourceHandle.pm
DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Row.pm
DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Schema.pm
DBIx-Class/0.08/branches/versioned_enhancements/script/dbicadmin
DBIx-Class/0.08/branches/versioned_enhancements/t/68inflate.t
DBIx-Class/0.08/branches/versioned_enhancements/t/746db2_400.t
DBIx-Class/0.08/branches/versioned_enhancements/t/84serialize.t
DBIx-Class/0.08/branches/versioned_enhancements/t/89dbicadmin.t
Log:
r11889 at metis (orig r3897): wreis | 2007-12-11 01:29:51 +0000
minor doc fix
r12746 at metis (orig r3901): ash | 2007-12-20 11:02:15 +0000
Add proper thaw hooks so schema gets re-attached
r13156 at metis (orig r3908): perigrin | 2008-01-02 20:52:13 +0000
move dbicadmin to JSON::Any
r13157 at metis (orig r3909): semifor | 2008-01-02 22:24:23 +0000
Added Storage::DBI subclass for MSSQL auto PK over ODBC.
r13158 at metis (orig r3910): nothingmuch | 2008-01-03 13:18:36 +0000
failing test for inflate not being triggerred with copy()
r13159 at metis (orig r3911): nothingmuch | 2008-01-03 13:31:49 +0000
test plan
r13160 at metis (orig r3912): nothingmuch | 2008-01-03 13:35:20 +0000
introduce set_inflated_columns
r13161 at metis (orig r3913): nothingmuch | 2008-01-03 13:36:07 +0000
pod coverage for Storage::DBI::ODBC::Microsoft_SQL_Server
r13162 at metis (orig r3914): nothingmuch | 2008-01-03 13:53:00 +0000
dbicadmin printed even when quiet
r13163 at metis (orig r3915): nothingmuch | 2008-01-03 13:54:38 +0000
make the dbicadmin test portable to JSON modules that do not support single quotes and bare strings, even on windaz
r13164 at metis (orig r3916): nothingmuch | 2008-01-03 14:50:52 +0000
changelog
r13166 at metis (orig r3918): tomboh | 2008-01-07 15:23:15 +0000
Fix class name typo
r13173 at metis (orig r3925): nigel | 2008-01-11 12:55:17 +0000
Copied documentation for id & discard_charges methods from Pk.pm
into Row.pm as few people think to look in Pk.pm. Put reference
back to original source.
Property changes on: DBIx-Class/0.08/branches/versioned_enhancements
___________________________________________________________________
Name: svk:merge
- 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:3889
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
fe160bb6-dc1c-0410-9f2b-d64a711b54a5:/local/DBIC-trunk-0.08:10510
+ 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:3925
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
fe160bb6-dc1c-0410-9f2b-d64a711b54a5:/local/DBIC-trunk-0.08:10510
Modified: DBIx-Class/0.08/branches/versioned_enhancements/Changes
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/Changes 2008-01-11 23:41:05 UTC (rev 3929)
+++ DBIx-Class/0.08/branches/versioned_enhancements/Changes 2008-01-11 23:45:03 UTC (rev 3930)
@@ -1,7 +1,13 @@
Revision history for DBIx::Class
+
+ - Added Storage::DBI subclass for MSSQL over ODBC.
+ - Added freeze, thaw and dclone methods to Schema so that thawed
+ objects will get re-attached to the schema.
+ - Moved dbicadmin to JSON::Any wrapped JSON.pm for a sane API
+ - introduced DBIx::Class::set_inflated_columns
+ - DBIx::Class::Row::copy uses set_inflated_columns
- Versioning refactored
- - Row::insert will now not fall over if passed duplicate related objects
0.08008 2007-11-16 14:30:00
- Fixed join merging bug (test from Zby)
Modified: DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/ResultSet.pm 2008-01-11 23:41:05 UTC (rev 3929)
+++ DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/ResultSet.pm 2008-01-11 23:45:03 UTC (rev 3930)
@@ -929,7 +929,7 @@
with to find the number of elements. If passed arguments, does a search
on the resultset and counts the results of that.
-Note: When using C<count> with C<group_by>, L<DBIX::Class> emulates C<GROUP BY>
+Note: When using C<count> with C<group_by>, L<DBIx::Class> emulates C<GROUP BY>
using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
not support C<DISTINCT> with multiple columns. If you are using such a
database, you should only use columns from the main table in your C<group_by>
Modified: DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/ResultSourceHandle.pm
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/ResultSourceHandle.pm 2008-01-11 23:41:05 UTC (rev 3929)
+++ DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/ResultSourceHandle.pm 2008-01-11 23:45:03 UTC (rev 3930)
@@ -14,6 +14,9 @@
__PACKAGE__->mk_group_accessors('simple' => qw/schema source_moniker/);
+# Schema to use when thawing.
+our $thaw_schema;
+
=head1 NAME
DBIx::Class::ResultSourceHandle
@@ -71,20 +74,32 @@
sub STORABLE_freeze {
my ($self, $cloning) = @_;
+
my $to_serialize = { %$self };
+
delete $to_serialize->{schema};
return (Storable::freeze($to_serialize));
}
=head2 STORABLE_thaw
-Thaws frozen handle.
+Thaws frozen handle. Resets the internal schema reference to the package
+variable C<$thaw_schema>. The recomened way of setting this is to use
+C<$schema->thaw($ice)> which handles this for you.
=cut
+
sub STORABLE_thaw {
my ($self, $cloning,$ice) = @_;
%$self = %{ Storable::thaw($ice) };
+ $self->{schema} = $thaw_schema;
}
+=head1 AUTHOR
+
+Ash Berlin C<< <ash at cpan.org> >>
+
+=cut
+
1;
Modified: DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Row.pm 2008-01-11 23:41:05 UTC (rev 3929)
+++ DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Row.pm 2008-01-11 23:45:03 UTC (rev 3930)
@@ -281,9 +281,10 @@
required.
Also takes an options hashref of C<< column_name => value> pairs >> to update
-first. But be aware that this hashref might be edited in place, so dont rely on
-it being the same after a call to C<update>. If you need to preserve the hashref,
-it is sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
+first. But be awawre that the hashref will be passed to
+C<set_inflated_columns>, which might edit it in place, so dont rely on it being
+the same after a call to C<update>. If you need to preserve the hashref, it is
+sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
=cut
@@ -294,38 +295,7 @@
$self->throw_exception("Cannot safely update a row in a PK-less table")
if ! keys %$ident_cond;
- if ($upd) {
- foreach my $key (keys %$upd) {
- if (ref $upd->{$key}) {
- my $info = $self->relationship_info($key);
- if ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'single')
- {
- my $rel = delete $upd->{$key};
- $self->set_from_related($key => $rel);
- $self->{_relationship_data}{$key} = $rel;
- } elsif ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'multi'
- && ref $upd->{$key} eq 'ARRAY') {
- my $others = delete $upd->{$key};
- foreach my $rel_obj (@$others) {
- if(!Scalar::Util::blessed($rel_obj)) {
- $rel_obj = $self->create_related($key, $rel_obj);
- }
- }
- $self->{_relationship_data}{$key} = $others;
-# $related->{$key} = $others;
- next;
- }
- elsif ($self->has_column($key)
- && exists $self->column_info($key)->{_inflate_info})
- {
- $self->set_inflated_column($key, delete $upd->{$key});
- }
- }
- }
- $self->set_columns($upd);
- }
+ $self->set_inflated_columns($upd) if $upd;
my %to_update = $self->get_dirty_columns;
return $self unless keys %to_update;
my $rows = $self->result_source->storage->update(
@@ -352,7 +322,7 @@
reinserted using C<< ->insert() >> before C<< ->update() >> can be used
on it. If you delete an object in a class with a C<has_many>
relationship, all the related objects will be deleted as well. To turn
-this behavior off, pass C<cascade_delete => 0> in the C<$attr>
+this behavior off, pass C<< cascade_delete => 0 >> in the C<$attr>
hashref. Any database-level cascade or restrict will take precedence
over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
@@ -508,6 +478,52 @@
return $self;
}
+=head2 set_inflated_columns
+
+ my $copy = $orig->set_inflated_columns({ $col => $val, $rel => $obj, ... });
+
+Sets more than one column value at once, taking care to respect inflations and
+relationships if relevant. Be aware that this hashref might be edited in place,
+so dont rely on it being the same after a call to C<set_inflated_columns>. If
+you need to preserve the hashref, it is sufficient to pass a shallow copy to
+C<set_inflated_columns>, e.g. ( { %{ $href } } )
+
+=cut
+
+sub set_inflated_columns {
+ my ( $self, $upd ) = @_;
+ foreach my $key (keys %$upd) {
+ if (ref $upd->{$key}) {
+ my $info = $self->relationship_info($key);
+ if ($info && $info->{attrs}{accessor}
+ && $info->{attrs}{accessor} eq 'single')
+ {
+ my $rel = delete $upd->{$key};
+ $self->set_from_related($key => $rel);
+ $self->{_relationship_data}{$key} = $rel;
+ } elsif ($info && $info->{attrs}{accessor}
+ && $info->{attrs}{accessor} eq 'multi'
+ && ref $upd->{$key} eq 'ARRAY') {
+ my $others = delete $upd->{$key};
+ foreach my $rel_obj (@$others) {
+ if(!Scalar::Util::blessed($rel_obj)) {
+ $rel_obj = $self->create_related($key, $rel_obj);
+ }
+ }
+ $self->{_relationship_data}{$key} = $others;
+# $related->{$key} = $others;
+ next;
+ }
+ elsif ($self->has_column($key)
+ && exists $self->column_info($key)->{_inflate_info})
+ {
+ $self->set_inflated_column($key, delete $upd->{$key});
+ }
+ }
+ }
+ $self->set_columns($upd);
+}
+
=head2 copy
my $copy = $orig->copy({ change => $to, ... });
@@ -529,7 +545,7 @@
bless $new, ref $self;
$new->result_source($self->result_source);
- $new->set_columns($changes);
+ $new->set_inflated_columns($changes);
$new->insert;
# Its possible we'll have 2 relations to the same Source. We need to make
@@ -748,6 +764,22 @@
}
}
+=head2 id
+
+Returns the primary key(s) for a row. Can't be called as a class method.
+Actually implemented in L<DBIx::Class::Pk>
+
+=head2 discard_changes
+
+Re-selects the row from the database, losing any changes that had
+been made.
+
+This method can also be used to refresh from storage, retrieving any
+changes made since the row was last read from storage. Actually
+implemented in L<DBIx::Class::Pk>
+
+=cut
+
1;
=head1 AUTHORS
Modified: DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Schema.pm 2008-01-11 23:41:05 UTC (rev 3929)
+++ DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Schema.pm 2008-01-11 23:45:03 UTC (rev 3930)
@@ -1059,8 +1059,44 @@
For an example of what you can do with this, see
L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To Your SQL>.
+=head2 thaw
+
+Provided as the recommened way of thawing schema objects. You can call
+C<Storable::thaw> directly if you wish, but the thawed objects will not have a
+reference to any schema, so are rather useless
+
=cut
+sub thaw {
+ my ($self, $obj) = @_;
+ local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
+ return Storable::thaw($obj);
+}
+
+=head2 freeze
+
+This doesn't actualy do anything more than call L<Storable/freeze>, it is just
+provided here for symetry.
+
+=cut
+
+sub freeze {
+ return Storable::freeze($_[1]);
+}
+
+=head2 dclone
+
+Recommeneded way of dcloning objects. This is needed to properly maintain
+references to the schema object (which itself is B<not> cloned.)
+
+=cut
+
+sub dclone {
+ my ($self, $obj) = @_;
+ local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
+ return Storable::dclone($obj);
+}
+
1;
=head1 AUTHORS
Added: DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm (rev 0)
+++ DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm 2008-01-11 23:45:03 UTC (rev 3930)
@@ -0,0 +1,83 @@
+package DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server;
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+sub _prep_for_execute {
+ my $self = shift;
+ my ($op, $extra_bind, $ident, $args) = @_;
+
+ my ($sql, $bind) = $self->SUPER::_prep_for_execute(@_);
+ $sql .= ';SELECT SCOPE_IDENTITY()' if $op eq 'insert';
+
+ return ($sql, $bind);
+}
+
+sub insert {
+ my ($self, $source, $to_insert) = @_;
+
+ my $bind_attributes = $self->source_bind_attributes($source);
+ my (undef, $sth) = $self->_execute( 'insert' => [], $source, $bind_attributes, $to_insert);
+ $self->{_scope_identity} = $sth->fetchrow_array;
+
+ return $to_insert;
+}
+
+sub last_insert_id { shift->{_scope_identity} }
+
+sub sqlt_type { 'SQLServer' }
+
+sub _sql_maker_opts {
+ my ( $self, $opts ) = @_;
+
+ if ( $opts ) {
+ $self->{_sql_maker_opts} = { %$opts };
+ }
+
+ return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} };
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBIx::Class::Storage::ODBC::Microsoft_SQL_Server - Support specific to
+Microsoft SQL Server over ODBC
+
+=head1 DESCRIPTION
+
+This class implements support specific to Microsoft SQL Server over ODBC,
+including auto-increment primary keys and SQL::Abstract::Limit dialect. It
+is loaded automatically by by DBIx::Class::Storage::DBI::ODBC when it
+detects a MSSQL back-end.
+
+=head1 IMPLEMENTATION NOTES
+
+Microsoft SQL Server supports three methods of retrieving the IDENTITY
+value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
+SCOPE_IDENTITY is used here because it is the safest. However, it must
+be called is the same execute statement, not just the same connection.
+
+So, this implementation appends a SELECT SCOPE_IDENTITY() statement
+onto each INSERT to accommodate that requirement.
+
+=head1 METHODS
+
+=head2 insert
+
+=head2 last_insert_id
+
+=head2 sqlt_type
+
+=head1 AUTHORS
+
+Marc Mims C<< <marc at questright.com> >>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
Modified: DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class.pm 2008-01-11 23:41:05 UTC (rev 3929)
+++ DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class.pm 2008-01-11 23:45:03 UTC (rev 3930)
@@ -258,6 +258,8 @@
penguin: K J Cheetham
+perigrin: Chris Prather <chris at prather.org>
+
phaylon: Robert Sedlacek <phaylon at dunkelheit.at>
quicksilver: Jules Bean
Modified: DBIx-Class/0.08/branches/versioned_enhancements/script/dbicadmin
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/script/dbicadmin 2008-01-11 23:41:05 UTC (rev 3929)
+++ DBIx-Class/0.08/branches/versioned_enhancements/script/dbicadmin 2008-01-11 23:45:03 UTC (rev 3930)
@@ -4,11 +4,11 @@
use Getopt::Long;
use Pod::Usage;
-use JSON qw( jsonToObj );
+use JSON::Any qw(JSON);
-$JSON::BareKey = 1;
-$JSON::QuotApos = 1;
+my $json = JSON::Any->new(allow_barekey => 1, allow_singlequote => 1);
+
GetOptions(
'schema=s' => \my $schema_class,
'class=s' => \my $resultset_class,
@@ -50,7 +50,7 @@
die('No schema specified') if(!$schema_class);
eval("require $schema_class");
die('Unable to load schema') if ($@);
-$connect = jsonToObj( $connect ) if ($connect);
+$connect = $json->jsonToObj( $connect ) if ($connect);
my $schema = $schema_class->connect(
( $connect ? @$connect : () )
);
@@ -59,15 +59,15 @@
my $resultset = eval{ $schema->resultset($resultset_class) };
die('Unable to load the class with the schema') if ($@);
-$set = jsonToObj( $set ) if ($set);
-$where = jsonToObj( $where ) if ($where);
-$attrs = jsonToObj( $attrs ) if ($attrs);
+$set = $json->jsonToObj( $set ) if ($set);
+$where = $json->jsonToObj( $where ) if ($where);
+$attrs = $json->jsonToObj( $attrs ) if ($attrs);
if ($op eq 'insert') {
die('Do not use the where option with the insert op') if ($where);
die('Do not use the attrs option with the insert op') if ($attrs);
my $obj = $resultset->create( $set );
- print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n";
+ print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n" if (!$quiet);
}
elsif ($op eq 'update') {
$resultset = $resultset->search( ($where||{}) );
Modified: DBIx-Class/0.08/branches/versioned_enhancements/t/68inflate.t
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/t/68inflate.t 2008-01-11 23:41:05 UTC (rev 3929)
+++ DBIx-Class/0.08/branches/versioned_enhancements/t/68inflate.t 2008-01-11 23:45:03 UTC (rev 3930)
@@ -10,7 +10,7 @@
eval { require DateTime };
plan skip_all => "Need DateTime for inflation tests" if $@;
-plan tests => 20;
+plan tests => 21;
$schema->class('CD')
#DBICTest::Schema::CD
@@ -99,6 +99,10 @@
$cd->discard_changes;
is($cd->year->year, $before_year + 1, 'discard_changes clears the inflated value');
+
+my $copy = $cd->copy({ year => $now, title => "zemoose" });
+
+isnt( $copy->year->year, $before_year, "copy" );
# eval { $cd->store_inflated_column('year', \'year + 1') };
# print STDERR "ERROR: $@" if($@);
Modified: DBIx-Class/0.08/branches/versioned_enhancements/t/746db2_400.t
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/t/746db2_400.t 2008-01-11 23:41:05 UTC (rev 3929)
+++ DBIx-Class/0.08/branches/versioned_enhancements/t/746db2_400.t 2008-01-11 23:45:03 UTC (rev 3930)
@@ -21,7 +21,7 @@
my $dbh = $schema->storage->dbh;
-$dbh->do("DROP TABLE artist", { RaiseError => 0, PrintError => 0 });
+eval { $dbh->do("DROP TABLE artist") };
$dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10))");
Added: DBIx-Class/0.08/branches/versioned_enhancements/t/746mssql.t
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/t/746mssql.t (rev 0)
+++ DBIx-Class/0.08/branches/versioned_enhancements/t/746mssql.t 2008-01-11 23:45:03 UTC (rev 3930)
@@ -0,0 +1,63 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
+
+plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
+ unless ($dsn && $user);
+
+plan tests => 12;
+
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1});
+
+$schema->storage->ensure_connected;
+isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
+
+my $dbh = $schema->storage->dbh;
+
+eval { $dbh->do("DROP TABLE artist") };
+
+ $dbh->do(<<'');
+CREATE TABLE artist (
+ artistid INT IDENTITY NOT NULL,
+ name VARCHAR(255),
+ charfield CHAR(10),
+ primary key(artistid)
+)
+
+my %seen_id;
+
+# test primary key handling
+my $new = $schema->resultset('Artist')->create({ name => 'foo' });
+ok($new->artistid > 0, "Auto-PK worked");
+
+$seen_id{$new->artistid}++;
+
+# test LIMIT support
+for (1..6) {
+ $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
+ is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
+ $seen_id{$new->artistid}++;
+}
+
+my $it = $schema->resultset('Artist')->search( {}, {
+ rows => 3,
+ order_by => 'artistid',
+});
+
+is( $it->count, 3, "LIMIT count ok" );
+is( $it->next->name, "foo", "iterator->next ok" );
+$it->next;
+is( $it->next->name, "Artist 2", "iterator->next ok" );
+is( $it->next, undef, "next past end of resultset ok" );
+
+
+# clean up our mess
+END {
+ $dbh->do('DROP TABLE artist') if $dbh;
+}
+
Modified: DBIx-Class/0.08/branches/versioned_enhancements/t/84serialize.t
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/t/84serialize.t 2008-01-11 23:41:05 UTC (rev 3929)
+++ DBIx-Class/0.08/branches/versioned_enhancements/t/84serialize.t 2008-01-11 23:45:03 UTC (rev 3930)
@@ -8,9 +8,25 @@
my $schema = DBICTest->init_schema();
-plan tests => 1;
+plan tests => 6;
my $artist = $schema->resultset('Artist')->find(1);
-my $copy = eval { Storable::dclone($artist) };
-is_deeply($copy, $artist, 'serialize row object works');
+{
+ my $copy = $schema->dclone($artist);
+ is_deeply($copy, $artist, "dclone row object works");
+ eval { $copy->discard_changes };
+ ok( !$@, "discard_changes okay" );
+ is($copy->id, $artist->id, "IDs still match ");
+}
+
+{
+ my $ice = $schema->freeze($artist);
+ my $copy = $schema->thaw($ice);
+ is_deeply($copy, $artist, 'dclone row object works');
+
+ eval { $copy->discard_changes };
+ ok( !$@, "discard_changes okay" );
+ is($copy->id, $artist->id, "IDs still okay");
+}
+
Modified: DBIx-Class/0.08/branches/versioned_enhancements/t/89dbicadmin.t
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/t/89dbicadmin.t 2008-01-11 23:41:05 UTC (rev 3929)
+++ DBIx-Class/0.08/branches/versioned_enhancements/t/89dbicadmin.t 2008-01-11 23:45:03 UTC (rev 3930)
@@ -19,26 +19,31 @@
plan tests => 5;
-# double quotes round the arguments and single-quote within to make sure the
-# tests run on windows as well
+# the script supports double quotes round the arguments and single-quote within
+# to make sure it runs on windows as well, but only if JSON::Any picks the right module
+
+
my $employees = $schema->resultset('Employee');
-my $cmd = qq|$^X script/dbicadmin --schema=DBICTest::Schema --class=Employee --tlibs --connect="['dbi:SQLite:dbname=t/var/DBIxClass.db','','',{AutoCommit:1}]" --force --tlibs|;
+my @cmd = ($^X, qw|script/dbicadmin --quiet --schema=DBICTest::Schema --class=Employee --tlibs|, q|--connect=["dbi:SQLite:dbname=t/var/DBIxClass.db","","",{"AutoCommit":1}]|, qw|--force --tlibs|);
-`$cmd --op=insert --set="{name:'Matt'}"`;
+system(@cmd, qw|--op=insert --set={"name":"Matt"}|);
ok( ($employees->count()==1), 'insert count' );
my $employee = $employees->find(1);
ok( ($employee->name() eq 'Matt'), 'insert valid' );
-`$cmd --op=update --set="{name:'Trout'}"`;
+system(@cmd, qw|--op=update --set={"name":"Trout"}|);
$employee = $employees->find(1);
ok( ($employee->name() eq 'Trout'), 'update' );
-`$cmd --op=insert --set="{name:'Aran'}"`;
-my $data = `$cmd --op=select --attrs="{order_by:'name'}"`;
+system(@cmd, qw|--op=insert --set={"name":"Aran"}|);
+
+open(my $fh, "-|", @cmd, qw|--op=select --attrs={"order_by":"name"}|) or die $!;
+my $data = do { local $/; <$fh> };
+close($fh);
ok( ($data=~/Aran.*Trout/s), 'select with attrs' );
-`$cmd --op=delete --where="{name:'Trout'}"`;
+system(@cmd, qw|--op=delete --where={"name":"Trout"}|);
ok( ($employees->count()==1), 'delete' );
More information about the Bast-commits
mailing list