[Bast-commits] r4310 - in DBIx-Class-Tokenize/0.01/trunk: . lib/DBIx/Class t

[jshirley at dev.catalyst.perl.org]

Author: jshirley
Date: 2008-04-30 21:32:54 +0100 (Wed, 30 Apr 2008)
New Revision: 4310

Added:
   DBIx-Class-Tokenize/0.01/trunk/Changes
   DBIx-Class-Tokenize/0.01/trunk/t/00-load.t
   DBIx-Class-Tokenize/0.01/trunk/t/01-token.t
Modified:
   DBIx-Class-Tokenize/0.01/trunk/MANIFEST
   DBIx-Class-Tokenize/0.01/trunk/lib/DBIx/Class/Tokenize.pm
Log:
test cases, ready for the cpanning.

Added: DBIx-Class-Tokenize/0.01/trunk/Changes
===================================================================
--- DBIx-Class-Tokenize/0.01/trunk/Changes	                        (rev 0)
+++ DBIx-Class-Tokenize/0.01/trunk/Changes	2008-04-30 20:32:54 UTC (rev 4310)
@@ -0,0 +1,5 @@
+Revision history for DBIx-Class-Tokenize
+
+0.01    2008-04-30
+        Initial version
+

Modified: DBIx-Class-Tokenize/0.01/trunk/MANIFEST
===================================================================
--- DBIx-Class-Tokenize/0.01/trunk/MANIFEST	2008-04-30 20:26:26 UTC (rev 4309)
+++ DBIx-Class-Tokenize/0.01/trunk/MANIFEST	2008-04-30 20:32:54 UTC (rev 4310)
@@ -10,16 +10,13 @@
 inc/Module/Install/Metadata.pm
 inc/Module/Install/Win32.pm
 inc/Module/Install/WriteAll.pm
-lib/DBIx/Class/QueryLog.pm
-lib/DBIx/Class/QueryLog/Analyzer.pm
-lib/DBIx/Class/QueryLog/Query.pm
-lib/DBIx/Class/QueryLog/Transaction.pm
+lib/DBIx/Class/Tokenize.pm
 Makefile.PL
 MANIFEST
 META.yml			# Will be created by "make dist"
 README
 t/00-load.t
-t/01-quickies.t
-t/02-analyzer.t
-t/pod-coverage.t
-t/pod.t
+t/01-token.t
+t/lib/DBIC/Test.pm
+t/lib/DBIC/Test/Schema.pm
+t/lib/DBIC/Test/Schema/Test.pm

Modified: DBIx-Class-Tokenize/0.01/trunk/lib/DBIx/Class/Tokenize.pm
===================================================================
--- DBIx-Class-Tokenize/0.01/trunk/lib/DBIx/Class/Tokenize.pm	2008-04-30 20:26:26 UTC (rev 4309)
+++ DBIx-Class-Tokenize/0.01/trunk/lib/DBIx/Class/Tokenize.pm	2008-04-30 20:32:54 UTC (rev 4310)
@@ -56,23 +56,10 @@
     my ( $self, $attrs ) = ( shift, shift );
 
     foreach my $key ( keys %{ $self->__columns_to_tokenize } ) {
-        my $field = $self->get_column($key);
         my $dest  = $self->__columns_to_tokenize->{$key};
         # Don't overwrite if there is something already there
         next if defined $self->get_column($dest);
-        my $token = lc($field);
-        if ( $self->parent ) {
-            my @parent_tokens = ();
-            my $parent = $self->parent;
-            while ( $parent and $parent->parent_pk1 ) {
-                my $pt = $parent->get_column('token');
-                next unless $pt;
-                push @parent_tokens, $pt;
-                $parent = $parent->parent;
-            }
-            $token = join("-", @parent_tokens, lc($field));
-        }
-        $self->$dest( $self->tokenize($token) );
+        $self->$dest( $self->tokenize( $key ) );
     }
     $self->next::method(@_);
 }
@@ -85,14 +72,23 @@
 easy to override so that you can change things around to suit your particular
 table.  Whatever is returned is inserted into the configured C<token_field>.
 
+An example of extending this method would be to traverse a tree in a row
+that uses L<DBIx::Class::Tree::AdjacencyList> and tokenize the parents as well.
+
 =cut
 
 sub tokenize {
-    my ( $self, $token ) = @_;
-    $token = lc($token);
-    $token =~ s/\s+/_/g;
-    $token =~ s/[^\w]/_/g;
-    return $token;
+    my ( $self, $key ) = @_;
+    
+    my $field = $self->get_column($key);
+
+    # Should we throw an exception, or just return undef?
+    return undef unless $field;
+
+    $field = lc($field);
+    $field =~ s/\s+/_/g;
+    $field =~ s/[^\w]/_/g;
+    return $field;
 }
 
 =head1 AUTHOR

Added: DBIx-Class-Tokenize/0.01/trunk/t/00-load.t
===================================================================
--- DBIx-Class-Tokenize/0.01/trunk/t/00-load.t	                        (rev 0)
+++ DBIx-Class-Tokenize/0.01/trunk/t/00-load.t	2008-04-30 20:32:54 UTC (rev 4310)
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+    eval "use DBD::SQLite";
+    plan $@
+        ? ( skip_all => 'needs DBD::SQLite for testing' )
+        : ( tests => 1 );
+}
+
+use_ok('DBIx::Class::Tokenize');
+

Added: DBIx-Class-Tokenize/0.01/trunk/t/01-token.t
===================================================================
--- DBIx-Class-Tokenize/0.01/trunk/t/01-token.t	                        (rev 0)
+++ DBIx-Class-Tokenize/0.01/trunk/t/01-token.t	2008-04-30 20:32:54 UTC (rev 4310)
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+use lib qw(t/lib);
+use DBIC::Test;
+
+my $schema = DBIC::Test->init_schema;
+my $row;
+
+$row = $schema->resultset('DBIC::Test::Schema::Test')
+    ->create({ name => 'Some Silly Book' });
+
+is($row->token, 'some_silly_book', "Basic Tokenize works");
+
+$row = $schema->resultset('DBIC::Test::Schema::Test')
+    ->create({ name => 'Some Silly Book, Volume 2.3-1' });
+is($row->token, 'some_silly_book__volume_2_3_1', "Other characters escape properly");