+
+* Added mysql_character_set for 4.1+ -mda
+* Two experimental filters. -mda
+
# -----------------------------------------------------------
# 0.7 2005-06-10
# -----------------------------------------------------------
--- /dev/null
+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<perl(1)>, L<SQL::Translator>
+
+=head1 BUGS
+
+=head1 TODO
+
+=head1 AUTHOR
+
+=cut
--- /dev/null
+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<perl(1)>, L<SQL::Translator>
+
+=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
--- /dev/null
+#!/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";
projects / dbsrgits/SQL-Translator.git / commitdiff