From: Mark Addison Date: Fri, 16 Dec 2005 10:25:00 +0000 (+0000) Subject: Experimental filters X-Git-Tag: v0.11008~475 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6cedfc23b6ba0390722dfeb2e7854b4ea36ae12b;p=dbsrgits%2FSQL-Translator.git Experimental filters --- diff --git a/Changes b/Changes index 73a731a..cbfdf1f 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,7 @@ + +* Added mysql_character_set for 4.1+ -mda +* Two experimental filters. -mda + # ----------------------------------------------------------- # 0.7 2005-06-10 # ----------------------------------------------------------- diff --git a/lib/SQL/Translator/Filter/DefaultExtra.pm b/lib/SQL/Translator/Filter/DefaultExtra.pm new file mode 100644 index 0000000..7766b2e --- /dev/null +++ b/lib/SQL/Translator/Filter/DefaultExtra.pm @@ -0,0 +1,98 @@ +package SQL::Translator::Filter::DefaultExtra; + +# ------------------------------------------------------------------- +# $Id: DefaultExtra.pm,v 1.1 2005-12-16 10:25:00 grommit Exp $ +# ------------------------------------------------------------------- +# Copyright (C) 2002-4 SQLFairy Authors +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=head1 NAME + +SQL::Translator::Filter::DefaultExtra - Set default extra data values for schema +objects. + +=head1 SYNOPSIS + + use SQL::Translator; + + my $sqlt = SQL::Translator->new( + from => 'MySQL', + to => 'MySQL', + filters => [ + DefaultExtra => { + # XXX - These should really be ordered + + # Default widget for fields to basic text edit. + 'field.widget' => 'text', + # idea: + 'field(data_type=BIT).widget' => 'yesno', + + # Default label (human formated name) for fields and tables + 'field.label' => '=ucfirst($name)', + 'table.label' => '=ucfirst($name)', + }, + ], + ) || die "SQLFairy error : ".SQL::Translator->error; + my $sql = $sqlt->translate || die "SQLFairy error : ".$sqlt->error; + +=cut + +use strict; +use vars qw/$VERSION/; +$VERSION=0.1; + +sub filter { + my $schema = shift; + my %args = { +shift }; + + # Tables + foreach ( $schema->get_tables ) { + my %extra = $_->extra; + + $extra{label} ||= ucfirst($_->name); + $_->extra( %extra ); + } + + # Fields + foreach ( map { $_->get_fields } $schema->get_tables ) { + my %extra = $_->extra; + + $extra{label} ||= ucfirst($_->name); + $_->extra( %extra ); + } +} + +1; + +__END__ + +=head1 DESCRIPTION + +Maybe I'm trying to do too much in one go. Args set a match and then an update, +if you want to set lots of things, use lots of filters! + +=head1 SEE ALSO + +L, L + +=head1 BUGS + +=head1 TODO + +=head1 AUTHOR + +=cut diff --git a/lib/SQL/Translator/Filter/Names.pm b/lib/SQL/Translator/Filter/Names.pm new file mode 100644 index 0000000..7c4de15 --- /dev/null +++ b/lib/SQL/Translator/Filter/Names.pm @@ -0,0 +1,170 @@ +package SQL::Translator::Filter::Names; + +# ------------------------------------------------------------------- +# $Id: Names.pm,v 1.1 2005-12-16 10:25:00 grommit Exp $ +# ------------------------------------------------------------------- +# Copyright (C) 2002-4 SQLFairy Authors +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=head1 NAME + +SQL::Translator::Filter::Names - Tweak the names of schema objects. + +=head1 SYNOPSIS + + #! /usr/bin/perl -w + use SQL::Translator; + + # Lowercase all table names and upper case the first letter of all field + # names. (MySql style!) + # + my $sqlt = SQL::Translator->new( + filename => \@ARGV, + from => 'MySQL', + to => 'MySQL', + filters => [ + Names => { + 'tables' => 'lc', + 'fields' => 'ucfirst', + }, + ], + ) || die "SQLFairy error : ".SQL::Translator->error; + print($sqlt->translate) || die "SQLFairy error : ".$sqlt->error; + +=cut + +use strict; +use vars qw/$VERSION/; +$VERSION=0.1; + +sub filter { + my $schema = shift; + my %args = %{$_[0]}; + + # Tables + #if ( my $func = $args{tables} ) { + # _filtername($_,$func) foreach ( $schema->get_tables ); + #} + # , + foreach my $type ( qw/tables procedures triggers views/ ) { + if ( my $func = $args{$type} ) { + my $meth = "get_$type"; + _filtername($_,$func) foreach $schema->$meth; + } + } + + # Fields + if ( my $func = $args{fields} ) { + _filtername($_,$func) + foreach map { $_->get_fields } $schema->get_tables ; + } + +} + +# _filtername( OBJ, FUNC_NAME ) +# Update the name attribute on the schema object given using the named filter. +# Objects with no name are skipped. +# Returns true if the name was changed. Dies if there is an error running func. +sub _filtername { + my ($obj,$func) = @_; + return unless my $name = $obj->name; + $func = _getfunc($func); + my $newname = eval { $func->($name) }; + die "$@" if $@; # TODO - Better message! + return if $name eq $newname; + $_->name($newname); +} + +# _getfunc( NAME ) - Returns code ref to func NAME or dies. +sub _getfunc { + my ($name) = @_; + no strict 'refs'; + my $func = "SQL::Translator::Filter::Names::$name"; + die "Table name filter - unknown function '$name'\n" unless exists &$func; + \&$func; +} + + + +# The name munging functions +#============================================================================= +# Get called with name to munge as first arg and return the new name. Die on +# errors. + +sub lc { lc shift; } +sub uc { uc shift; } +sub ucfirst { ucfirst shift; } + +1; #========================================================================== + +__END__ + +=head1 DESCRIPTION + +=head1 SEE ALSO + +L, L + +=head1 BUGS + +=head1 TODO + +=over 4 + +=item Name Groups + +Define a bunch of usefull groups to run the name filters over. e.g. all, fkeys, +pkeys etc. + +=item More Functions + +e.g. camelcase, titlecase, single word etc. +Also a way to pass in a regexp. + +May also want a way to pass in arguments for the func e.g. prefix. + +=item Multiple Filters on the same name (filter order)? + +Do we actually need this, you could just run lots of filters. Would make adding +func args to the interface easier. + + filters => [ + [ 'Names', { all => 'lc' } ], + [ 'Names', { + tables => 'lc', + fields => 'ucfirst', + } ], + ], + +Mind you if you could give the filter a list this wouldn't be a problem! + + filters => [ + [ 'Names', + all => 'lc' + fields => 'ucfirst', + ], + ], + +Which is nice. Might have to change the calling conventions for filters. +Would also provide an order to run the filters in rather than having to hard +code it into the filter it's self. + +=back + +=head1 AUTHOR + +=cut diff --git a/t/38-filter-names.t b/t/38-filter-names.t new file mode 100644 index 0000000..ab791c6 --- /dev/null +++ b/t/38-filter-names.t @@ -0,0 +1,134 @@ +#!/usr/bin/perl -w +# vim:filetype=perl + +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +# SQL::Translator::Filter::HelloWorld - Test filter in a package +#============================================================================= +package SQL::Translator::Filter::HelloWorld; + +use strict; +use vars qw/$VERSION/; +$VERSION=0.1; + +sub filter { + my ($schema,$args) = (shift,shift); + + my $greeting = $args->{greeting} || "Hello"; + $schema->add_table( + name => "HelloWorld", + ); +} + +# Hack to allow sqlt to see our module as it wasn't loaded from a .pm +$INC{'SQL/Translator/Filter/HelloWorld.pm'} + = 'lib/SQL/Translator/Filter/HelloWorld.pm'; + +#============================================================================= + +package main; + +use strict; +use Test::More; +use Test::Exception; +use Test::SQL::Translator qw(maybe_plan); + +use Data::Dumper; + +BEGIN { + maybe_plan(4, 'YAML', 'Test::Differences') +} +use Test::Differences; +use SQL::Translator; + +my $in_yaml = qq{--- +schema: + tables: + Person: + name: Person + fields: + first_name: + data_type: foovar + name: first_name +}; + +# helloworld: +# comments: '' +# constraints: [] +# fields: {} +# indices: [] +# name: HelloWorld +# options: [] +# order: 2 +my $ans_yaml = qq{--- +schema: + procedures: {} + tables: + person: + comments: '' + constraints: [] + fields: + First_name: + data_type: foovar + default_value: ~ + extra: {} + is_nullable: 1 + is_primary_key: 0 + is_unique: 0 + name: First_name + order: 1 + size: + - 0 + indices: [] + name: person + options: [] + order: 1 + triggers: {} + views: {} +translator: + add_drop_table: 0 + filename: ~ + no_comments: 0 + parser_args: {} + parser_type: SQL::Translator::Parser::YAML + producer_args: {} + producer_type: SQL::Translator::Producer::YAML + show_warnings: 1 + trace: 0 + version: 0.07 +}; + +# Parse the test XML schema +my $obj; +$obj = SQL::Translator->new( + debug => 0, + show_warnings => 1, + from => "YAML", + to => "YAML", + data => $in_yaml, + filters => [ + # Filter from SQL::Translator::Filter::* + [ 'Names', { + tables => 'lc', + fields => 'ucfirst', + } ], + ], + +) or die "Failed to create translator object: ".SQL::Translator->error; + +#sub translate_ok { +# my ($sqlt,$ans_yaml,$name) = @_; +# $name ||= ""; +# +# my $out = eval { $sqlt->translate }; +# fail( $sqlt->error ) if $sqlt->error; +# fail( "No output" ) unless $out; +# eq_or_diff $out, $ans_yaml ,"Translated $name"; +#} + +my $out; +lives_ok { $out = $obj->translate; } "Translate ran"; +is $obj->error, '' ,"No errors"; +ok $out ne "" ,"Produced something!"; +eq_or_diff $out, $ans_yaml ,"Output looks right";