[Rt-commit] r3890 - in Jifty-DBI/trunk: . lib/Jifty/DBI/Filter t

ruz at bestpractical.com ruz at bestpractical.com
Sun Sep 25 04:59:55 EDT 2005


Author: ruz
Date: Sun Sep 25 04:59:54 2005
New Revision: 3890

Modified:
   Jifty-DBI/trunk/   (props changed)
   Jifty-DBI/trunk/Makefile.PL
   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/t/06filter_datetime.t
   Jifty-DBI/trunk/t/06filter_truncate.t
   Jifty-DBI/trunk/t/06filter_utf8.t
Log:
 r2509 at cubic-pc:  cubic | 2005-09-24 13:52:19 +0400
 * Truncate - trancate data to fit available space
 * utf8 - validate utf8 data before store and after fetch
 * DateTime filter - access to datetime columns with DateTime objects
 ** Makefilei.PL update
 * tests for this filters


Modified: Jifty-DBI/trunk/Makefile.PL
==============================================================================
--- Jifty-DBI/trunk/Makefile.PL	(original)
+++ Jifty-DBI/trunk/Makefile.PL	Sun Sep 25 04:59:54 2005
@@ -10,6 +10,9 @@
 requires('Lingua::EN::Inflect');
 requires('Class::ReturnValue', 0.40);
 requires('Cache::Simple::TimedExpiry' => '0.21');
+requires('DateTime');
+requires('DateTime::Format::Strptime');
+
 build_requires('Test::More' => 0.52);
 
 features(

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	Sun Sep 25 04:59:54 2005
@@ -0,0 +1,76 @@
+package Jifty::DBI::Filter::DateTime;
+
+use warnings;
+use strict;
+
+use base qw(Jifty::DBI::Filter);
+use DateTime ();
+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	Sun Sep 25 04:59:54 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	Sun Sep 25 04:59:54 2005
@@ -0,0 +1,77 @@
+
+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
+
+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
+
+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/t/06filter_datetime.t
==============================================================================
--- Jifty-DBI/trunk/t/06filter_datetime.t	(original)
+++ Jifty-DBI/trunk/t/06filter_datetime.t	Sun Sep 25 04:59:54 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;
+

Modified: Jifty-DBI/trunk/t/06filter_truncate.t
==============================================================================
--- Jifty-DBI/trunk/t/06filter_truncate.t	(original)
+++ Jifty-DBI/trunk/t/06filter_truncate.t	Sun Sep 25 04:59:54 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;
+

Modified: Jifty-DBI/trunk/t/06filter_utf8.t
==============================================================================
--- Jifty-DBI/trunk/t/06filter_utf8.t	(original)
+++ Jifty-DBI/trunk/t/06filter_utf8.t	Sun Sep 25 04:59:54 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;
+
+


More information about the Rt-commit mailing list