0.00000_1 :-)

Makefile.PL

@@ -5,8 +5,15 @@ all_from 'lib/DBIx/Class/PhoneticSearch.pm';
 author   'Moritz Onken <onken@netcubed.de>';
 license  'perl';
 
+requires 'DBIx::Class' => '0.08103';
+requires 'SQL::Translator';
+requires 'Text::Phonetic';
+requires 'Class::Load';
+
 build_requires 'Test::More';
 
+repository 'http://github.com/monken/DBIx-Class-PhoneticSearch/tree/master';
+
 auto_install;
 
 WriteAll;

lib/DBIx/Class/PhoneticSearch.pm

@@ -3,18 +3,66 @@ package DBIx::Class::PhoneticSearch;
 use warnings;
 use strict;
 
-=head1 NAME
+use Class::Load qw();
 
-DBIx::Class::PhoneticSearch - The great new DBIx::Class::PhoneticSearch!
+use constant PHONETIC_ALGORITHMS =>
+  qw(DaitchMokotoff DoubleMetaphone Koeln Metaphone Phonem Phonix Soundex SoundexNara);
 
-=head1 VERSION
+sub register_column {
+    my ( $self, $column, $info, @rest ) = @_;
 
-Version 0.01
+    $self->next::method( $column, $info, @rest );
 
-=cut
+    if ( my $config = $info->{phonetic_search} ) {
+        $info->{phonetic_search} = $config = { algorithm => $config }
+          unless ( ref $config eq "HASH" );
+        $config->{algorithm} = 'Phonix'
+          unless ( grep { $config->{algorithm} eq $_ } PHONETIC_ALGORITHMS );
+        $self->add_column( $column
+              . '_phonetic_'
+              . lc( $config->{algorithm} ) =>
+              { data_type => 'character varying', is_nullable => 1 } );
+    }
+
+    return undef;
+}
+
+sub store_column {
+    my ( $self, $name, $value, @rest ) = @_;
+
+    my $info = $self->column_info($name);
+
+    if ( my $config = $info->{phonetic_search} ) {
+        my $class  = 'Text::Phonetic::' . $config->{algorithm};
+        my $column = $name . '_phonetic_' . lc( $config->{algorithm} );
+        Class::Load::load_class($class);
+        $self->set_column( $column, $class->new->encode($value) );
+    }
+
+    return $self->next::method( $name, $value, @rest );
+}
+
+sub sqlt_deploy_hook {
+    my ($self, $table, @rest) = @_;
+    $self->maybe::next::method($table, @rest);
+    foreach my $column($self->columns) {
+        next unless(my $config = $self->column_info($column)->{phonetic_search});
+        next if($config->{no_indices});
+        my $phonetic_column = $column.'_phonetic_' . lc( $config->{algorithm} );
+        $table->add_index(name => 'idx_'.$phonetic_column, fields => [$phonetic_column]);
+        $table->add_index(name => 'idx_'.$column, fields => [$column]);
+
+    }
+
+}
 
-our $VERSION = '0.01';
+1;
 
+__END__
+
+=head1 NAME
+
+DBIx::Class::PhoneticSearch - The great new DBIx::Class::PhoneticSearch!
 
 =head1 SYNOPSIS
 
@@ -26,27 +74,20 @@ Perhaps a little code snippet.
 
     my $foo = DBIx::Class::PhoneticSearch->new();
     ...
+    
+=head1 ADVANCED CONFIGURATION
 
-=head1 EXPORT
+=head2 algorithm
 
-A list of functions that can be exported.  You can delete this section
-if you don't export anything, such as for a purely object-oriented module.
+Choose one of C<DaitchMokotoff DoubleMetaphone Koeln Metaphone Phonem Phonix Soundex SoundexNara>.
 
-=head1 FUNCTIONS
+See L<Text::Phonetic> for more details.
 
-=head2 function1
+Defaults to C<Phonix>.
 
-=cut
+=head2 no_indices
 
-sub function1 {
-}
-
-=head2 function2
-
-=cut
-
-sub function2 {
-}
+By default this module will create indices on both the source column and the phonetic column. Set this attribute to a true value to disable this behaviour.
 
 =head1 AUTHOR
 
@@ -104,4 +145,3 @@ under the same terms as Perl itself.
 
 =cut
 
-1; # End of DBIx::Class::PhoneticSearch

lib/DBIx/Class/ResultSet/PhoneticSearch.pm

@@ -0,0 +1,75 @@
+package DBIx::Class::ResultSet::PhoneticSearch;
+
+use base 'DBIx::Class::ResultSet';
+
+use strict;
+use warnings;
+
+use Carp;
+
+sub search_phonetic {
+    my ( $self, $search, $attributes ) = @_;
+
+    $attributes ||= {};
+
+    my $source = $self->result_source;
+
+    my @search =
+        ref $search eq 'ARRAY' ? @{$search}
+      : ref $search eq 'HASH'  ? %{$search}
+      :   croak 'search_phonetic takes an arrayref or a hashref';
+
+    my $type = ref $search eq 'ARRAY' ? '-or' : '-and';
+
+    my $query = [];
+
+    while ( my $column = shift @search ) {
+        my $value = shift @search;
+        $column =~ s/^(.*?\.)?(.*)$/$2/;
+        my $prefix = $1 || q{};
+        my $info = $source->column_info($column);
+        croak qq(Column '$column' is not a phonetic column)
+          unless ( my $config = $info->{phonetic_search} );
+
+        my $class  = 'Text::Phonetic::' . $config->{algorithm};
+        my $column = $column . '_phonetic_' . lc( $config->{algorithm} );
+        Class::Load::load_class($class);
+        my $encoded_value = $class->new->encode($value);
+
+        push(@{$query}, { "$prefix$column" => $encoded_value});
+
+    }
+
+    return $self->search( { $type => $query }, $attributes );
+}
+
+sub update_phonetic_columns {
+    my ($self) = @_;
+    my $i      = 0;
+    my $source = $self->result_source;
+    foreach my $column ( $source->columns ) {
+        $i += $self->update_phonetic_column($column);
+    }
+    return $i;
+}
+
+sub update_phonetic_column {
+    my ( $self, $column ) = @_;
+    my $source = $self->result_source;
+    my $config = $source->column_info($column)->{phonetic_search};
+    my $i;
+    return 0 unless ($config);
+    my $class           = 'Text::Phonetic::' . $config->{algorithm};
+    my $phonetic_column = $column . '_phonetic_' . lc( $config->{algorithm} );
+    Class::Load::load_class($class);
+    my $rs = $self->search( { $column => { '!=' => undef } } );
+
+    while ( my $row = $rs->next ) {
+        $row->update(
+            { $phonetic_column => $class->new->encode( $row->$column ) } );
+        $i++;
+    }
+    return $i;
+}
+
+1;

t/lib/Schema.pm

@@ -0,0 +1,43 @@
+{
+package
+  Schema::Item;
+
+use base 'DBIx::Class';
+
+__PACKAGE__->load_components(qw(PhoneticSearch Core));
+
+__PACKAGE__->table('item');
+
+__PACKAGE__->add_columns(
+  id => { data_type => 'integer', auto_increment => 1, },
+  name1 => { data_type => 'character varying', phonetic_search => 1 },
+  name2 => { data_type => 'character varying', is_nullable => 1, phonetic_search => { algorithm => 'Koeln' } }
+
+);
+
+__PACKAGE__->set_primary_key('id');
+
+__PACKAGE__->resultset_class('DBIx::Class::ResultSet::PhoneticSearch');
+
+}
+
+
+{ 
+package 
+  Schema;
+
+use base 'DBIx::Class::Schema';
+
+__PACKAGE__->load_classes('Item');
+
+sub connect {
+  my $class = shift;
+  my $schema = $class->next::method('dbi:SQLite::memory:');
+  $schema->deploy;
+  return $schema;
+}
+
+}
+
+1;
+

t/search.t

@@ -0,0 +1,69 @@
+use Test::More tests => 13;
+
+use strict;
+use warnings;
+
+use lib qw(t/lib);
+use Schema;
+
+my $s = Schema->connect;
+
+my $rs = $s->resultset('Item');
+
+eval { $rs->search_phonetic({ foobar => 'xyz' }) };
+
+ok($@, 'error on unknown columns: '.$@);
+
+eval { $rs->search_phonetic({ id => 'xyz' }) };
+
+ok($@, 'error on non-phonetic columns: '.$@);
+
+$rs->create({name1 => 'Meyer', name2 => 'Peter'});
+
+$rs->create({name1 => 'Schmidt', name2 => 'Moritz'});
+
+my @found = $rs->search_phonetic({ name1 => 'Meyer', name2 => 'Peter'});
+
+is(@found, 1, 'one result found');
+
+@found = $rs->search_phonetic({ name1 => 'Meier', name2 => 'Peter'});
+
+is(@found, 1, 'one result found');
+
+@found = $rs->search_phonetic({ 'me.name1' => 'Meier', 'me.name2' => 'Peter'});
+
+is(@found, 1, 'one result found with prefix');
+
+@found = $rs->search_phonetic([ name1 => 'Meier', name1 => 'Meyer']);
+
+is(@found, 1, 'one result found in OR search');
+
+@found = $rs->search_phonetic([ name1 => 'Meier', name1 => 'Foo']);
+
+is(@found, 1, 'zero results found in OR search');
+
+@found = $rs->search_phonetic([ name2 => 'Moriz']);
+
+is(@found, 1, 'moriz found instead of moritz');
+
+is($rs->update_phonetic_columns, 4, 'updates 4 rows');
+
+is($rs->update_phonetic_column('name1'), 2, 'updates 2 rows');
+
+is($rs->result_source->column_info('name1')->{phonetic_search}->{algorithm}, 'Phonix', 'algorithm is set');
+
+is($rs->result_source->column_info('name2')->{phonetic_search}->{algorithm}, 'Koeln', 'algorithm is set');
+
+$rs->create({name1 => 'Schmidt', name2 => 'Moriz'});
+
+$rs->create({name1 => 'Schmidt', name2 => 'Moriiz'});
+
+@found = $rs->search_phonetic({ name2 => 'Moriiz'}, { order_by => { -desc => \[ 'name2 LIKE ?', 'Moriiz' ] } });
+
+is($found[0]->name2, "Moriiz", 'sorting for exact match');
+
+
+
+
+
+