[Rt-commit] r3882 - 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 16:49:38 EDT 2005
Author: jesse
Date: Sat Sep 24 16:49:32 2005
New Revision: 3882
Added:
Jifty-DBI/trunk/lib/Jifty/DBI/HasFilters.pm
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
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/Record.pm
Jifty-DBI/trunk/t/01records.t
Jifty-DBI/trunk/t/utils.pl
Log:
r15981 at hualien: jesse | 2005-09-24 16:48:24 -0400
* Next cut of filters from Ruslan
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 16:49:32 2005
@@ -3,10 +3,9 @@
package Jifty::DBI::Column;
-use base qw/Class::Accessor/;
+use base qw/Class::Accessor Jifty::DBI::HasFilters/;
use UNIVERSAL::require;
-
__PACKAGE__->mk_accessors qw/
name
type
@@ -17,12 +16,9 @@
length
refers_to_collection_class
refers_to_record_class
- alias_for_column
- filters
- output_filters
+ alias_for_column
/;
-# input_filters
=head1 NAME
@@ -60,51 +56,4 @@
*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 16:49:32 2005
@@ -4,7 +4,7 @@
package Jifty::DBI::Filter;
use base 'Class::Accessor';
-__PACKAGE__->mk_accessors(qw(column value_ref));
+__PACKAGE__->mk_accessors(qw(record column value_ref));
=head2 new
@@ -52,12 +52,8 @@
from flattening a L<DateTime> object into an ISO date to making sure
that data is utf8 clean.
-
-
-
=cut
-
sub encode {
}
@@ -68,7 +64,6 @@
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 16:49:32 2005
@@ -0,0 +1,75 @@
+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 16:49:32 2005
@@ -4,6 +4,7 @@
package Jifty::DBI::Filter::Truncate;
use base qw/Jifty::DBI::Filter/;
+use Encode ();
sub encode {
my $self = shift;
@@ -23,31 +24,16 @@
return unless ($truncate_to); # don't need to truncate
- # 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(),
- );
+ my $utf8 = Encode::is_utf8( $$value_ref );
+ {
+ use bytes;
+ $$value_ref = substr( $$value_ref, 0, $truncate_to );
}
- else {
- $$value_ref = Encode::encode(
- utf8 => Encode::decode(
- utf8 => substr( $$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 );
}
-
}
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 16:49:32 2005
@@ -0,0 +1,81 @@
+
+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 16:49:32 2005
@@ -1,11 +1,13 @@
package Jifty::DBI::Handle;
use strict;
use Carp;
-use DBI;
-use Class::ReturnValue;
-use Encode;
+use DBI ();
+use Class::ReturnValue ();
+use Encode ();
-use vars qw($VERSION @ISA %DBIHandle $PrevHandle $DEBUG $TRANSDEPTH);
+use base qw/Jifty::DBI::HasFilters/;
+
+use vars qw($VERSION %DBIHandle $PrevHandle $DEBUG $TRANSDEPTH);
$TRANSDEPTH = 0;
@@ -559,13 +561,18 @@
sub database_version {
my $self = shift;
+ my %args = ( short => 1, @_ );
- unless ( $self->{'database_version'} ) {
+ unless( defined $self->{'database_version'} ) {
my $statement = "SELECT VERSION()";
my $sth = $self->simple_query($statement);
- my @vals = $sth->fetchrow();
- $self->{'database_version'} = $vals[0];
+ unless( $sth ) {
+ return( $self->{'database_version'} = '' );
+ }
+ my $ver = ($sth->fetchrow_array())[0];
+ $self->{'database_version'} = $ver;
}
+ 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 16:49:32 2005
@@ -40,12 +40,28 @@
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 isnert failure, returns a L<Class::ReturnValue> object
+In case of insert 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 16:49:32 2005
@@ -20,8 +20,18 @@
=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
Added: Jifty-DBI/trunk/lib/Jifty/DBI/HasFilters.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/HasFilters.pm Sat Sep 24 16:49:32 2005
@@ -0,0 +1,79 @@
+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 16:49:32 2005
@@ -5,11 +5,13 @@
use vars qw($AUTOLOAD);
use Class::ReturnValue;
-use Lingua::EN::Inflect;
use Jifty::DBI::Column;
use UNIVERSAL::require;
-use base qw/Class::Data::Inheritable/;
+use base qw/
+ Class::Data::Inheritable
+ Jifty::DBI::HasFilters
+ /;
Jifty::DBI::Record->mk_classdata('COLUMNS');
@@ -240,6 +242,7 @@
bless( $self, $class );
$self->_init_columns() unless $self->COLUMNS;
+ $self->input_filters( 'Jifty::DBI::Filter::Truncate' );
$self->_init(@_);
@@ -452,31 +455,29 @@
for my $column_name ( keys %$schema ) {
my $column = $self->add_column($column_name);
- # Default, everything readable and writable
- $column->readable(1);
+ my $meta = $schema->{ $column_name } || {};
- if ( $schema->{$column_name}{'read'} ) {
- $column->readable( $schema->{$column_name}{'read'});
- } else {
- $column->readable(1);
- }
+ # Default, everything readable
+ $column->readable( delete $meta->{'read'} || 1 );
- if ( $schema->{$column_name}{'write'} ) {
- $column->writable( $schema->{$column_name}{'write'});
+ # Default, everything writable except columns of the pkey
+ if ( $meta->{'write'} ) {
+ $column->writable( $meta->{'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 = $schema->{$column_name}{'type'} || $schema->{$column_name}{'TYPE'};
+ my $type = delete $meta->{'type'} ||
+ delete $meta->{'TYPE'};
if ($type) {
$column->type($type);
-
}
- my $refclass = $schema->{$column_name}{'REFERENCES'} || $schema->{$column_name}{'references'};
+ my $refclass = delete $meta->{'REFERENCES'} ||
+ delete $meta->{'references'};
if ($refclass) {
$refclass->require();
@@ -486,7 +487,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( $schema->{$column_name}{'read'} || 1);
+ $virtual_column->readable( delete $meta->{'read'} || 1);
}
else {
$column->refers_to_record_class($refclass);
@@ -500,6 +501,10 @@
warn "Error: $refclass neither Record nor Collection";
}
}
+ for my $attr( keys %$meta) {
+ next unless $column->can( $attr );
+ $column->$attr( $meta->{$attr} );
+ }
}
}
@@ -582,8 +587,7 @@
sub column {
my $self = shift;
- my $name = shift;
- $name = lc $name;
+ my $name = lc( shift || '');
return undef unless $self->COLUMNS and $self->COLUMNS->{$name};
return $self->COLUMNS->{$name} ;
@@ -651,10 +655,16 @@
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};
}
@@ -713,34 +723,26 @@
return ( $ret->return_value );
}
-
- $column->encode_value(\$args{'value'});
+ $self->_apply_input_filters( column => $column, value_ref => \$args{'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 );
+ # 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 );
+ }
}
-
-
-
my $method = "validate_" . $column->name;
unless ( $self->$method( $args{'value'} ) ) {
$ret->as_array( 0, 'Illegal value for ' . $column->name);
@@ -793,6 +795,7 @@
}
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 );
@@ -950,6 +953,7 @@
$self->{'values'} = $sth->fetchrow_hashref;
$self->{'fetched'} = {};
+ $self->{'decoded'} = {};
if ( !$self->{'values'} && $sth->err ) {
return ( 0, "Couldn't fetch row: " . $sth->err );
}
@@ -994,7 +998,9 @@
}
- $column->encode_value( \$attribs{$column_name});
+ $self->_apply_input_filters( column => $column,
+ value_ref => \$attribs{$column_name},
+ );
}
unless ( $self->_handle->knows_blobs ) {
@@ -1078,7 +1084,12 @@
my $table = $1;
$table =~ s/(?<=[a-z])([A-Z]+)/"_" . lc($1)/eg;
$table =~ tr/A-Z/a-z/;
- $table = Lingua::EN::Inflect::PL_N($table);
+ local $@;
+ if( eval { require Lingua::EN::Inflect } ) {
+ $table = Lingua::EN::Inflect::PL_N($table);
+ } else {
+ # here is simple rules without Lingua::*
+ }
$self->{__table_name} = $table;
}
return $self->{__table_name};
@@ -1112,6 +1123,53 @@
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 16:49:32 2005
@@ -8,7 +8,7 @@
BEGIN { require "t/utils.pl" }
our (@available_drivers);
-use constant TESTS_PER_DRIVER => 63;
+use constant TESTS_PER_DRIVER => 61;
my $total = scalar(@available_drivers) * TESTS_PER_DRIVER;
plan tests => $total;
@@ -80,19 +80,14 @@
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',
@@ -181,10 +176,11 @@
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', "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");
+ 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");
# deletes
$newrec = TestApp::Address->new($handle);
@@ -208,7 +204,7 @@
sub validate_name
{
my ($self, $value) = @_;
- return 0 if $value =~ /invalid/i;
+ return 0 if $value && $value =~ /invalid/i;
return 1;
}
Added: Jifty-DBI/trunk/t/06filter.t
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/t/06filter.t Sat Sep 24 16:49:32 2005
@@ -0,0 +1,27 @@
+#!/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;
Added: Jifty-DBI/trunk/t/06filter_datetime.t
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/t/06filter_datetime.t Sat Sep 24 16:49:32 2005
@@ -0,0 +1,108 @@
+#!/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;
+
Added: Jifty-DBI/trunk/t/06filter_truncate.t
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/t/06filter_truncate.t Sat Sep 24 16:49:32 2005
@@ -0,0 +1,145 @@
+#!/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;
+
Added: Jifty-DBI/trunk/t/06filter_utf8.t
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/t/06filter_utf8.t Sat Sep 24 16:49:32 2005
@@ -0,0 +1,142 @@
+#!/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 16:49:32 2005
@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
use strict;
+use File::Spec ();
=head1 VARIABLES
@@ -123,7 +124,7 @@
);
}
-=head2 should_test
+=head2 should_test $driver
Checks environment for C<JDBI_TEST_*> variables.
Returns true if specified DB back-end should be tested.
@@ -139,23 +140,41 @@
return $ENV{$env};
}
-=head2 had_schema
+=head2 has_schema $class $driver|$handle
-Returns true if C<$class> has schema for C<$driver>.
+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.
=cut
sub has_schema
{
my ($class, $driver) = @_;
- my $method = 'schema_'. lc $driver;
- return UNIVERSAL::can( $class, $method );
+ 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 ) );
+ }
}
=head2 init_schema
-Takes C<$class> and C<$handle> and inits schema by calling
-C<schema_$driver> method of the C<$class>.
+Takes C<$class> and C<$handle> or C<$driver> and inits schema
+by calling method C<has_schema> returns of the C<$class>.
Returns last C<DBI::st> on success or last return value of the
SimpleQuery method on error.
@@ -164,7 +183,8 @@
sub init_schema
{
my ($class, $handle) = @_;
- my $call = "schema_". lc handle_to_driver( $handle );
+ my $call = has_schema( $class, $handle );
+ diag( "using '$class\:\:$call' schema for ". handle_to_driver( $handle ) ) if $ENV{TEST_VERBOSE};
my $schema = $class->$call();
$schema = ref( $schema )? $schema : [$schema];
my $ret;
More information about the Rt-commit
mailing list