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