Commit | Line | Data |
6cedfc23 |
1 | package SQL::Translator::Filter::Names; |
2 | |
3 | # ------------------------------------------------------------------- |
821a0fde |
4 | # $Id$ |
6cedfc23 |
5 | # ------------------------------------------------------------------- |
6 | # Copyright (C) 2002-4 SQLFairy Authors |
7 | # |
8 | # This program is free software; you can redistribute it and/or |
9 | # modify it under the terms of the GNU General Public License as |
10 | # published by the Free Software Foundation; version 2. |
11 | # |
12 | # This program is distributed in the hope that it will be useful, but |
13 | # WITHOUT ANY WARRANTY; without even the implied warranty of |
14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
15 | # General Public License for more details. |
16 | # |
17 | # You should have received a copy of the GNU General Public License |
18 | # along with this program; if not, write to the Free Software |
19 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA |
20 | # 02111-1307 USA |
21 | # ------------------------------------------------------------------- |
22 | |
23 | =head1 NAME |
24 | |
25 | SQL::Translator::Filter::Names - Tweak the names of schema objects. |
26 | |
27 | =head1 SYNOPSIS |
28 | |
29 | #! /usr/bin/perl -w |
30 | use SQL::Translator; |
31 | |
32 | # Lowercase all table names and upper case the first letter of all field |
33 | # names. (MySql style!) |
34 | # |
35 | my $sqlt = SQL::Translator->new( |
36 | filename => \@ARGV, |
37 | from => 'MySQL', |
38 | to => 'MySQL', |
39 | filters => [ |
40 | Names => { |
41 | 'tables' => 'lc', |
42 | 'fields' => 'ucfirst', |
43 | }, |
44 | ], |
45 | ) || die "SQLFairy error : ".SQL::Translator->error; |
46 | print($sqlt->translate) || die "SQLFairy error : ".$sqlt->error; |
47 | |
48 | =cut |
49 | |
50 | use strict; |
51 | use vars qw/$VERSION/; |
52 | $VERSION=0.1; |
53 | |
54 | sub filter { |
55 | my $schema = shift; |
56 | my %args = %{$_[0]}; |
57 | |
58 | # Tables |
59 | #if ( my $func = $args{tables} ) { |
60 | # _filtername($_,$func) foreach ( $schema->get_tables ); |
61 | #} |
62 | # , |
63 | foreach my $type ( qw/tables procedures triggers views/ ) { |
64 | if ( my $func = $args{$type} ) { |
65 | my $meth = "get_$type"; |
66 | _filtername($_,$func) foreach $schema->$meth; |
67 | } |
68 | } |
69 | |
70 | # Fields |
71 | if ( my $func = $args{fields} ) { |
72 | _filtername($_,$func) |
73 | foreach map { $_->get_fields } $schema->get_tables ; |
74 | } |
75 | |
76 | } |
77 | |
78 | # _filtername( OBJ, FUNC_NAME ) |
79 | # Update the name attribute on the schema object given using the named filter. |
80 | # Objects with no name are skipped. |
81 | # Returns true if the name was changed. Dies if there is an error running func. |
82 | sub _filtername { |
83 | my ($obj,$func) = @_; |
84 | return unless my $name = $obj->name; |
85 | $func = _getfunc($func); |
86 | my $newname = eval { $func->($name) }; |
87 | die "$@" if $@; # TODO - Better message! |
88 | return if $name eq $newname; |
89 | $_->name($newname); |
90 | } |
91 | |
92 | # _getfunc( NAME ) - Returns code ref to func NAME or dies. |
93 | sub _getfunc { |
94 | my ($name) = @_; |
95 | no strict 'refs'; |
96 | my $func = "SQL::Translator::Filter::Names::$name"; |
97 | die "Table name filter - unknown function '$name'\n" unless exists &$func; |
98 | \&$func; |
99 | } |
100 | |
101 | |
102 | |
103 | # The name munging functions |
104 | #============================================================================= |
105 | # Get called with name to munge as first arg and return the new name. Die on |
106 | # errors. |
107 | |
108 | sub lc { lc shift; } |
109 | sub uc { uc shift; } |
110 | sub ucfirst { ucfirst shift; } |
111 | |
112 | 1; #========================================================================== |
113 | |
114 | __END__ |
115 | |
116 | =head1 DESCRIPTION |
117 | |
118 | =head1 SEE ALSO |
119 | |
120 | L<perl(1)>, L<SQL::Translator> |
121 | |
122 | =head1 BUGS |
123 | |
124 | =head1 TODO |
125 | |
126 | =over 4 |
127 | |
128 | =item Name Groups |
129 | |
130 | Define a bunch of usefull groups to run the name filters over. e.g. all, fkeys, |
131 | pkeys etc. |
132 | |
133 | =item More Functions |
134 | |
135 | e.g. camelcase, titlecase, single word etc. |
136 | Also a way to pass in a regexp. |
137 | |
138 | May also want a way to pass in arguments for the func e.g. prefix. |
139 | |
140 | =item Multiple Filters on the same name (filter order)? |
141 | |
142 | Do we actually need this, you could just run lots of filters. Would make adding |
143 | func args to the interface easier. |
144 | |
145 | filters => [ |
146 | [ 'Names', { all => 'lc' } ], |
147 | [ 'Names', { |
148 | tables => 'lc', |
149 | fields => 'ucfirst', |
150 | } ], |
151 | ], |
152 | |
153 | Mind you if you could give the filter a list this wouldn't be a problem! |
154 | |
155 | filters => [ |
156 | [ 'Names', |
157 | all => 'lc' |
158 | fields => 'ucfirst', |
159 | ], |
160 | ], |
161 | |
162 | Which is nice. Might have to change the calling conventions for filters. |
163 | Would also provide an order to run the filters in rather than having to hard |
164 | code it into the filter it's self. |
165 | |
166 | =back |
167 | |
168 | =head1 AUTHOR |
169 | |
170 | =cut |