[Rt-commit] r3883 - in Jifty-DBI/trunk: . lib/Jifty/DBI
lib/Jifty/DBI/Filter lib/Jifty/DBI/Handle t
jesse at bestpractical.com
jesse at bestpractical.com
Sat Sep 24 17:03:37 EDT 2005
Author: jesse
Date: Sat Sep 24 17:03:35 2005
New Revision: 3883
Modified:
Jifty-DBI/trunk/ (props changed)
Jifty-DBI/trunk/lib/Jifty/DBI/Column.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Filter.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Filter/DateTime.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Filter/Truncate.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Filter/utf8.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Handle.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Pg.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/SQLite.pm
Jifty-DBI/trunk/lib/Jifty/DBI/HasFilters.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm
Jifty-DBI/trunk/t/01records.t
Jifty-DBI/trunk/t/06filter.t
Jifty-DBI/trunk/t/06filter_datetime.t
Jifty-DBI/trunk/t/06filter_truncate.t
Jifty-DBI/trunk/t/06filter_utf8.t
Jifty-DBI/trunk/t/utils.pl
Log:
r15983 at hualien: jesse | 2005-09-24 17:02:50 -0400
*Reverting the patch from ruslan, as he would prefer to send smaller patches
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Column.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Column.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Column.pm Sat Sep 24 17:03:35 2005
@@ -3,9 +3,10 @@
package Jifty::DBI::Column;
-use base qw/Class::Accessor Jifty::DBI::HasFilters/;
+use base qw/Class::Accessor/;
use UNIVERSAL::require;
+
__PACKAGE__->mk_accessors qw/
name
type
@@ -16,9 +17,12 @@
length
refers_to_collection_class
refers_to_record_class
- alias_for_column
+ alias_for_column
+ filters
+ output_filters
/;
+# input_filters
=head1 NAME
@@ -56,4 +60,51 @@
*write = \&writable;
+sub decode_value {
+ my $self = shift;
+ my $value_ref = shift;
+ $self->_apply_filters( value_ref => $value_ref,
+ filters => $self->output_filters,
+ action => 'decode'
+ );
+}
+
+sub input_filters {
+ my $self = shift;
+
+ return (['Jifty::DBI::Filter::Truncate']);
+
+}
+
+
+
+sub encode_value {
+ my $self = shift;
+ my $value_ref = shift;
+ $self->_apply_filters( value_ref => $value_ref,
+ filters =>
+ $self->input_filters,
+ action => 'encode'
+ );
+}
+
+
+sub _apply_filters {
+ my $self = shift;
+ my %args = (
+ value_ref => undef,
+ filters => undef,
+ action => undef,
+ @_
+ );
+ my $action = $args{'action'};
+ foreach my $filter_class ( @{ $args{filters} } ) {
+ $filter_class->require();
+ my $filter = $filter_class->new( column => $self, value_ref => $args{'value_ref'});
+ # XXX TODO error proof this
+ $filter->$action();
+ }
+}
+
+
1;
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Filter.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Filter.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Filter.pm Sat Sep 24 17:03:35 2005
@@ -4,7 +4,7 @@
package Jifty::DBI::Filter;
use base 'Class::Accessor';
-__PACKAGE__->mk_accessors(qw(record column value_ref));
+__PACKAGE__->mk_accessors(qw(column value_ref));
=head2 new
@@ -52,8 +52,12 @@
from flattening a L<DateTime> object into an ISO date to making sure
that data is utf8 clean.
+
+
+
=cut
+
sub encode {
}
@@ -64,6 +68,7 @@
from flattening a L<DateTime> object into an ISO date to making sure
that data is utf8 clean.
+
=cut
sub decode {
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Filter/DateTime.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Filter/DateTime.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Filter/DateTime.pm Sat Sep 24 17:03:35 2005
@@ -1,75 +0,0 @@
-package Jifty::DBI::Filter::DateTime;
-
-use warnings;
-use strict;
-
-use base qw(Jifty::DBI::Filter);
-use DateTime::Format::Strptime;
-
-=head1 NAME
-
-Jifty::DBI::Filter::DateTime - DateTime object wrapper around date fields
-
-=head1 DESCRIPTION
-
-This filter allow you to work with DateTime objects instead of
-plain text dates.
-
-=head2 encode
-
-If value is DateTime object then converts it into ISO format
-C<YYYY-MM-DD hh:mm:ss>. Does nothing if value is not defined
-or string.
-
-=cut
-
-sub encode {
- my $self = shift;
-
- my $value_ref = $self->value_ref;
- return unless $$value_ref;
-
- return unless UNIVERSAL::isa( $$value_ref, 'DateTime' );
-
- $$value_ref = $$value_ref->strftime( "%Y-%m-%d %H:%M:%S" );
-
- return 1;
-}
-
-=head2 decode
-
-If value is defined then converts it into DateTime object otherwise
-do nothing.
-
-=cut
-
-sub decode {
- my $self = shift;
-
- my $value_ref = $self->value_ref;
- return unless defined $$value_ref;
-
- # XXX: Looks like we should use special modules for parsing DT because
- # different MySQL versions can return DT in different formats(none strict ISO)
- # Pg has also special format that depends on "european" and
- # server time_zone, by default ISO
- # other DBs may have own formats(Interbase for example can be forced to use special format)
- # but we need Jifty::DBI::Handle here to get DB type
- my $parser = DateTime::Format::Strptime->new(
- pattern => '%Y-%m-%d %H:%M:%S',
- );
- my $dt = $parser->parse_datetime( $$value_ref );
- if( $dt ) {
- $$value_ref = $dt;
- } else {
- return;
- }
-}
-
-=head1 SEE ALSO
-
-L<Jifty::DBI::Filter>, L<DateTime>
-
-=cut
-
-1;
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Filter/Truncate.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Filter/Truncate.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Filter/Truncate.pm Sat Sep 24 17:03:35 2005
@@ -4,7 +4,6 @@
package Jifty::DBI::Filter::Truncate;
use base qw/Jifty::DBI::Filter/;
-use Encode ();
sub encode {
my $self = shift;
@@ -24,16 +23,31 @@
return unless ($truncate_to); # don't need to truncate
- my $utf8 = Encode::is_utf8( $$value_ref );
- {
- use bytes;
- $$value_ref = substr( $$value_ref, 0, $truncate_to );
+ # Perl 5.6 didn't speak unicode
+ $$value_ref = substr( $$value_ref, 0, $truncate_to )
+ unless ( $] >= 5.007 );
+
+ require Encode;
+
+ if ( Encode::is_utf8( $$value_ref ) ) {
+ $$value_ref = Encode::decode(
+ utf8 => substr(
+ Encode::encode( utf8 => $$value_ref ),
+ 0, $truncate_to
+ ),
+ Encode::FB_QUIET(),
+ );
}
- if( $utf8 ) {
- # return utf8 flag back, but use Encode::FB_QUIET because
- # we could broke tail char
- $$value_ref = Encode::decode_utf8( $$value_ref, Encode::FB_QUIET );
+ else {
+ $$value_ref = Encode::encode(
+ utf8 => Encode::decode(
+ utf8 => substr( $$value_ref, 0, $truncate_to ),
+ Encode::FB_QUIET(),
+ )
+ );
+
}
+
}
1;
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Filter/utf8.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Filter/utf8.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Filter/utf8.pm Sat Sep 24 17:03:35 2005
@@ -1,81 +0,0 @@
-
-use strict;
-use warnings;
-
-package Jifty::DBI::Filter::utf8;
-use base qw/Jifty::DBI::Filter/;
-use Encode ();
-
-=head1 NAME
-
-Jifty::DBI::Filter::utf8 - Jifty::DBI UTF-8 data filter
-
-=head1 DESCRIPTION
-
-This filter allow you to check that you operate with
-valid UTF-8 data.
-
-Usage as type specific filter is recommneded.
-
-=head1 METHODS
-
-=head2 encode
-
-No special arguments.
-
-Method always unset UTF-8 flag on the value, but
-if value doesn't have flag then method checks
-value for malformed UTF-8 data and stop on
-the first bad code.
-
-=cut
-
-sub encode {
- my $self = shift;
-
- my $value_ref = $self->value_ref;
- return undef unless ( defined( $$value_ref ) );
-
- if( Encode::is_utf8( $$value_ref ) ) {
- $$value_ref = Encode::encode_utf8( $$value_ref );
- } else {
- # if value has no utf8 flag but filter on the stack
- # we do double encoding, and stop on the first bad characters
- # with FB_QUIET fallback schema. We this schema because we
- # don't want data grow
- $$value_ref = Encode::encode_utf8( Encode::decode_utf8( $$value_ref, Encode::FB_QUIET ) );
- }
- return 1;
-}
-
-=head2 decode
-
-No special arguments.
-
-Checks whether value is correct UTF-8 data or not and
-substitute all malformed data with 0xFFFD code point.
-
-Always set UTF-8 flag on the value.
-
-=cut
-
-sub decode {
- my $self = shift;
-
- my $value_ref = $self->value_ref;
- return undef unless ( defined( $$value_ref ) );
-
- unless( Encode::is_utf8( $$value_ref ) ) {
- $$value_ref = Encode::decode_utf8( $$value_ref );
- }
- return 1;
-}
-
-1;
-__END__
-
-=head1 SEE ALSO
-
-L<Jifty::DBI::Filter>, L<perlunicode>
-
-=cut
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Handle.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Handle.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle.pm Sat Sep 24 17:03:35 2005
@@ -1,13 +1,11 @@
package Jifty::DBI::Handle;
use strict;
use Carp;
-use DBI ();
-use Class::ReturnValue ();
-use Encode ();
+use DBI;
+use Class::ReturnValue;
+use Encode;
-use base qw/Jifty::DBI::HasFilters/;
-
-use vars qw($VERSION %DBIHandle $PrevHandle $DEBUG $TRANSDEPTH);
+use vars qw($VERSION @ISA %DBIHandle $PrevHandle $DEBUG $TRANSDEPTH);
$TRANSDEPTH = 0;
@@ -561,18 +559,13 @@
sub database_version {
my $self = shift;
- my %args = ( short => 1, @_ );
- unless( defined $self->{'database_version'} ) {
+ unless ( $self->{'database_version'} ) {
my $statement = "SELECT VERSION()";
my $sth = $self->simple_query($statement);
- unless( $sth ) {
- return( $self->{'database_version'} = '' );
- }
- my $ver = ($sth->fetchrow_array())[0];
- $self->{'database_version'} = $ver;
+ my @vals = $sth->fetchrow();
+ $self->{'database_version'} = $vals[0];
}
- return $self->{'database_version'};
}
=head2 case_sensitive
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Pg.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Pg.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Pg.pm Sat Sep 24 17:03:35 2005
@@ -40,28 +40,12 @@
return ($DBIHandle);
}
-=head2 database_version
-
-=cut
-
-sub database_version {
- my $self = shift;
- my %args = ( short => 1, @_ );
-
- my $ver = $self->SUPER::database_version( %args );
- if( $args{'short'} && $ver =~ /(\d+(?:\.\d+)*(?:-[a-z0-9]+)?)/i ) {
- $ver = $1;
- }
-
- return $ver;
-}
-
=head2 insert
Takes a table name as the first argument and assumes that the rest of
the arguments are an array of key-value pairs to be inserted.
-In case of insert failure, returns a L<Class::ReturnValue> object
+In case of isnert failure, returns a L<Class::ReturnValue> object
preloaded with error info
=cut
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/SQLite.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Handle/SQLite.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/SQLite.pm Sat Sep 24 17:03:35 2005
@@ -20,18 +20,8 @@
=head1 METHODS
-=head2
-
-Returns the version of the SQLite library which is used, e.g., "2.8.0".
-
=cut
-sub database_version {
- my $self = shift;
- return undef unless $self->dbh;
- return $self->dbh->{sqlite_version} || '';
-}
-
=head2 insert
Takes a table name as the first argument and assumes that the rest of the arguments
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/HasFilters.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/HasFilters.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/HasFilters.pm Sat Sep 24 17:03:35 2005
@@ -1,79 +0,0 @@
-package Jifty::DBI::HasFilters;
-
-use warnings;
-use strict;
-
-use base qw/Class::Accessor/;
-__PACKAGE__->mk_accessors qw/
- input_filters
- output_filters
- /;
-
-=head1 NAME
-
-Jifty::DBI::HasFilters - abstract class for objects that has filters
-
-=head1 SYNOPSYS
-
- my $record = Jifty::DBI::Record->new(...);
- $record->input_filters( 'Jifty::DBI::Filter::Truncate',
- 'Jifty::DBI::Filter::utf8'
- );
- my @filters = $record->output_filters;
-
-=head1 DESCRIPTION
-
-This abstract class provide generic interface for setting and getting
-input and output data filters for L<Jifty::DBI> objects.
-You shouldn't use it directly, but L<Jifty::DBI::Handle>, L<Jifty::DBI::Record>
-and L<Jifty::DBI::Column> classes inherit this interface.
-
-
-=head1 METHODS
-
-=head2 input_filters
-
-Returns array of the input filters, if arguments list is not empty
-then set input filter.
-
-=cut
-
-sub input_filters {
- my $self = shift;
- if( @_ ) { # setting
- my @values = map { UNIVERSAL::isa($_, 'ARRAY')? @$_: $_ } @_;
- return $self->_input_filters_accessor( @values );
- }
-
- return grep $_, $self->_input_filters_accessor;
-}
-
-=head2 output_filters
-
-Deals similar with list of output filters, but unless
-you defined own list returns reversed list of the input
-filters. In common situation you don't need to define
-own list of output filters, but use this method to get
-default list based on the input list.
-
-=cut
-
-sub output_filters {
- my $self = shift;
- if( @_ ) { # setting
- $self->_output_filters_accessor( @_ );
- }
-
- my @values = grep $_, $self->_output_filters_accessor;
- return @values if @values;
-
- return reverse $self->input_filters
-}
-
-=head1 SEE ALSO
-
-L<Jifty::DBI::Filter>
-
-=cut
-
-1;
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm Sat Sep 24 17:03:35 2005
@@ -5,13 +5,11 @@
use vars qw($AUTOLOAD);
use Class::ReturnValue;
+use Lingua::EN::Inflect;
use Jifty::DBI::Column;
use UNIVERSAL::require;
-use base qw/
- Class::Data::Inheritable
- Jifty::DBI::HasFilters
- /;
+use base qw/Class::Data::Inheritable/;
Jifty::DBI::Record->mk_classdata('COLUMNS');
@@ -242,7 +240,6 @@
bless( $self, $class );
$self->_init_columns() unless $self->COLUMNS;
- $self->input_filters( 'Jifty::DBI::Filter::Truncate' );
$self->_init(@_);
@@ -455,29 +452,31 @@
for my $column_name ( keys %$schema ) {
my $column = $self->add_column($column_name);
- my $meta = $schema->{ $column_name } || {};
+ # Default, everything readable and writable
+ $column->readable(1);
- # Default, everything readable
- $column->readable( delete $meta->{'read'} || 1 );
+ if ( $schema->{$column_name}{'read'} ) {
+ $column->readable( $schema->{$column_name}{'read'});
+ } else {
+ $column->readable(1);
+ }
- # Default, everything writable except columns of the pkey
- if ( $meta->{'write'} ) {
- $column->writable( $meta->{'write'} );
+ if ( $schema->{$column_name}{'write'} ) {
+ $column->writable( $schema->{$column_name}{'write'});
} elsif (not defined $column->writable) { # don't want to make pkeys writable
$column->writable(1);
}
- delete $meta->{'write'};
+
# Next time, all-lower hash keys
- my $type = delete $meta->{'type'} ||
- delete $meta->{'TYPE'};
+ my $type = $schema->{$column_name}{'type'} || $schema->{$column_name}{'TYPE'};
if ($type) {
$column->type($type);
+
}
- my $refclass = delete $meta->{'REFERENCES'} ||
- delete $meta->{'references'};
+ my $refclass = $schema->{$column_name}{'REFERENCES'} || $schema->{$column_name}{'references'};
if ($refclass) {
$refclass->require();
@@ -487,7 +486,7 @@
my $virtual_column = $self->add_column($1);
$virtual_column->refers_to_record_class($refclass);
$virtual_column->alias_for_column($column_name);
- $virtual_column->readable( delete $meta->{'read'} || 1);
+ $virtual_column->readable( $schema->{$column_name}{'read'} || 1);
}
else {
$column->refers_to_record_class($refclass);
@@ -501,10 +500,6 @@
warn "Error: $refclass neither Record nor Collection";
}
}
- for my $attr( keys %$meta) {
- next unless $column->can( $attr );
- $column->$attr( $meta->{$attr} );
- }
}
}
@@ -587,7 +582,8 @@
sub column {
my $self = shift;
- my $name = lc( shift || '');
+ my $name = shift;
+ $name = lc $name;
return undef unless $self->COLUMNS and $self->COLUMNS->{$name};
return $self->COLUMNS->{$name} ;
@@ -655,16 +651,10 @@
my ($value) = eval { $sth->fetchrow_array() };
warn $@ if $@;
+ $column->decode_value(\$value);
$self->{'values'}{$column->name} = $value;
$self->{'fetched'}{$column->name} = 1;
}
- if( $self->{'fetched'}{$column->name} &&
- !$self->{'decoded'}{$column->name} ) {
- $self->_apply_output_filters( column => $column,
- value_ref => \$self->{'values'}{$column->name},
- );
- $self->{'decoded'}{$column->name} = 1;
- }
return $self->{'values'}{$column->name};
}
@@ -723,26 +713,34 @@
return ( $ret->return_value );
}
- $self->_apply_input_filters( column => $column, value_ref => \$args{'value'} );
+
+ $column->encode_value(\$args{'value'});
- # if value is not fetched or it's allready decoded
- # then we don't check eqality
- # we also don't call __value cause it's decode value
- if ( $self->{'fetched'}{$column->name} ||
- !$self->{'decoded'}{$column->name} ) {
- if( ( !defined $args{'value'} && !defined $self->{'values'}{$column->name} ) ||
- ( defined $args{'value'} && defined $self->{'values'}{$column->name} &&
- $args{'value'} eq $self->{'values'}{$column->name} ) ) {
- $ret->as_array( 0, "That is already the current value" );
- $ret->as_error(
- errno => 1,
- do_backtrace => 0,
- message => "That is already the current value"
- );
- return ( $ret->return_value );
- }
+
+ if ( !defined( $args{'value'} ) ) {
+ $ret->as_array( 0, "No value passed to _set" );
+ $ret->as_error(
+ errno => 2,
+ do_backtrace => 0,
+ message => "No value passed to _set"
+ );
+ return ( $ret->return_value );
+ }
+ elsif ( ( defined $self->__value($column->name) )
+ and ( $args{'value'} eq $self->__value($column->name) ) )
+ {
+ $ret->as_array( 0, "That is already the current value" );
+ $ret->as_error(
+ errno => 1,
+ do_backtrace => 0,
+ message => "That is already the current value"
+ );
+ return ( $ret->return_value );
}
+
+
+
my $method = "validate_" . $column->name;
unless ( $self->$method( $args{'value'} ) ) {
$ret->as_array( 0, 'Illegal value for ' . $column->name);
@@ -795,7 +793,6 @@
}
else {
$self->{'values'}->{$column->name} = $unmunged_value;
- $self->{'decoded'}{$column->name} = 0;
}
$ret->as_array( 1, "The new value has been set." );
return ( $ret->return_value );
@@ -953,7 +950,6 @@
$self->{'values'} = $sth->fetchrow_hashref;
$self->{'fetched'} = {};
- $self->{'decoded'} = {};
if ( !$self->{'values'} && $sth->err ) {
return ( 0, "Couldn't fetch row: " . $sth->err );
}
@@ -998,9 +994,7 @@
}
- $self->_apply_input_filters( column => $column,
- value_ref => \$attribs{$column_name},
- );
+ $column->encode_value( \$attribs{$column_name});
}
unless ( $self->_handle->knows_blobs ) {
@@ -1084,12 +1078,7 @@
my $table = $1;
$table =~ s/(?<=[a-z])([A-Z]+)/"_" . lc($1)/eg;
$table =~ tr/A-Z/a-z/;
- local $@;
- if( eval { require Lingua::EN::Inflect } ) {
- $table = Lingua::EN::Inflect::PL_N($table);
- } else {
- # here is simple rules without Lingua::*
- }
+ $table = Lingua::EN::Inflect::PL_N($table);
$self->{__table_name} = $table;
}
return $self->{__table_name};
@@ -1123,53 +1112,6 @@
sub schema {}
-sub _filters
-{
- my $self = shift;
- my %args = ( direction => 'input', column => undef, @_ );
-
- my @filters = ();
- my @objs = ($self, $args{'column'}, $self->_handle);
- @objs = reverse @objs if $args{'direction'} eq 'output';
- my $method = $args{'direction'} ."_filters";
- foreach my $obj( @objs ) {
- push @filters, $obj->$method();
- }
- return grep $_, @filters;
-}
-
-sub _apply_input_filters {
- return (shift)->_apply_filters(direction => 'input', @_);
-}
-sub _apply_output_filters {
- return (shift)->_apply_filters(direction => 'output', @_);
-}
-sub _apply_filters {
- my $self = shift;
- my %args = ( direction => 'input',
- column => undef,
- value_ref => undef,
- @_
- );
-
- my @filters = $self->_filters( %args );
- my $action = $args{'direction'} eq 'output'? 'decode' : 'encode';
- foreach my $filter_class ( @filters ) {
- local $UNIVERSAL::require::ERROR;
- $filter_class->require();
- if( $UNIVERSAL::require::ERROR ) {
- warn $UNIVERSAL::require::ERROR;
- next;
- }
- my $filter = $filter_class->new( record => $self,
- column => $args{'column'},
- value_ref => $args{'value_ref'},
- );
- # XXX TODO error proof this
- $filter->$action();
- }
-}
-
1;
__END__
Modified: Jifty-DBI/trunk/t/01records.t
==============================================================================
--- Jifty-DBI/trunk/t/01records.t (original)
+++ Jifty-DBI/trunk/t/01records.t Sat Sep 24 17:03:35 2005
@@ -8,7 +8,7 @@
BEGIN { require "t/utils.pl" }
our (@available_drivers);
-use constant TESTS_PER_DRIVER => 61;
+use constant TESTS_PER_DRIVER => 63;
my $total = scalar(@available_drivers) * TESTS_PER_DRIVER;
plan tests => $total;
@@ -80,14 +80,19 @@
is($rec->name, '12345678901234', "Truncated on update");
+# Test unicode truncation:
+ my $univalue = "這是個測試";
+ ($val,$msg) = $rec->set_name($univalue.$univalue);
+ ok($val, $msg) ;
+ is($rec->name, '這是個測');
+
+
+
# make sure we do _not_ truncate things which should not be truncated
($val,$msg) = $rec->set_employee_id('1234567890');
ok($val, $msg) ;
is($rec->employee_id, '1234567890', "Did not truncate id on create");
- #delete prev record
- $rec->delete;
-
# make sure we do truncation on create
my $newrec = TestApp::Address->new($handle);
my $newid = $newrec->create( name => '1234567890123456789012345678901234567890',
@@ -176,11 +181,10 @@
is( ($val->as_array)[1], 'Illegal value for name', "correct error message" );
is( $rec->name, 'Obra', "old value is still there");
# XXX TODO FIXME: this test cover current implementation that is broken //RUZ
-# fixed, now we can set undef values(NULLs)
$val = $rec->set_name( );
- isa_ok( $val, 'Class::ReturnValue', "set empty/undef/NULL value");
- is( ($val->as_array)[1], "The new value has been set.", "correct error message" );
- is( $rec->name, undef, "new value is undef, NULL in DB");
+ isa_ok( $val, 'Class::ReturnValue', "couldn't set empty/undef value, error returned");
+ is( ($val->as_array)[1], "No value passed to _set", "correct error message" );
+ is( $rec->name, 'Obra', "old value is still there");
# deletes
$newrec = TestApp::Address->new($handle);
@@ -204,7 +208,7 @@
sub validate_name
{
my ($self, $value) = @_;
- return 0 if $value && $value =~ /invalid/i;
+ return 0 if $value =~ /invalid/i;
return 1;
}
Modified: Jifty-DBI/trunk/t/06filter.t
==============================================================================
--- Jifty-DBI/trunk/t/06filter.t (original)
+++ Jifty-DBI/trunk/t/06filter.t Sat Sep 24 17:03:35 2005
@@ -1,27 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-
-use Test::More;
-BEGIN { require "t/utils.pl" }
-plan tests => 6;
-# test for Jifty::DBI::Filter class only
-# create new t/06filter_*.t files for specific filters
-
-# DB independat tests
-use_ok('Jifty::DBI::Filter');
-my $filter = new Jifty::DBI::Filter;
-isa_ok( $filter, 'Jifty::DBI::Filter' );
-is( $filter->column, undef, "empty column value" );
-is( $filter->value_ref, undef, "empty value reference" );
-
-$filter->column( 'my column' );
-is( $filter->column, 'my column', "successfuly set column" );
-$filter->value_ref( 'my value_ref' );
-is( $filter->value_ref, 'my value_ref', "successfuly set value_ref" );
-
-# methods do nothing, but just in case
-$filter->decode;
-$filter->encode;
-
-1;
Modified: Jifty-DBI/trunk/t/06filter_datetime.t
==============================================================================
--- Jifty-DBI/trunk/t/06filter_datetime.t (original)
+++ Jifty-DBI/trunk/t/06filter_datetime.t Sat Sep 24 17:03:35 2005
@@ -1,108 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-
-use Test::More;
-BEGIN { require "t/utils.pl" }
-our (@available_drivers);
-
-use constant TESTS_PER_DRIVER => 11;
-
-my $total = scalar(@available_drivers) * TESTS_PER_DRIVER;
-plan tests => $total;
-
-use DateTime ();
-
-foreach my $d ( @available_drivers ) {
-SKIP: {
- unless( has_schema( 'TestApp::User', $d ) ) {
- skip "No schema for '$d' driver", TESTS_PER_DRIVER;
- }
- unless( should_test( $d ) ) {
- skip "ENV is not defined for driver '$d'", TESTS_PER_DRIVER;
- }
- diag("start testing with '$d' handle") if $ENV{TEST_VERBOSE};
-
- my $handle = get_handle( $d );
- connect_handle( $handle );
- isa_ok($handle->dbh, 'DBI::db');
-
- my $ret = init_schema( 'TestApp::User', $handle );
- isa_ok($ret,'DBI::st', "Inserted the schema. got a statement handle back");
-
- my $rec = TestApp::User->new($handle);
- isa_ok($rec, 'Jifty::DBI::Record');
-
- my $now = time;
- my $dt = DateTime->from_epoch( epoch => $now );
- my($id) = $rec->create( created => $dt );
- ok($id, "Successfuly created ticket");
- ok($rec->load($id), "Loaded the record");
- is($rec->id, $id, "The record has its id");
- isa_ok($rec->created, 'DateTime' );
- is( $rec->created->epoch, $now, "Correct value");
-
- # undef/NULL
- $rec->set_created;
- is($rec->created, undef, "Set undef value" );
-
- # from string
- require POSIX;
- $rec->set_created( POSIX::strftime( "%Y-%m-%d %H:%M:%S", gmtime($now) ) );
- isa_ok($rec->created, 'DateTime' );
- is( $rec->created->epoch, $now, "Correct value");
-}
-}
-
-package TestApp::User;
-
-use base qw/Jifty::DBI::Record/;
-
-sub schema {
-
- {
-
- id => { TYPE => 'int(11)' },
- created => { TYPE => 'datetime',
- input_filters => 'Jifty::DBI::Filter::DateTime',
- },
-
- }
-
-}
-
-sub schema_sqlite {
-
-<<EOF;
-CREATE TABLE users (
- id integer primary key,
- created datetime
-)
-EOF
-
-}
-
-sub schema_mysql {
-
-<<EOF;
-CREATE TEMPORARY TABLE users (
- id integer auto_increment primary key,
- created datetime
-)
-EOF
-
-}
-
-sub schema_pg {
-
-<<EOF;
-CREATE TEMPORARY TABLE users (
- id serial primary key,
- created timestamp
-)
-EOF
-
-}
-
-1;
-
Modified: Jifty-DBI/trunk/t/06filter_truncate.t
==============================================================================
--- Jifty-DBI/trunk/t/06filter_truncate.t (original)
+++ Jifty-DBI/trunk/t/06filter_truncate.t Sat Sep 24 17:03:35 2005
@@ -1,145 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-
-use Test::More;
-BEGIN { require "t/utils.pl" }
-our (@available_drivers);
-
-use constant TESTS_PER_DRIVER => 15;
-
-my $total = scalar(@available_drivers) * TESTS_PER_DRIVER;
-plan tests => $total;
-
-foreach my $d ( @available_drivers ) {
-SKIP: {
- unless( should_test( $d ) ) {
- skip "ENV is not defined for driver '$d'", TESTS_PER_DRIVER;
- }
- diag("start testing with '$d' handle") if $ENV{TEST_VERBOSE};
- my $handle = get_handle( $d );
- connect_handle( $handle );
- isa_ok($handle->dbh, 'DBI::db');
-
- unless( has_schema( 'TestApp::User', $handle ) ) {
- skip "No schema for '$d' driver", TESTS_PER_DRIVER - 1;
- }
-
- my $ret = init_schema( 'TestApp::User', $handle );
- isa_ok($ret,'DBI::st', "Inserted the schema. got a statement handle back");
-
- my $rec = TestApp::User->new($handle);
- isa_ok($rec, 'Jifty::DBI::Record');
-
- # name would be truncated
- my($id) = $rec->create( login => "obra", name => "Jesse Vincent" );
- ok($id, "Successfuly created ticket");
- ok($rec->load($id), "Loaded the record");
- is($rec->id, $id, "The record has its id");
- is($rec->login, 'obra', "Login is not truncated" );
- is($rec->name, 'Jesse Vinc', "But name is truncated" );
-
- # UTF-8 string with flag set
- use Encode ();
- ($id) = $rec->create( login => "\x{442}\x{435}\x{441}\x{442}", name => "test" );
- ok($id, "Successfuly created ticket");
- ok($rec->load($id), "Loaded the record");
- is($rec->id, $id, "The record has its id");
- is(Encode::decode_utf8($rec->login), "\x{442}\x{435}", "Login is truncated to two UTF-8 chars" );
- is($rec->name, 'test', "Name is not truncated" );
-
-# this test fails on Pg because it doesn't like data that
-# has bytes in unsupported encoding, we should use 'bytea'
-# type for this test, but we don't have coverage for this
-# # scalar with cp1251 octets
-# $str = "\x{442}\x{435}\x{441}\x{442}\x{442}\x{435}\x{441}\x{442}";
-# $str = Encode::encode('cp1251', $str);
-# ($id) = $rec->create( login => $str, name => "test" );
-# ok($id, "Successfuly created ticket");
-# ok($rec->load($id), "Loaded the record");
-# is($rec->id, $id, "The record has its id");
-# is($rec->login, "\xf2\xe5\xf1\xf2\xf2", "Login is truncated to five octets" );
-# is($rec->name, 'test', "Name is not truncated" );
-
- # check that filter also work for set_* operations
- $rec->set_login( 'ruz' );
- $rec->set_name( 'Ruslan Zakirov' );
- is($rec->login, "ruz", "Login is not truncated" );
- is($rec->name, 'Ruslan Zak', "Name is truncated" );
-}
-}
-
-package TestApp::User;
-
-use base qw/Jifty::DBI::Record/;
-
-sub schema {
-
- {
-
- id => { TYPE => 'int(11)' },
-# special small lengths to test truncation
- login => { TYPE => 'varchar(5)', DEFAULT => ''},
- name => { TYPE => 'varchar(10)', length => 10, DEFAULT => ''},
- disabled => { TYPE => 'int(4)', length => 4, DEFAULT => 0},
-
- }
-
-}
-
-sub schema_sqlite {
-
-<<EOF;
-CREATE TABLE users (
- id integer primary key,
- login char(5),
- name varchar(10),
- disabled int(4) default 0
-)
-EOF
-
-}
-
-sub schema_mysql {
-
-<<EOF;
-CREATE TEMPORARY TABLE users (
- id integer auto_increment primary key,
- login char(5),
- name varchar(10),
- disabled int(4) default 0
-)
-EOF
-
-}
-
-sub schema_mysql_4_1 {
-
-<<EOF;
-CREATE TEMPORARY TABLE users (
- id integer auto_increment primary key,
- login binary(5),
- name varbinary(10),
- disabled int(4) default 0
-)
-EOF
-
-}
-
-# XXX: Pg adds trailing spaces to CHAR columns
-# when other don't, must be fixed for consistency
-sub schema_pg {
-
-<<EOF;
-CREATE TEMPORARY TABLE users (
- id serial primary key,
- login varchar(5),
- name varchar(10),
- disabled integer default 0
-)
-EOF
-
-}
-
-1;
-
Modified: Jifty-DBI/trunk/t/06filter_utf8.t
==============================================================================
--- Jifty-DBI/trunk/t/06filter_utf8.t (original)
+++ Jifty-DBI/trunk/t/06filter_utf8.t Sat Sep 24 17:03:35 2005
@@ -1,142 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-
-use Test::More;
-BEGIN { require "t/utils.pl" }
-our (@available_drivers);
-
-use constant TESTS_PER_DRIVER => 24;
-
-my $total = scalar(@available_drivers) * TESTS_PER_DRIVER;
-plan tests => $total;
-
-use DateTime ();
-
-foreach my $d ( @available_drivers ) {
-SKIP: {
- unless( has_schema( 'TestApp::User', $d ) ) {
- skip "No schema for '$d' driver", TESTS_PER_DRIVER;
- }
- unless( should_test( $d ) ) {
- skip "ENV is not defined for driver '$d'", TESTS_PER_DRIVER;
- }
- diag("start testing with '$d' handle") if $ENV{TEST_VERBOSE};
-
- my $handle = get_handle( $d );
- connect_handle( $handle );
- isa_ok($handle->dbh, 'DBI::db');
-
- my $ret = init_schema( 'TestApp::User', $handle );
- isa_ok($ret,'DBI::st', "Inserted the schema. got a statement handle back");
-
- $handle->input_filters( 'Jifty::DBI::Filter::utf8' );
- is( ($handle->input_filters)[0], 'Jifty::DBI::Filter::utf8', 'Filter was added' );
-
- my $rec = TestApp::User->new($handle);
- isa_ok($rec, 'Jifty::DBI::Record');
-
- # "test" in Russian
- my $str = "\x{442}\x{435}\x{441}\x{442}";
-
- my($id) = $rec->create( signature => $str );
- ok($id, "Successfuly created ticket");
- ok($rec->load($id), "Loaded the record");
- is($rec->id, $id, "The record has its id");
- ok( Encode::is_utf8($rec->signature), "Value is UTF-8" );
- is( $rec->signature, $str, "Value is the same" );
-
- # correct data with no UTF-8 flag
- my $nstr = Encode::encode_utf8( $str );
- ($id) = $rec->create( signature => $nstr );
- ok($id, "Successfuly created ticket");
- ok($rec->load($id), "Loaded the record");
- is($rec->id, $id, "The record has its id");
- ok( Encode::is_utf8($rec->signature), "Value is UTF-8" );
- is( $rec->signature, $str, "Value is the same" );
-
- # cut string in the middle of the unicode char
- # and drop flag, leave only first char and
- # a half of the second so in result we will
- # get only one char
- $nstr = do{ use bytes; substr( $str, 0, 3 ) };
- ($id) = $rec->create( signature => $nstr );
- ok($id, "Successfuly created ticket");
- ok($rec->load($id), "Loaded the record");
- is($rec->id, $id, "The record has its id");
- ok( Encode::is_utf8($rec->signature), "Value is UTF-8" );
- is( $rec->signature, "\x{442}", "Value is correct" );
-
- # UTF-8 string with flag unset and enabeld trancation
- # truncation should cut third char, but utf8 filter should
- # replace it with \x{fffd} code point
- $rec->set_name( Encode::encode_utf8($str) );
- is($rec->name, "\x{442}\x{435}",
- "Name was truncated to two UTF-8 chars"
- );
-
- # create with undef value, no utf8 or truncate magic
- ($id) = $rec->create( signature => undef );
- ok($id, "Successfuly created ticket");
- ok($rec->load($id), "Loaded the record");
- is($rec->id, $id, "The record has its id");
- is($rec->signature, undef, "successfuly stored and fetched undef");
-
-}
-}
-
-package TestApp::User;
-
-use base qw/Jifty::DBI::Record/;
-
-sub schema {
-
- {
-
- id => { TYPE => 'int(11)' },
- name => { TYPE => 'varchar(5)' },
- signature => { TYPE => 'varchar(100)' },
-
- }
-
-}
-
-sub schema_sqlite {
-
-<<EOF;
-CREATE TABLE users (
- id integer primary key,
- name varchar(5),
- signature varchar(100)
-)
-EOF
-
-}
-
-sub schema_mysql {
-
-<<EOF;
-CREATE TEMPORARY TABLE users (
- id integer auto_increment primary key,
- name varchar(5),
- signature varchar(100)
-)
-EOF
-
-}
-
-sub schema_pg {
-
-<<EOF;
-CREATE TEMPORARY TABLE users (
- id serial primary key,
- name varchar(5),
- signature varchar(100)
-)
-EOF
-
-}
-
-1;
-
-
Modified: Jifty-DBI/trunk/t/utils.pl
==============================================================================
--- Jifty-DBI/trunk/t/utils.pl (original)
+++ Jifty-DBI/trunk/t/utils.pl Sat Sep 24 17:03:35 2005
@@ -1,7 +1,6 @@
#!/usr/bin/perl -w
use strict;
-use File::Spec ();
=head1 VARIABLES
@@ -124,7 +123,7 @@
);
}
-=head2 should_test $driver
+=head2 should_test
Checks environment for C<JDBI_TEST_*> variables.
Returns true if specified DB back-end should be tested.
@@ -140,41 +139,23 @@
return $ENV{$env};
}
-=head2 has_schema $class $driver|$handle
+=head2 had_schema
-Returns method name if C<$class> has schema for C<$driver> or C<$handle>.
-If second argument is handle object then checks also for DB version
-specific schemas.
+Returns true if C<$class> has schema for C<$driver>.
=cut
sub has_schema
{
my ($class, $driver) = @_;
- unless( UNIVERSAL::isa( $driver, 'Jifty::DBI::Handle' ) ) {
- my $method = 'schema_'. lc $driver;
- $method = '' unless UNIVERSAL::can( $class, $method );
- return $method;
- } else {
- my $ver = $driver->database_version;
- return has_schema( $class, handle_to_driver( $driver ) ) unless $ver;
-
- my $method = 'schema_'. lc handle_to_driver( $driver );
- $ver =~ s/-.*$//;
- my @nums = grep $_, map { int($_) } split /\./, $ver;
- while( @nums ) {
- my $m = $method ."_". join '_', @nums;
- return $m if( UNIVERSAL::can( $class, $m ) );
- pop @nums;
- }
- return has_schema( $class, handle_to_driver( $driver ) );
- }
+ my $method = 'schema_'. lc $driver;
+ return UNIVERSAL::can( $class, $method );
}
=head2 init_schema
-Takes C<$class> and C<$handle> or C<$driver> and inits schema
-by calling method C<has_schema> returns of the C<$class>.
+Takes C<$class> and C<$handle> and inits schema by calling
+C<schema_$driver> method of the C<$class>.
Returns last C<DBI::st> on success or last return value of the
SimpleQuery method on error.
@@ -183,8 +164,7 @@
sub init_schema
{
my ($class, $handle) = @_;
- my $call = has_schema( $class, $handle );
- diag( "using '$class\:\:$call' schema for ". handle_to_driver( $handle ) ) if $ENV{TEST_VERBOSE};
+ my $call = "schema_". lc handle_to_driver( $handle );
my $schema = $class->$call();
$schema = ref( $schema )? $schema : [$schema];
my $ret;
More information about the Rt-commit
mailing list