[Bast-commits] r4308 - / DBIx-Class-Tokenize
DBIx-Class-Tokenize/0.01 DBIx-Class-Tokenize/0.01/trunk
DBIx-Class-Tokenize/0.01/trunk/lib
DBIx-Class-Tokenize/0.01/trunk/lib/DBIx
DBIx-Class-Tokenize/0.01/trunk/lib/DBIx/Class
DBIx-Class-Tokenize/0.01/trunk/t
DBIx-Class-Tokenize/0.01/trunk/t/lib
DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC
DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test
DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test/Schema
jshirley at dev.catalyst.perl.org
jshirley at dev.catalyst.perl.org
Wed Apr 30 18:15:41 BST 2008
Author: jshirley
Date: 2008-04-30 18:15:41 +0100 (Wed, 30 Apr 2008)
New Revision: 4308
Added:
DBIx-Class-Tokenize/
DBIx-Class-Tokenize/0.01/
DBIx-Class-Tokenize/0.01/trunk/
DBIx-Class-Tokenize/0.01/trunk/MANIFEST
DBIx-Class-Tokenize/0.01/trunk/MANIFEST.SKIP
DBIx-Class-Tokenize/0.01/trunk/Makefile.PL
DBIx-Class-Tokenize/0.01/trunk/lib/
DBIx-Class-Tokenize/0.01/trunk/lib/DBIx/
DBIx-Class-Tokenize/0.01/trunk/lib/DBIx/Class/
DBIx-Class-Tokenize/0.01/trunk/lib/DBIx/Class/Tokenize.pm
DBIx-Class-Tokenize/0.01/trunk/t/
DBIx-Class-Tokenize/0.01/trunk/t/lib/
DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/
DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test.pm
DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test/
DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test/Schema.pm
DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test/Schema/
DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test/Schema/Test.pm
DBIx-Class-Tokenize/0.01/trunk/t/sql/
DBIx-Class-Tokenize/0.01/trunk/t/var/
Log:
Adding a simple tokenize component for related column triggers, need to add tests then will ship to CPAN after review.
Added: DBIx-Class-Tokenize/0.01/trunk/MANIFEST
===================================================================
--- DBIx-Class-Tokenize/0.01/trunk/MANIFEST (rev 0)
+++ DBIx-Class-Tokenize/0.01/trunk/MANIFEST 2008-04-30 17:15:41 UTC (rev 4308)
@@ -0,0 +1,25 @@
+Changes
+inc/Module/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+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
+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
Added: DBIx-Class-Tokenize/0.01/trunk/MANIFEST.SKIP
===================================================================
--- DBIx-Class-Tokenize/0.01/trunk/MANIFEST.SKIP (rev 0)
+++ DBIx-Class-Tokenize/0.01/trunk/MANIFEST.SKIP 2008-04-30 17:15:41 UTC (rev 4308)
@@ -0,0 +1,48 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# for developers only :)
+^TODO$
+^VERSIONING\.SKETCH$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\..*?\.sw[po]$
+\#$
+\b\.#
+
+# avoid OS X finder files
+\.DS_Store$
+
+# Don't ship the test db
+^t/var
+
+# Don't ship the last dist we built :)
+\.tar\.gz$
+
+# Skip maint stuff
+^maint/
+
+# Avoid copies to .orig
+\.orig$
+
+# Dont use Module::Build anymore
+^Build.PL$
Added: DBIx-Class-Tokenize/0.01/trunk/Makefile.PL
===================================================================
--- DBIx-Class-Tokenize/0.01/trunk/Makefile.PL (rev 0)
+++ DBIx-Class-Tokenize/0.01/trunk/Makefile.PL 2008-04-30 17:15:41 UTC (rev 4308)
@@ -0,0 +1,10 @@
+use inc::Module::Install;
+
+name 'DBIx-Class-Tokenize';
+all_from 'lib/DBIx/Class/Tokenize.pm';
+
+requires 'DBIx::Class' => 0;
+
+auto_install;
+
+WriteAll;
Added: DBIx-Class-Tokenize/0.01/trunk/lib/DBIx/Class/Tokenize.pm
===================================================================
--- DBIx-Class-Tokenize/0.01/trunk/lib/DBIx/Class/Tokenize.pm (rev 0)
+++ DBIx-Class-Tokenize/0.01/trunk/lib/DBIx/Class/Tokenize.pm 2008-04-30 17:15:41 UTC (rev 4308)
@@ -0,0 +1,151 @@
+package DBIx::Class::Tokenize;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class/;
+
+__PACKAGE__->mk_classdata( '__columns_to_tokenize' => {} );
+
+=head1 NAME
+
+DBIx::Class::Tokenize - Automatically tokenize a column on creation
+
+=head1 DESCRIPTION
+
+This component simply creates a clean token based on a field on insertion. The
+simple use case is having a long name that is displayable, like "Catalyst Book"
+that you want to change to "catalyst_book". Rather than do that by hand
+every time you create a record, this component does it for you.
+
+=head1 SYNOPSIS
+
+ package MyApp::Schema::Book;
+
+ __PACKAGE__->load_components( qw(Tokenize ... Core) );
+ __PACKAGE__->add_columns(
+ id => { data_type => 'integer', is_auto_increment => 1 },
+ name => { data_type => 'varchar', size => 128,
+ # Update the 'token' field on create
+ token_field => 'token' },
+ token => { data_type => 'varchar', size => 128, is_nullable => 0 }
+ );
+
+ ...
+
+ my $row = $schema->resultset('Book')->create({ name => "Catalyst Book" });
+
+ print $row->token; # Prints "catalyst_book
+
+=cut
+
+sub register_column {
+ my ( $self, $column, $info, @rest ) = @_;
+
+ $self->next::method($column, $info, @rest);
+ return unless $info->{token_field};
+ return unless defined($info->{data_type});
+ return unless $info->{data_type} =~ /^(var)?char$/i;
+
+ my $token = $info->{token_field} || 'token';
+
+ $self->__columns_to_tokenize->{$column} = $token;
+}
+
+sub insert {
+ 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->next::method(@_);
+}
+
+=head1 METHODS
+
+=head2 tokenize
+
+This method is what performs the actual conversion to the tokenized form. It is
+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>.
+
+=cut
+
+sub tokenize {
+ my ( $self, $token ) = @_;
+ $token = lc($token);
+ $token =~ s/\s+/_/g;
+ $token =~ s/[^\w]/_/g;
+ return $token;
+}
+
+=head1 AUTHOR
+
+J. Shirley, C<< <jshirley at coldhardcode.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-catalyst-controller-rest-dbi
+c-item at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DBIx-Class-Tokenize>. I will be notified, and then you'll automatically be notified of
+progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc DBIx::Class::Tokenize
+
+You can also look for information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBIx-Class-Tokenize>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/DBIx-Class-Tokenize>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/DBIx-Class-Tokenize>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/DBIx-Class-Tokenize>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+This is a Cold Hard Code, LLC module - http://www.coldhardcode.com
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Cold Hard Code, LLC, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1;
Added: DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test/Schema/Test.pm
===================================================================
--- DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test/Schema/Test.pm (rev 0)
+++ DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test/Schema/Test.pm 2008-04-30 17:15:41 UTC (rev 4308)
@@ -0,0 +1,28 @@
+package #
+ DBIC::Test::Schema::Test;
+
+use base 'DBIx::Class::Core';
+
+__PACKAGE__->load_components(qw/Tokenize Core/);
+__PACKAGE__->table('test');
+
+__PACKAGE__->add_columns(
+ 'pk1' => {
+ data_type => 'integer', is_nullable => 0, is_auto_increment => 1
+ },
+ 'name' => {
+ data_type => 'varchar',
+ size => 128,
+ is_nullable => 0,
+ token_field => 'token'
+ },
+ 'token' => {
+ data_type => 'varchar',
+ size => 128,
+ is_nullable => 0,
+ },
+);
+
+__PACKAGE__->set_primary_key('pk1');
+
+1;
Added: DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test/Schema.pm
===================================================================
--- DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test/Schema.pm (rev 0)
+++ DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test/Schema.pm 2008-04-30 17:15:41 UTC (rev 4308)
@@ -0,0 +1,14 @@
+package # hide from PAUSE
+ DBIC::Test::Schema;
+
+use base qw/DBIx::Class::Schema/;
+
+no warnings qw/qw/;
+
+__PACKAGE__->load_classes;
+
+sub dsn {
+ return shift->storage->connect_info->[0];
+}
+
+1;
Added: DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test.pm
===================================================================
--- DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test.pm (rev 0)
+++ DBIx-Class-Tokenize/0.01/trunk/t/lib/DBIC/Test.pm 2008-04-30 17:15:41 UTC (rev 4308)
@@ -0,0 +1,109 @@
+package #
+ DBIC::Test;
+
+use strict;
+use warnings;
+
+BEGIN {
+ # little trick by Ovid to pretend to subclass+exporter Test::More
+ use base qw/Test::Builder::Module Class::Accessor::Grouped/;
+ use Test::More;
+ use File::Spec::Functions qw/catfile catdir/;
+
+ @DBIC::Test::EXPORT = @Test::More::EXPORT;
+
+ __PACKAGE__->mk_group_accessors('inherited', qw/db_dir db_file/);
+};
+
+__PACKAGE__->db_dir(catdir('t', 'var'));
+__PACKAGE__->db_file('test.db');
+
+sub init_schema {
+ my ( $self, %args ) = @_;
+
+ my $db_dir = $args{'db_dir'} || $self->db_dir;
+ my $db_file = $args{'db_file'} || $self->db_file;
+
+ my $namespace = $args{'namespace'} || 'DBIC::TestSchema';
+ my $db = catfile($db_dir, $db_file);
+
+ eval 'use DBD::SQLite';
+ if ( $@ ) {
+ BAIL_OUT('DBD::SQLite not installed');
+ return;
+ }
+
+ eval 'use DBIC::Test::Schema';
+ if ( $@ ) {
+ BAIL_OUT("Could not load test schema DBIC::Test::Schema: $@");
+ return;
+ }
+
+ unlink($db) if -e $db;
+ unlink($db . '-journal') if -e $db . '-journal';
+ mkdir($db_dir) unless -d $db_dir;
+
+ my $dsn = 'dbi:SQLite:' . $db;
+ my $schema = DBIC::Test::Schema
+ ->compose_namespace($namespace)->connect($dsn);
+ $schema->storage->on_connect_do([
+ 'PRAGMA synchronous = OFF',
+ 'PRAGMA temp_store = MEMORY'
+ ]);
+
+ __PACKAGE__->deploy_schema($schema, %args);
+ __PACKAGE__->populate_schema($schema, %args) unless $args{'no_populate'};
+
+ return $schema;
+}
+
+sub deploy_schema {
+ my ( $self, $schema, %options ) = @_;
+ my $eval = $options{'eval_deploy'};
+
+ eval 'use SQL::Translator';
+
+ if ( !$@ && !$options{'no_deploy'} ) {
+ eval {
+ $schema->deploy();
+ };
+ if ( $@ && !$eval ) {
+ die $@;
+ }
+ } else {
+ unless ( open(IN, catfile('t', 'sql', 'test.sqlite.sql') ) ) {
+ BAIL_OUT("Can't load schema, sorry: $!");
+ return;
+ }
+ my $sql;
+ { local $/ = undef; $sql = <IN>; }
+ close IN;
+ eval {
+ ($schema->storage->dbh->do($_) || print "Error on SQL: $_\n")
+ for split(/;\n/, $sql);
+ };
+ if ( $@ && !$eval ) {
+ die $@;
+ }
+ }
+
+}
+
+sub clear_schema {
+ my ( $self, $schema, %options ) = @_;
+
+ foreach my $source ( $schema->sources ) {
+ $schema->resultset($source)->delete_all;
+ }
+}
+
+sub populate_schema {
+ my ( $self, $schema, %options ) = @_;
+
+ if ( $options{'clear'} ) {
+ $self->clear_schema($schema, %options);
+ }
+ # We don't need any data, but if we did, put it here.
+}
+
+1;
More information about the Bast-commits
mailing list