← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:16 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator.pm
StatementsExecuted 961 statements in 11.5ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
4116.35ms197msSQL::Translator::::translateSQL::Translator::translate
8114.12ms5.85msSQL::Translator::::loadSQL::Translator::load
1112.18ms19.0msSQL::Translator::::BEGIN@39SQL::Translator::BEGIN@39
111853µs6.47msSQL::Translator::::BEGIN@37SQL::Translator::BEGIN@37
111365µs560µsSQL::Translator::::BEGIN@35SQL::Translator::BEGIN@35
111356µs418µsSQL::Translator::::BEGIN@38SQL::Translator::BEGIN@38
411259µs6.88msSQL::Translator::::initSQL::Translator::init
1621197µs6.29msSQL::Translator::::_toolSQL::Translator::_tool
1221131µs200µsSQL::Translator::::_argsSQL::Translator::_args
2851105µs172µsSQL::Translator::::isaSQL::Translator::isa
81195µs5.97msSQL::Translator::::_load_subSQL::Translator::_load_sub
466189µs89µsSQL::Translator::::CORE:matchSQL::Translator::CORE:match (opcode)
82158µs118µsSQL::Translator::::dataSQL::Translator::data
123353µs327µsSQL::Translator::::schemaSQL::Translator::schema
41152µs52µsSQL::Translator::::filtersSQL::Translator::filters
82144µs44µsSQL::Translator::::validateSQL::Translator::validate
82143µs3.71msSQL::Translator::::parserSQL::Translator::parser
82239µs220µsSQL::Translator::::producer_argsSQL::Translator::producer_args
82136µs2.65msSQL::Translator::::producerSQL::Translator::producer
82225µs25µsSQL::Translator::::show_warningsSQL::Translator::show_warnings
82224µs24µsSQL::Translator::::no_commentsSQL::Translator::no_comments
81122µs22µsSQL::Translator::::CORE:substSQL::Translator::CORE:subst (opcode)
21122µs22µsSQL::Translator::::CORE:regcompSQL::Translator::CORE:regcomp (opcode)
82220µs20µsSQL::Translator::::add_drop_tableSQL::Translator::add_drop_table
11115µs20µsSQL::Translator::::BEGIN@21SQL::Translator::BEGIN@21
41112µs12µsSQL::Translator::::quote_table_namesSQL::Translator::quote_table_names
41112µs12µsSQL::Translator::::quote_field_namesSQL::Translator::quote_field_names
41111µs30µsSQL::Translator::::parser_argsSQL::Translator::parser_args
11111µs36µsSQL::Translator::::BEGIN@34SQL::Translator::BEGIN@34
11111µs1.12msSQL::Translator::::BEGIN@23SQL::Translator::BEGIN@23
41111µs11µsSQL::Translator::::traceSQL::Translator::trace
11110µs41µsSQL::Translator::::BEGIN@36SQL::Translator::BEGIN@36
11110µs51µsSQL::Translator::::BEGIN@31SQL::Translator::BEGIN@31
11110µs34µsSQL::Translator::::BEGIN@33SQL::Translator::BEGIN@33
1118µs63µsSQL::Translator::::BEGIN@22SQL::Translator::BEGIN@22
4117µs7µsSQL::Translator::::parser_typeSQL::Translator::parser_type
4117µs7µsSQL::Translator::::producer_typeSQL::Translator::producer_type
0000s0sSQL::Translator::::__ANON__[:46]SQL::Translator::__ANON__[:46]
0000s0sSQL::Translator::::__ANON__[:733]SQL::Translator::__ANON__[:733]
0000s0sSQL::Translator::::__ANON__[:832]SQL::Translator::__ANON__[:832]
0000s0sSQL::Translator::::_format_nameSQL::Translator::_format_name
0000s0sSQL::Translator::::_listSQL::Translator::_list
0000s0sSQL::Translator::::filenameSQL::Translator::filename
0000s0sSQL::Translator::::format_fk_nameSQL::Translator::format_fk_name
0000s0sSQL::Translator::::format_package_nameSQL::Translator::format_package_name
0000s0sSQL::Translator::::format_pk_nameSQL::Translator::format_pk_name
0000s0sSQL::Translator::::format_table_nameSQL::Translator::format_table_name
0000s0sSQL::Translator::::list_parsersSQL::Translator::list_parsers
0000s0sSQL::Translator::::list_producersSQL::Translator::list_producers
0000s0sSQL::Translator::::resetSQL::Translator::reset
0000s0sSQL::Translator::::versionSQL::Translator::version
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package SQL::Translator;
2
3# ----------------------------------------------------------------------
4# Copyright (C) 2002-2009 The SQLFairy Authors
5#
6# This program is free software; you can redistribute it and/or
7# modify it under the terms of the GNU General Public License as
8# published by the Free Software Foundation; version 2.
9#
10# This program is distributed in the hope that it will be useful, but
11# WITHOUT ANY WARRANTY; without even the implied warranty of
12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13# General Public License for more details.
14#
15# You should have received a copy of the GNU General Public License
16# along with this program; if not, write to the Free Software
17# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
18# 02111-1307 USA
19# -------------------------------------------------------------------
20
21326µs224µs
# spent 20µs (15+5) within SQL::Translator::BEGIN@21 which was called: # once (15µs+5µs) by DBIx::Class::Optional::Dependencies::_check_deps at line 21
use strict;
# spent 20µs making 1 call to SQL::Translator::BEGIN@21 # spent 5µs making 1 call to strict::import
22323µs2118µs
# spent 63µs (8+55) within SQL::Translator::BEGIN@22 which was called: # once (8µs+55µs) by DBIx::Class::Optional::Dependencies::_check_deps at line 22
use vars qw( $VERSION $DEFAULT_SUB $DEBUG $ERROR );
# spent 63µs making 1 call to SQL::Translator::BEGIN@22 # spent 55µs making 1 call to vars::import
23344µs22.22ms
# spent 1.12ms (11µs+1.10) within SQL::Translator::BEGIN@23 which was called: # once (11µs+1.10ms) by DBIx::Class::Optional::Dependencies::_check_deps at line 23
use base 'Class::Base';
# spent 1.12ms making 1 call to SQL::Translator::BEGIN@23 # spent 1.10ms making 1 call to base::import
24
25155µsrequire 5.005;
26
271600ns$VERSION = '0.11010';
281700ns$DEBUG = 0 unless defined $DEBUG;
291400ns$ERROR = "";
30
31323µs291µs
# spent 51µs (10+41) within SQL::Translator::BEGIN@31 which was called: # once (10µs+41µs) by DBIx::Class::Optional::Dependencies::_check_deps at line 31
use Carp qw(carp);
# spent 51µs making 1 call to SQL::Translator::BEGIN@31 # spent 40µs making 1 call to Exporter::import
32
33321µs258µs
# spent 34µs (10+24) within SQL::Translator::BEGIN@33 which was called: # once (10µs+24µs) by DBIx::Class::Optional::Dependencies::_check_deps at line 33
use Data::Dumper;
# spent 34µs making 1 call to SQL::Translator::BEGIN@33 # spent 24µs making 1 call to Exporter::import
34323µs261µs
# spent 36µs (11+25) within SQL::Translator::BEGIN@34 which was called: # once (11µs+25µs) by DBIx::Class::Optional::Dependencies::_check_deps at line 34
use File::Find;
# spent 36µs making 1 call to SQL::Translator::BEGIN@34 # spent 25µs making 1 call to Exporter::import
35395µs2617µs
# spent 560µs (365+195) within SQL::Translator::BEGIN@35 which was called: # once (365µs+195µs) by DBIx::Class::Optional::Dependencies::_check_deps at line 35
use File::Spec::Functions qw(catfile);
# spent 560µs making 1 call to SQL::Translator::BEGIN@35 # spent 56µs making 1 call to Exporter::import
36321µs271µs
# spent 41µs (10+30) within SQL::Translator::BEGIN@36 which was called: # once (10µs+30µs) by DBIx::Class::Optional::Dependencies::_check_deps at line 36
use File::Basename qw(dirname);
# spent 41µs making 1 call to SQL::Translator::BEGIN@36 # spent 30µs making 1 call to Exporter::import
373124µs26.48ms
# spent 6.47ms (853µs+5.61) within SQL::Translator::BEGIN@37 which was called: # once (853µs+5.61ms) by DBIx::Class::Optional::Dependencies::_check_deps at line 37
use IO::Dir;
# spent 6.47ms making 1 call to SQL::Translator::BEGIN@37 # spent 15µs making 1 call to Exporter::import
383119µs1418µs
# spent 418µs (356+61) within SQL::Translator::BEGIN@38 which was called: # once (356µs+61µs) by DBIx::Class::Optional::Dependencies::_check_deps at line 38
use SQL::Translator::Producer;
# spent 418µs making 1 call to SQL::Translator::BEGIN@38
3932.76ms119.0ms
# spent 19.0ms (2.18+16.8) within SQL::Translator::BEGIN@39 which was called: # once (2.18ms+16.8ms) by DBIx::Class::Optional::Dependencies::_check_deps at line 39
use SQL::Translator::Schema;
# spent 19.0ms making 1 call to SQL::Translator::BEGIN@39
40
41# ----------------------------------------------------------------------
42# The default behavior is to "pass through" values (note that the
43# SQL::Translator instance is the first value ($_[0]), and the stuff
44# to be parsed is the second value ($_[1])
45# ----------------------------------------------------------------------
4612µs$DEFAULT_SUB = sub { $_[0]->schema } unless defined $DEFAULT_SUB;
47
48# ----------------------------------------------------------------------
49# init([ARGS])
50# The constructor.
51#
52# new takes an optional hash of arguments. These arguments may
53# include a parser, specified with the keys "parser" or "from",
54# and a producer, specified with the keys "producer" or "to".
55#
56# The values that can be passed as the parser or producer are
57# given directly to the parser or producer methods, respectively.
58# See the appropriate method description below for details about
59# what each expects/accepts.
60# ----------------------------------------------------------------------
61
# spent 6.88ms (259µs+6.62) within SQL::Translator::init which was called 4 times, avg 1.72ms/call: # 4 times (259µs+6.62ms) by Class::Base::new at line 59 of Class/Base.pm, avg 1.72ms/call
sub init {
6268164µs my ( $self, $config ) = @_;
63 #
64 # Set the parser and producer.
65 #
66 # If a 'parser' or 'from' parameter is passed in, use that as the
67 # parser; if a 'producer' or 'to' parameter is passed in, use that
68 # as the producer; both default to $DEFAULT_SUB.
69 #
7043.69ms $self->parser ($config->{'parser'} || $config->{'from'} || $DEFAULT_SUB);
# spent 3.69ms making 4 calls to SQL::Translator::parser, avg 922µs/call
7142.63ms $self->producer($config->{'producer'} || $config->{'to'} || $DEFAULT_SUB);
# spent 2.63ms making 4 calls to SQL::Translator::producer, avg 658µs/call
72
73 #
74 # Set up callbacks for formatting of pk,fk,table,package names in producer
75 # MOVED TO PRODUCER ARGS
76 #
77 #$self->format_table_name($config->{'format_table_name'});
78 #$self->format_package_name($config->{'format_package_name'});
79 #$self->format_fk_name($config->{'format_fk_name'});
80 #$self->format_pk_name($config->{'format_pk_name'});
81
82 #
83 # Set the parser_args and producer_args
84 #
85 for my $pargs ( qw[ parser_args producer_args ] ) {
86823µs4106µs $self->$pargs( $config->{$pargs} ) if defined $config->{ $pargs };
# spent 106µs making 4 calls to SQL::Translator::producer_args, avg 26µs/call
87 }
88
89 #
90 # Initialize the filters.
91 #
92 if ( $config->{filters} && ref $config->{filters} eq "ARRAY" ) {
93 $self->filters( @{$config->{filters}} )
94 || return $self->error('Error inititializing filters: '.$self->error);
95 }
96
97 #
98 # Set the data source, if 'filename' or 'file' is provided.
99 #
100 $config->{'filename'} ||= $config->{'file'} || "";
101 $self->filename( $config->{'filename'} ) if $config->{'filename'};
102
103 #
104 # Finally, if there is a 'data' parameter, use that in
105 # preference to filename and file
106 #
1074110µs if ( my $data = $config->{'data'} ) {
# spent 110µs making 4 calls to SQL::Translator::data, avg 28µs/call
108 $self->data( $data );
109 }
110
111 #
112 # Set various other options.
113 #
114 $self->{'debug'} = defined $config->{'debug'} ? $config->{'debug'} : $DEBUG;
115
116411µs $self->add_drop_table( $config->{'add_drop_table'} );
# spent 11µs making 4 calls to SQL::Translator::add_drop_table, avg 3µs/call
117
118412µs $self->no_comments( $config->{'no_comments'} );
# spent 12µs making 4 calls to SQL::Translator::no_comments, avg 3µs/call
119
120412µs $self->show_warnings( $config->{'show_warnings'} );
# spent 12µs making 4 calls to SQL::Translator::show_warnings, avg 3µs/call
121
122411µs $self->trace( $config->{'trace'} );
# spent 11µs making 4 calls to SQL::Translator::trace, avg 3µs/call
123
124410µs $self->validate( $config->{'validate'} );
# spent 10µs making 4 calls to SQL::Translator::validate, avg 3µs/call
125
126412µs $self->quote_table_names( (defined $config->{'quote_table_names'}
# spent 12µs making 4 calls to SQL::Translator::quote_table_names, avg 3µs/call
127 ? $config->{'quote_table_names'} : 1) );
128412µs $self->quote_field_names( (defined $config->{'quote_field_names'}
# spent 12µs making 4 calls to SQL::Translator::quote_field_names, avg 3µs/call
129 ? $config->{'quote_field_names'} : 1) );
130
131 return $self;
132}
133
134# ----------------------------------------------------------------------
135# add_drop_table([$bool])
136# ----------------------------------------------------------------------
137
# spent 20µs within SQL::Translator::add_drop_table which was called 8 times, avg 3µs/call: # 4 times (11µs+0s) by SQL::Translator::init at line 116, avg 3µs/call # 4 times (9µs+0s) by SQL::Translator::Producer::SQLite::produce at line 58 of SQL/Translator/Producer/SQLite.pm, avg 2µs/call
sub add_drop_table {
1382431µs my $self = shift;
139 if ( defined (my $arg = shift) ) {
140 $self->{'add_drop_table'} = $arg ? 1 : 0;
141 }
142 return $self->{'add_drop_table'} || 0;
143}
144
145# ----------------------------------------------------------------------
146# no_comments([$bool])
147# ----------------------------------------------------------------------
148
# spent 24µs within SQL::Translator::no_comments which was called 8 times, avg 3µs/call: # 4 times (13µs+0s) by SQL::Translator::Producer::SQLite::produce at line 57 of SQL/Translator/Producer/SQLite.pm, avg 3µs/call # 4 times (12µs+0s) by SQL::Translator::init at line 118, avg 3µs/call
sub no_comments {
1493231µs my $self = shift;
150 my $arg = shift;
151 if ( defined $arg ) {
152 $self->{'no_comments'} = $arg ? 1 : 0;
153 }
154 return $self->{'no_comments'} || 0;
155}
156
157
158# ----------------------------------------------------------------------
159# quote_table_names([$bool])
160# ----------------------------------------------------------------------
161
# spent 12µs within SQL::Translator::quote_table_names which was called 4 times, avg 3µs/call: # 4 times (12µs+0s) by SQL::Translator::init at line 126, avg 3µs/call
sub quote_table_names {
1621221µs my $self = shift;
163 if ( defined (my $arg = shift) ) {
164 $self->{'quote_table_names'} = $arg ? 1 : 0;
165 }
166 return $self->{'quote_table_names'} || 0;
167}
168
169# ----------------------------------------------------------------------
170# quote_field_names([$bool])
171# ----------------------------------------------------------------------
172
# spent 12µs within SQL::Translator::quote_field_names which was called 4 times, avg 3µs/call: # 4 times (12µs+0s) by SQL::Translator::init at line 128, avg 3µs/call
sub quote_field_names {
1731216µs my $self = shift;
174 if ( defined (my $arg = shift) ) {
175 $self->{'quote_field_names'} = $arg ? 1 : 0;
176 }
177 return $self->{'quote_field_names'} || 0;
178}
179
180# ----------------------------------------------------------------------
181# producer([$producer_spec])
182#
183# Get or set the producer for the current translator.
184# ----------------------------------------------------------------------
185
# spent 2.65ms (36µs+2.62) within SQL::Translator::producer which was called 8 times, avg 332µs/call: # 4 times (22µs+2.61ms) by SQL::Translator::init at line 71, avg 658µs/call # 4 times (13µs+7µs) by SQL::Translator::translate at line 496, avg 5µs/call
sub producer {
186 shift->_tool({
187839µs82.62ms name => 'producer',
# spent 2.62ms making 8 calls to SQL::Translator::_tool, avg 327µs/call
188 path => "SQL::Translator::Producer",
189 default_sub => "produce",
190 }, @_);
191}
192
193# ----------------------------------------------------------------------
194# producer_type()
195#
196# producer_type is an accessor that allows producer subs to get
197# information about their origin. This is poptentially important;
198# since all producer subs are called as subroutine references, there is
199# no way for a producer to find out which package the sub lives in
200# originally, for example.
201# ----------------------------------------------------------------------
202411µs
# spent 7µs within SQL::Translator::producer_type which was called 4 times, avg 2µs/call: # 4 times (7µs+0s) by SQL::Translator::translate at line 497, avg 2µs/call
sub producer_type { $_[0]->{'producer_type'} }
203
204# ----------------------------------------------------------------------
205# producer_args([\%args])
206#
207# Arbitrary name => value pairs of paramters can be passed to a
208# producer using this method.
209#
210# If the first argument passed in is undef, then the hash of arguments
211# is cleared; all subsequent elements are added to the hash of name,
212# value pairs stored as producer_args.
213# ----------------------------------------------------------------------
214840µs8181µs
# spent 220µs (39+181) within SQL::Translator::producer_args which was called 8 times, avg 28µs/call: # 4 times (20µs+94µs) by SQL::Translator::Producer::SQLite::produce at line 60 of SQL/Translator/Producer/SQLite.pm, avg 29µs/call # 4 times (19µs+87µs) by SQL::Translator::init at line 86, avg 26µs/call
sub producer_args { shift->_args("producer", @_); }
# spent 181µs making 8 calls to SQL::Translator::_args, avg 23µs/call
215
216# ----------------------------------------------------------------------
217# parser([$parser_spec])
218# ----------------------------------------------------------------------
219
# spent 3.71ms (43µs+3.67) within SQL::Translator::parser which was called 8 times, avg 464µs/call: # 4 times (27µs+3.66ms) by SQL::Translator::init at line 70, avg 922µs/call # 4 times (16µs+8µs) by SQL::Translator::translate at line 487, avg 6µs/call
sub parser {
220 shift->_tool({
221843µs83.67ms name => 'parser',
# spent 3.67ms making 8 calls to SQL::Translator::_tool, avg 459µs/call
222 path => "SQL::Translator::Parser",
223 default_sub => "parse",
224 }, @_);
225}
226
227413µs
# spent 7µs within SQL::Translator::parser_type which was called 4 times, avg 2µs/call: # 4 times (7µs+0s) by SQL::Translator::translate at line 488, avg 2µs/call
sub parser_type { $_[0]->{'parser_type'}; }
228
229414µs419µs
# spent 30µs (11+19) within SQL::Translator::parser_args which was called 4 times, avg 8µs/call: # 4 times (11µs+19µs) by SQL::Translator::Parser::DBIx::Class::parse at line 42 of SQL/Translator/Parser/DBIx/Class.pm, avg 8µs/call
sub parser_args { shift->_args("parser", @_); }
# spent 19µs making 4 calls to SQL::Translator::_args, avg 5µs/call
230
231# ----------------------------------------------------------------------
232# e.g.
233# $sqlt->filters => [
234# sub { },
235# [ "NormalizeNames", field => "lc", tabel => "ucfirst" ],
236# [
237# "DataTypeMap",
238# "TEXT" => "BIGTEXT",
239# ],
240# ],
241# ----------------------------------------------------------------------
242
# spent 52µs within SQL::Translator::filters which was called 4 times, avg 13µs/call: # 4 times (52µs+0s) by SQL::Translator::translate at line 526, avg 13µs/call
sub filters {
2431256µs my $self = shift;
244 my $filters = $self->{filters} ||= [];
245 return @$filters unless @_;
246
247 # Set. Convert args to list of [\&code,@args]
248 foreach (@_) {
249 my ($filt,@args) = ref($_) eq "ARRAY" ? @$_ : $_;
250 if ( isa($filt,"CODE") ) {
251 push @$filters, [$filt,@args];
252 next;
253 }
254 else {
255 $self->debug("Adding $filt filter. Args:".Dumper(\@args)."\n");
256 $filt = _load_sub("$filt\::filter", "SQL::Translator::Filter")
257 || return $self->error(__PACKAGE__->error);
258 push @$filters, [$filt,@args];
259 }
260 }
261 return @$filters;
262}
263
264# ----------------------------------------------------------------------
265
# spent 25µs within SQL::Translator::show_warnings which was called 8 times, avg 3µs/call: # 4 times (13µs+0s) by SQL::Translator::Producer::SQLite::produce at line 56 of SQL/Translator/Producer/SQLite.pm, avg 3µs/call # 4 times (12µs+0s) by SQL::Translator::init at line 120, avg 3µs/call
sub show_warnings {
2663238µs my $self = shift;
267 my $arg = shift;
268 if ( defined $arg ) {
269 $self->{'show_warnings'} = $arg ? 1 : 0;
270 }
271 return $self->{'show_warnings'} || 0;
272}
273
274
275# filename - get or set the filename
276sub filename {
277 my $self = shift;
278 if (@_) {
279 my $filename = shift;
280 if (-d $filename) {
281 my $msg = "Cannot use directory '$filename' as input source";
282 return $self->error($msg);
283 } elsif (ref($filename) eq 'ARRAY') {
284 $self->{'filename'} = $filename;
285 $self->debug("Got array of files: ".join(', ',@$filename)."\n");
286 } elsif (-f _ && -r _) {
287 $self->{'filename'} = $filename;
288 $self->debug("Got filename: '$self->{'filename'}'\n");
289 } else {
290 my $msg = "Cannot use '$filename' as input source: ".
291 "file does not exist or is not readable.";
292 return $self->error($msg);
293 }
294 }
295
296 $self->{'filename'};
297}
298
299# ----------------------------------------------------------------------
300# data([$data])
301#
302# if $self->{'data'} is not set, but $self->{'filename'} is, then
303# $self->{'filename'} is opened and read, with the results put into
304# $self->{'data'}.
305# ----------------------------------------------------------------------
306
# spent 118µs (58+59) within SQL::Translator::data which was called 8 times, avg 15µs/call: # 4 times (51µs+59µs) by SQL::Translator::init at line 107, avg 28µs/call # 4 times (7µs+0s) by SQL::Translator::translate at line 479, avg 2µs/call
sub data {
3073229µs my $self = shift;
308
309 # Set $self->{'data'} based on what was passed in. We will
310 # accept a number of things; do our best to get it right.
31188µs if (@_) {
312 my $data = shift;
313816µs431µs if (isa($data, "SCALAR")) {
# spent 31µs making 4 calls to SQL::Translator::isa, avg 8µs/call
314 $self->{'data'} = $data;
315 }
316 else {
317828µs if (isa($data, 'ARRAY')) {
# spent 28µs making 8 calls to SQL::Translator::isa, avg 4µs/call
318 $data = join '', @$data;
319 }
320 elsif (isa($data, 'GLOB')) {
321 seek ($data, 0, 0) if eof ($data);
322 local $/;
323 $data = <$data>;
324 }
325 elsif (! ref $data && @_) {
326 $data = join '', $data, @_;
327 }
328 $self->{'data'} = \$data;
329 }
330 }
331
332 # If we have a filename but no data yet, populate.
333 if (not $self->{'data'} and my $filename = $self->filename) {
334 $self->debug("Opening '$filename' to get contents.\n");
335 local *FH;
336 local $/;
337 my $data;
338
339 my @files = ref($filename) eq 'ARRAY' ? @$filename : ($filename);
340
341 foreach my $file (@files) {
342 unless (open FH, $file) {
343 return $self->error("Can't read file '$file': $!");
344 }
345
346 $data .= <FH>;
347
348 unless (close FH) {
349 return $self->error("Can't close file '$file': $!");
350 }
351 }
352
353 $self->{'data'} = \$data;
354 }
355
356 return $self->{'data'};
357}
358
359# ----------------------------------------------------------------------
360sub reset {
361#
362# Deletes the existing Schema object so that future calls to translate
363# don't append to the existing.
364#
365 my $self = shift;
366 $self->{'schema'} = undef;
367 return 1;
368}
369
370# ----------------------------------------------------------------------
371
# spent 327µs (53+274) within SQL::Translator::schema which was called 12 times, avg 27µs/call: # 4 times (31µs+274µs) by SQL::Translator::Parser::DBIx::Class::parse at line 53 of SQL/Translator/Parser/DBIx/Class.pm, avg 76µs/call # 4 times (12µs+0s) by SQL::Translator::translate at line 516, avg 3µs/call # 4 times (10µs+0s) by SQL::Translator::Producer::SQLite::produce at line 59 of SQL/Translator/Producer/SQLite.pm, avg 2µs/call
sub schema {
372#
373# Returns the SQL::Translator::Schema object
374#
3753663µs my $self = shift;
376
3774274µs unless ( defined $self->{'schema'} ) {
# spent 274µs making 4 calls to SQL::Translator::Schema::new, avg 69µs/call
378 $self->{'schema'} = SQL::Translator::Schema->new(
379 translator => $self,
380 );
381 }
382
383 return $self->{'schema'};
384}
385
386# ----------------------------------------------------------------------
387
# spent 11µs within SQL::Translator::trace which was called 4 times, avg 3µs/call: # 4 times (11µs+0s) by SQL::Translator::init at line 122, avg 3µs/call
sub trace {
3881614µs my $self = shift;
389 my $arg = shift;
390 if ( defined $arg ) {
391 $self->{'trace'} = $arg ? 1 : 0;
392 }
393 return $self->{'trace'} || 0;
394}
395
396# ----------------------------------------------------------------------
397# translate([source], [\%args])
398#
399# translate does the actual translation. The main argument is the
400# source of the data to be translated, which can be a filename, scalar
401# reference, or glob reference.
402#
403# Alternatively, translate takes optional arguements, which are passed
404# to the appropriate places. Most notable of these arguments are
405# parser and producer, which can be used to set the parser and
406# producer, respectively. This is the applications last chance to set
407# these.
408#
409# translate returns a string.
410# ----------------------------------------------------------------------
411
# spent 197ms (6.35+190) within SQL::Translator::translate which was called 4 times, avg 49.1ms/call: # 4 times (6.35ms+190ms) by DBIx::Class::Storage::DBI::deployment_statements at line 2733 of DBIx/Class/Storage/DBI.pm, avg 49.1ms/call
sub translate {
412886.21ms my $self = shift;
413 my ($args, $parser, $parser_type, $producer, $producer_type);
414 my ($parser_output, $producer_output, @producer_output);
415
416 # Parse arguments
41788µs if (@_ == 1) {
418 # Passed a reference to a hash?
419 if (isa($_[0], 'HASH')) {
420 # yep, a hashref
421 $self->debug("translate: Got a hashref\n");
422 $args = $_[0];
423 }
424
425 # Passed a GLOB reference, i.e., filehandle
426 elsif (isa($_[0], 'GLOB')) {
427 $self->debug("translate: Got a GLOB reference\n");
428 $self->data($_[0]);
429 }
430
431 # Passed a reference to a string containing the data
432 elsif (isa($_[0], 'SCALAR')) {
433 # passed a ref to a string
434 $self->debug("translate: Got a SCALAR reference (string)\n");
435 $self->data($_[0]);
436 }
437
438 # Not a reference; treat it as a filename
439 elsif (! ref $_[0]) {
440 # Not a ref, it's a filename
441 $self->debug("translate: Got a filename\n");
442 $self->filename($_[0]);
443 }
444
445 # Passed something else entirely.
446 else {
447 # We're not impressed. Take your empty string and leave.
448 # return "";
449
450 # Actually, if data, parser, and producer are set, then we
451 # can continue. Too bad, because I like my comment
452 # (above)...
453 return "" unless ($self->data &&
454 $self->producer &&
455 $self->parser);
456 }
457 }
458 else {
459 # You must pass in a hash, or you get nothing.
460 return "" if @_ % 2;
461 $args = { @_ };
462 }
463
464 # ----------------------------------------------------------------------
465 # Can specify the data to be transformed using "filename", "file",
466 # "data", or "datasource".
467 # ----------------------------------------------------------------------
468 if (my $filename = ($args->{'filename'} || $args->{'file'})) {
469 $self->filename($filename);
470 }
471
472 if (my $data = ($args->{'data'} || $args->{'datasource'})) {
473 $self->data($data);
474 }
475
476 # ----------------------------------------------------------------
477 # Get the data.
478 # ----------------------------------------------------------------
47947µs my $data = $self->data;
# spent 7µs making 4 calls to SQL::Translator::data, avg 2µs/call
480
481 # ----------------------------------------------------------------
482 # Local reference to the parser subroutine
483 # ----------------------------------------------------------------
484 if ($parser = ($args->{'parser'} || $args->{'from'})) {
485 $self->parser($parser);
486 }
487424µs $parser = $self->parser;
# spent 24µs making 4 calls to SQL::Translator::parser, avg 6µs/call
48847µs $parser_type = $self->parser_type;
# spent 7µs making 4 calls to SQL::Translator::parser_type, avg 2µs/call
489
490 # ----------------------------------------------------------------
491 # Local reference to the producer subroutine
492 # ----------------------------------------------------------------
493 if ($producer = ($args->{'producer'} || $args->{'to'})) {
494 $self->producer($producer);
495 }
496420µs $producer = $self->producer;
# spent 20µs making 4 calls to SQL::Translator::producer, avg 5µs/call
49747µs $producer_type = $self->producer_type;
# spent 7µs making 4 calls to SQL::Translator::producer_type, avg 2µs/call
498
499 # ----------------------------------------------------------------
500 # Execute the parser, the filters and then execute the producer.
501 # Allowances are made for each piece to die, or fail to compile,
502 # since the referenced subroutines could be almost anything. In
503 # the future, each of these might happen in a Safe environment,
504 # depending on how paranoid we want to be.
505 # ----------------------------------------------------------------
506
507 # Run parser
50886µs unless ( defined $self->{'schema'} ) {
509413µs4118ms eval { $parser_output = $parser->($self, $$data) };
# spent 118ms making 4 calls to SQL::Translator::Parser::DBIx::Class::parse, avg 29.5ms/call
510 if ($@ || ! $parser_output) {
511 my $msg = sprintf "translate: Error with parser '%s': %s",
512 $parser_type, ($@) ? $@ : " no results";
513 return $self->error($msg);
514 }
515 }
5161232.6ms $self->debug("Schema =\n", Dumper($self->schema), "\n");
# spent 32.6ms making 4 calls to Data::Dumper::Dumper, avg 8.14ms/call # spent 55µs making 4 calls to Class::Base::debug, avg 14µs/call # spent 12µs making 4 calls to SQL::Translator::schema, avg 3µs/call
517
518 # Validate the schema if asked to.
519433µs if ($self->validate) {
# spent 33µs making 4 calls to SQL::Translator::validate, avg 8µs/call
520 my $schema = $self->schema;
521 return $self->error('Invalid schema') unless $schema->is_valid;
522 }
523
524 # Run filters
525 my $filt_num = 0;
526452µs foreach ($self->filters) {
# spent 52µs making 4 calls to SQL::Translator::filters, avg 13µs/call
527 $filt_num++;
528 my ($code,@args) = @$_;
529 eval { $code->($self->schema, @args) };
530 my $err = $@ || $self->error || 0;
531 return $self->error("Error with filter $filt_num : $err") if $err;
532 }
533
534 # Run producer
535 # Calling wantarray in the eval no work, wrong scope.
536 my $wantarray = wantarray ? 1 : 0;
537462µs eval {
538439.2ms if ($wantarray) {
# spent 39.2ms making 4 calls to SQL::Translator::Producer::SQLite::produce, avg 9.81ms/call
539 @producer_output = $producer->($self);
540 } else {
541 $producer_output = $producer->($self);
542 }
543 };
544 if ($@ || !( $producer_output || @producer_output)) {
545 my $err = $@ || $self->error || "no results";
546 my $msg = "translate: Error with producer '$producer_type': $err";
547 return $self->error($msg);
548 }
549
550 return wantarray ? @producer_output : $producer_output;
551}
552
553# ----------------------------------------------------------------------
554# list_parsers()
555#
556# Hacky sort of method to list all available parsers. This has
557# several problems:
558#
559# - Only finds things in the SQL::Translator::Parser namespace
560#
561# - Only finds things that are located in the same directory
562# as SQL::Translator::Parser. Yeck.
563#
564# This method will fail in several very likely cases:
565#
566# - Parser modules in different namespaces
567#
568# - Parser modules in the SQL::Translator::Parser namespace that
569# have any XS componenets will be installed in
570# arch_lib/SQL/Translator.
571#
572# ----------------------------------------------------------------------
573sub list_parsers {
574 return shift->_list("parser");
575}
576
577# ----------------------------------------------------------------------
578# list_producers()
579#
580# See notes for list_parsers(), above; all the problems apply to
581# list_producers as well.
582# ----------------------------------------------------------------------
583sub list_producers {
584 return shift->_list("producer");
585}
586
587
588# ======================================================================
589# Private Methods
590# ======================================================================
591
592# ----------------------------------------------------------------------
593# _args($type, \%args);
594#
595# Gets or sets ${type}_args. Called by parser_args and producer_args.
596# ----------------------------------------------------------------------
597
# spent 200µs (131+69) within SQL::Translator::_args which was called 12 times, avg 17µs/call: # 8 times (114µs+67µs) by SQL::Translator::producer_args at line 214, avg 23µs/call # 4 times (17µs+2µs) by SQL::Translator::parser_args at line 229, avg 5µs/call
sub _args {
59872128µs my $self = shift;
599 my $type = shift;
6001216µs $type = "${type}_args" unless $type =~ /_args$/;
# spent 16µs making 12 calls to SQL::Translator::CORE:match, avg 1µs/call
601
602434µs unless (defined $self->{$type} && isa($self->{$type}, 'HASH')) {
# spent 34µs making 4 calls to SQL::Translator::isa, avg 8µs/call
603 $self->{$type} = { };
604 }
605
6061225µs if (@_) {
607 # If the first argument is an explicit undef (remember, we
608 # don't get here unless there is stuff in @_), then we clear
609 # out the producer_args hash.
610 if (! defined $_[0]) {
611 shift @_;
612 %{$self->{$type}} = ();
613 }
614
615419µs my $args = isa($_[0], 'HASH') ? shift : { @_ };
# spent 19µs making 4 calls to SQL::Translator::isa, avg 5µs/call
616 %{$self->{$type}} = (%{$self->{$type}}, %$args);
617 }
618
619 $self->{$type};
620}
621
622# ----------------------------------------------------------------------
623# Does the get/set work for parser and producer. e.g.
624# return $self->_tool({
625# name => 'producer',
626# path => "SQL::Translator::Producer",
627# default_sub => "produce",
628# }, @_);
629# ----------------------------------------------------------------------
630
# spent 6.29ms (197µs+6.09) within SQL::Translator::_tool which was called 16 times, avg 393µs/call: # 8 times (117µs+3.55ms) by SQL::Translator::parser at line 221, avg 459µs/call # 8 times (79µs+2.54ms) by SQL::Translator::producer at line 187, avg 327µs/call
sub _tool {
63110490µs my ($self,$args) = (shift, shift);
632 my $name = $args->{name};
633 return $self->{$name} unless @_; # get accessor
634
635 my $path = $args->{path};
636 my $default_sub = $args->{default_sub};
637 my $tool = shift;
638
639 # passed an anonymous subroutine reference
64064139µs860µs if (isa($tool, 'CODE')) {
# spent 60µs making 8 calls to SQL::Translator::isa, avg 8µs/call
641 $self->{$name} = $tool;
642 $self->{"$name\_type"} = "CODE";
643 $self->debug("Got $name: code ref\n");
644 }
645
646 # Module name was passed directly
647 # We try to load the name; if it doesn't load, there's a
648 # possibility that it has a function name attached to it,
649 # so we give it a go.
650 else {
651810µs $tool =~ s/-/::/g if $tool !~ /::/;
# spent 10µs making 8 calls to SQL::Translator::CORE:match, avg 1µs/call
652 my ($code,$sub);
65385.97ms ($code,$sub) = _load_sub("$tool\::$default_sub", $path);
# spent 5.97ms making 8 calls to SQL::Translator::_load_sub, avg 747µs/call
654 unless ($code) {
655 if ( __PACKAGE__->error =~ m/Can't find module/ ) {
656 # Mod not found so try sub
657 ($code,$sub) = _load_sub("$tool", $path) unless $code;
658 die "Can't load $name subroutine '$tool' : ".__PACKAGE__->error
659 unless $code;
660 }
661 else {
662 die "Can't load $name '$tool' : ".__PACKAGE__->error;
663 }
664 }
665
666 # get code reference and assign
667825µs my (undef,$module,undef) = $sub =~ m/((.*)::)?(\w+)$/;
# spent 25µs making 8 calls to SQL::Translator::CORE:match, avg 3µs/call
668 $self->{$name} = $code;
669 $self->{"$name\_type"} = $sub eq "CODE" ? "CODE" : $module;
670823µs $self->debug("Got $name: $sub\n");
# spent 23µs making 8 calls to Class::Base::debug, avg 3µs/call
671 }
672
673 # At this point, $self->{$name} contains a subroutine
674 # reference that is ready to run
675
676 # Anything left? If so, it's args
677 my $meth = "$name\_args";
678 $self->$meth(@_) if (@_);
679
680 return $self->{$name};
681}
682
683# ----------------------------------------------------------------------
684# _list($type)
685# ----------------------------------------------------------------------
686sub _list {
687 my $self = shift;
688 my $type = shift || return ();
689 my $uctype = ucfirst lc $type;
690
691 #
692 # First find all the directories where SQL::Translator
693 # parsers or producers (the "type") appear to live.
694 #
695 load("SQL::Translator::$uctype") or return ();
696 my $path = catfile "SQL", "Translator", $uctype;
697 my @dirs;
698 for (@INC) {
699 my $dir = catfile $_, $path;
700 $self->debug("_list_${type}s searching $dir\n");
701 next unless -d $dir;
702 push @dirs, $dir;
703 }
704
705 #
706 # Now use File::File::find to look recursively in those
707 # directories for all the *.pm files, then present them
708 # with the slashes turned into dashes.
709 #
710 my %found;
711 find(
712 sub {
713 if ( -f && m/\.pm$/ ) {
714 my $mod = $_;
715 $mod =~ s/\.pm$//;
716 my $cur_dir = $File::Find::dir;
717 my $base_dir = quotemeta catfile 'SQL', 'Translator', $uctype;
718
719 #
720 # See if the current directory is below the base directory.
721 #
722 if ( $cur_dir =~ m/$base_dir(.*)/ ) {
723 $cur_dir = $1;
724 $cur_dir =~ s!^/!!; # kill leading slash
725 $cur_dir =~ s!/!-!g; # turn other slashes into dashes
726 }
727 else {
728 $cur_dir = '';
729 }
730
731 $found{ join '-', map { $_ || () } $cur_dir, $mod } = 1;
732 }
733 },
734 @dirs
735 );
736
737 return sort { lc $a cmp lc $b } keys %found;
738}
739
740# ----------------------------------------------------------------------
741# load(MODULE [,PATH[,PATH]...])
742#
743# Loads a Perl module. Short circuits if a module is already loaded.
744#
745# MODULE - is the name of the module to load.
746#
747# PATH - optional list of 'package paths' to look for the module in. e.g
748# If you called load('Super::Foo' => 'My', 'Other') it will
749# try to load the mod Super::Foo then My::Super::Foo then Other::Super::Foo.
750#
751# Returns package name of the module actually loaded or false and sets error.
752#
753# Note, you can't load a name from the root namespace (ie one without '::' in
754# it), therefore a single word name without a path fails.
755# ----------------------------------------------------------------------
756
# spent 5.85ms (4.12+1.73) within SQL::Translator::load which was called 8 times, avg 731µs/call: # 8 times (4.12ms+1.73ms) by SQL::Translator::_load_sub at line 790, avg 731µs/call
sub load {
7574034µs my $name = shift;
758 my @path;
75984µs push @path, "" if $name =~ /::/; # Empty path to check name on its own first
# spent 4µs making 8 calls to SQL::Translator::CORE:match, avg 462ns/call
760 push @path, @_ if @_;
761
762 foreach (@path) {
76358147µs my $module = $_ ? "$_\::$name" : $name;
764822µs my $file = $module; $file =~ s[::][/]g; $file .= ".pm";
# spent 22µs making 8 calls to SQL::Translator::CORE:subst, avg 3µs/call
765836µs __PACKAGE__->debug("Loading $name as $file\n");
# spent 36µs making 8 calls to Class::Base::debug, avg 4µs/call
766 return $module if $INC{$file}; # Already loaded
767
7682211µs eval { require $file };
769422µs next if $@ =~ /Can't locate $file in \@INC/;
# spent 22µs making 2 calls to SQL::Translator::CORE:regcomp, avg 11µs/call # spent 1µs making 2 calls to SQL::Translator::CORE:match, avg 500ns/call
770214µs123µs eval { $module->import() } unless $@;
# spent 23µs making 1 call to Exporter::import
771 return __PACKAGE__->error("Error loading $name as $module : $@")
772 if $@ && $@ !~ /"SQL::Translator::Producer" is not exported/;
773
774 return $module; # Module loaded ok
775 }
776
777 return __PACKAGE__->error("Can't find module $name. Path:".join(",",@path));
778}
779
780# ----------------------------------------------------------------------
781# Load the sub name given (including package), optionally using a base package
782# path. Returns code ref and name of sub loaded, including its package.
783# (\&code, $sub) = load_sub( 'MySQL::produce', "SQL::Translator::Producer" );
784# (\&code, $sub) = load_sub( 'MySQL::produce', @path );
785# ----------------------------------------------------------------------
786
# spent 5.97ms (95µs+5.88) within SQL::Translator::_load_sub which was called 8 times, avg 747µs/call: # 8 times (95µs+5.88ms) by SQL::Translator::_tool at line 653, avg 747µs/call
sub _load_sub {
7872480µs my ($tool, @path) = @_;
788
789833µs my (undef,$module,$func_name) = $tool =~ m/((.*)::)?(\w+)$/;
# spent 33µs making 8 calls to SQL::Translator::CORE:match, avg 4µs/call
7901646µs85.85ms if ( my $module = load($module => @path) ) {
# spent 5.85ms making 8 calls to SQL::Translator::load, avg 731µs/call
791 my $sub = "$module\::$func_name";
792 return wantarray ? ( \&{ $sub }, $sub ) : \&$sub;
793 }
794 return undef;
795}
796
797# ----------------------------------------------------------------------
798sub format_table_name {
799 return shift->_format_name('_format_table_name', @_);
800}
801
802# ----------------------------------------------------------------------
803sub format_package_name {
804 return shift->_format_name('_format_package_name', @_);
805}
806
807# ----------------------------------------------------------------------
808sub format_fk_name {
809 return shift->_format_name('_format_fk_name', @_);
810}
811
812# ----------------------------------------------------------------------
813sub format_pk_name {
814 return shift->_format_name('_format_pk_name', @_);
815}
816
817# ----------------------------------------------------------------------
818# The other format_*_name methods rely on this one. It optionally
819# accepts a subroutine ref as the first argument (or uses an identity
820# sub if one isn't provided or it doesn't already exist), and applies
821# it to the rest of the arguments (if any).
822# ----------------------------------------------------------------------
823sub _format_name {
824 my $self = shift;
825 my $field = shift;
826 my @args = @_;
827
828 if (ref($args[0]) eq 'CODE') {
829 $self->{$field} = shift @args;
830 }
831 elsif (! exists $self->{$field}) {
832 $self->{$field} = sub { return shift };
833 }
834
835 return @args ? $self->{$field}->(@args) : $self->{$field};
836}
837
838# ----------------------------------------------------------------------
839# isa($ref, $type)
840#
841# Calls UNIVERSAL::isa($ref, $type). I think UNIVERSAL::isa is ugly,
842# but I like function overhead.
843# ----------------------------------------------------------------------
844
# spent 172µs (105+67) within SQL::Translator::isa which was called 28 times, avg 6µs/call: # 8 times (34µs+26µs) by SQL::Translator::_tool at line 640, avg 8µs/call # 8 times (19µs+9µs) by SQL::Translator::data at line 317, avg 4µs/call # 4 times (26µs+7µs) by SQL::Translator::_args at line 602, avg 8µs/call # 4 times (10µs+21µs) by SQL::Translator::data at line 313, avg 8µs/call # 4 times (16µs+3µs) by SQL::Translator::_args at line 615, avg 5µs/call
sub isa($$) {
84556197µs my ($ref, $type) = @_;
8462867µs return UNIVERSAL::isa($ref, $type);
# spent 67µs making 28 calls to UNIVERSAL::isa, avg 2µs/call
847}
848
849# ----------------------------------------------------------------------
850# version
851#
852# Returns the $VERSION of the main SQL::Translator package.
853# ----------------------------------------------------------------------
854sub version {
855 my $self = shift;
856 return $VERSION;
857}
858
859# ----------------------------------------------------------------------
860
# spent 44µs within SQL::Translator::validate which was called 8 times, avg 5µs/call: # 4 times (33µs+0s) by SQL::Translator::translate at line 519, avg 8µs/call # 4 times (10µs+0s) by SQL::Translator::init at line 124, avg 3µs/call
sub validate {
8612479µs my ( $self, $arg ) = @_;
862 if ( defined $arg ) {
863 $self->{'validate'} = $arg ? 1 : 0;
864 }
865 return $self->{'validate'} || 0;
866}
867
86816µs1;
869
870# ----------------------------------------------------------------------
871# Who killed the pork chops?
872# What price bananas?
873# Are you my Angel?
874# Allen Ginsberg
875# ----------------------------------------------------------------------
876
877=pod
878
879=head1 NAME
880
881SQL::Translator - manipulate structured data definitions (SQL and more)
882
883=head1 SYNOPSIS
884
885 use SQL::Translator;
886
887 my $translator = SQL::Translator->new(
888 # Print debug info
889 debug => 1,
890 # Print Parse::RecDescent trace
891 trace => 0,
892 # Don't include comments in output
893 no_comments => 0,
894 # Print name mutations, conflicts
895 show_warnings => 0,
896 # Add "drop table" statements
897 add_drop_table => 1,
898 # to quote or not to quote, thats the question
899 quote_table_names => 1,
900 quote_field_names => 1,
901 # Validate schema object
902 validate => 1,
903 # Make all table names CAPS in producers which support this option
904 format_table_name => sub {my $tablename = shift; return uc($tablename)},
905 # Null-op formatting, only here for documentation's sake
906 format_package_name => sub {return shift},
907 format_fk_name => sub {return shift},
908 format_pk_name => sub {return shift},
909 );
910
911 my $output = $translator->translate(
912 from => 'MySQL',
913 to => 'Oracle',
914 # Or an arrayref of filenames, i.e. [ $file1, $file2, $file3 ]
915 filename => $file,
916 ) or die $translator->error;
917
918 print $output;
919
920=head1 DESCRIPTION
921
922This documentation covers the API for SQL::Translator. For a more general
923discussion of how to use the modules and scripts, please see
924L<SQL::Translator::Manual>.
925
926SQL::Translator is a group of Perl modules that converts
927vendor-specific SQL table definitions into other formats, such as
928other vendor-specific SQL, ER diagrams, documentation (POD and HTML),
929XML, and Class::DBI classes. The main focus of SQL::Translator is
930SQL, but parsers exist for other structured data formats, including
931Excel spreadsheets and arbitrarily delimited text files. Through the
932separation of the code into parsers and producers with an object model
933in between, it's possible to combine any parser with any producer, to
934plug in custom parsers or producers, or to manipulate the parsed data
935via the built-in object model. Presently only the definition parts of
936SQL are handled (CREATE, ALTER), not the manipulation of data (INSERT,
937UPDATE, DELETE).
938
939=head1 CONSTRUCTOR
940
941The constructor is called C<new>, and accepts a optional hash of options.
942Valid options are:
943
944=over 4
945
946=item *
947
948parser / from
949
950=item *
951
952parser_args
953
954=item *
955
956producer / to
957
958=item *
959
960producer_args
961
962=item *
963
964filters
965
966=item *
967
968filename / file
969
970=item *
971
972data
973
974=item *
975
976debug
977
978=item *
979
980add_drop_table
981
982=item *
983
984quote_table_names
985
986=item *
987
988quote_field_names
989
990=item *
991
992no_comments
993
994=item *
995
996trace
997
998=item *
999
1000validate
1001
1002=back
1003
1004All options are, well, optional; these attributes can be set via
1005instance methods. Internally, they are; no (non-syntactical)
1006advantage is gained by passing options to the constructor.
1007
1008=head1 METHODS
1009
1010=head2 add_drop_table
1011
1012Toggles whether or not to add "DROP TABLE" statements just before the
1013create definitions.
1014
1015=head2 quote_table_names
1016
1017Toggles whether or not to quote table names with " in DROP and CREATE
1018statements. The default (true) is to quote them.
1019
1020=head2 quote_field_names
1021
1022Toggles whether or not to quote field names with " in most
1023statements. The default (true), is to quote them.
1024
1025=head2 no_comments
1026
1027Toggles whether to print comments in the output. Accepts a true or false
1028value, returns the current value.
1029
1030=head2 producer
1031
1032The C<producer> method is an accessor/mutator, used to retrieve or
1033define what subroutine is called to produce the output. A subroutine
1034defined as a producer will be invoked as a function (I<not a method>)
1035and passed its container C<SQL::Translator> instance, which it should
1036call the C<schema> method on, to get the C<SQL::Translator::Schema>
1037generated by the parser. It is expected that the function transform the
1038schema structure to a string. The C<SQL::Translator> instance is also useful
1039for informational purposes; for example, the type of the parser can be
1040retrieved using the C<parser_type> method, and the C<error> and
1041C<debug> methods can be called when needed.
1042
1043When defining a producer, one of several things can be passed in: A
1044module name (e.g., C<My::Groovy::Producer>), a module name relative to
1045the C<SQL::Translator::Producer> namespace (e.g., C<MySQL>), a module
1046name and function combination (C<My::Groovy::Producer::transmogrify>),
1047or a reference to an anonymous subroutine. If a full module name is
1048passed in (for the purposes of this method, a string containing "::"
1049is considered to be a module name), it is treated as a package, and a
1050function called "produce" will be invoked: C<$modulename::produce>.
1051If $modulename cannot be loaded, the final portion is stripped off and
1052treated as a function. In other words, if there is no file named
1053F<My/Groovy/Producer/transmogrify.pm>, C<SQL::Translator> will attempt
1054to load F<My/Groovy/Producer.pm> and use C<transmogrify> as the name of
1055the function, instead of the default C<produce>.
1056
1057 my $tr = SQL::Translator->new;
1058
1059 # This will invoke My::Groovy::Producer::produce($tr, $data)
1060 $tr->producer("My::Groovy::Producer");
1061
1062 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
1063 $tr->producer("Sybase");
1064
1065 # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
1066 # assuming that My::Groovy::Producer::transmogrify is not a module
1067 # on disk.
1068 $tr->producer("My::Groovy::Producer::transmogrify");
1069
1070 # This will invoke the referenced subroutine directly, as
1071 # $subref->($tr, $data);
1072 $tr->producer(\&my_producer);
1073
1074There is also a method named C<producer_type>, which is a string
1075containing the classname to which the above C<produce> function
1076belongs. In the case of anonymous subroutines, this method returns
1077the string "CODE".
1078
1079Finally, there is a method named C<producer_args>, which is both an
1080accessor and a mutator. Arbitrary data may be stored in name => value
1081pairs for the producer subroutine to access:
1082
1083 sub My::Random::producer {
1084 my ($tr, $data) = @_;
1085 my $pr_args = $tr->producer_args();
1086
1087 # $pr_args is a hashref.
1088
1089Extra data passed to the C<producer> method is passed to
1090C<producer_args>:
1091
1092 $tr->producer("xSV", delimiter => ',\s*');
1093
1094 # In SQL::Translator::Producer::xSV:
1095 my $args = $tr->producer_args;
1096 my $delimiter = $args->{'delimiter'}; # value is ,\s*
1097
1098=head2 parser
1099
1100The C<parser> method defines or retrieves a subroutine that will be
1101called to perform the parsing. The basic idea is the same as that of
1102C<producer> (see above), except the default subroutine name is
1103"parse", and will be invoked as C<$module_name::parse($tr, $data)>.
1104Also, the parser subroutine will be passed a string containing the
1105entirety of the data to be parsed.
1106
1107 # Invokes SQL::Translator::Parser::MySQL::parse()
1108 $tr->parser("MySQL");
1109
1110 # Invokes My::Groovy::Parser::parse()
1111 $tr->parser("My::Groovy::Parser");
1112
1113 # Invoke an anonymous subroutine directly
1114 $tr->parser(sub {
1115 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
1116 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
1117 return $dumper->Dump;
1118 });
1119
1120There is also C<parser_type> and C<parser_args>, which perform
1121analogously to C<producer_type> and C<producer_args>
1122
1123=head2 filters
1124
1125Set or retreive the filters to run over the schema during the
1126translation, before the producer creates its output. Filters are sub
1127routines called, in order, with the schema object to filter as the 1st
1128arg and a hash of options (passed as a list) for the rest of the args.
1129They are free to do whatever they want to the schema object, which will be
1130handed to any following filters, then used by the producer.
1131
1132Filters are set as an array, which gives the order they run in.
1133Like parsers and producers, they can be defined by a module name, a
1134module name relative to the SQL::Translator::Filter namespace, a module
1135name and function name together or a reference to an anonymous subroutine.
1136When using a module name a function called C<filter> will be invoked in
1137that package to do the work.
1138
1139To pass args to the filter set it as an array ref with the 1st value giving
1140the filter (name or sub) and the rest its args. e.g.
1141
1142 $tr->filters(
1143 sub {
1144 my $schema = shift;
1145 # Do stuff to schema here!
1146 },
1147 DropFKeys,
1148 [ "Names", table => 'lc' ],
1149 [ "Foo", foo => "bar", hello => "world" ],
1150 [ "Filter5" ],
1151 );
1152
1153Although you normally set them in the constructor, which calls
1154through to filters. i.e.
1155
1156 my $translator = SQL::Translator->new(
1157 ...
1158 filters => [
1159 sub { ... },
1160 [ "Names", table => 'lc' ],
1161 ],
1162 ...
1163 );
1164
1165See F<t/36-filters.t> for more examples.
1166
1167Multiple set calls to filters are cumulative with new filters added to
1168the end of the current list.
1169
1170Returns the filters as a list of array refs, the 1st value being a
1171reference to the filter sub and the rest its args.
1172
1173=head2 show_warnings
1174
1175Toggles whether to print warnings of name conflicts, identifier
1176mutations, etc. Probably only generated by producers to let the user
1177know when something won't translate very smoothly (e.g., MySQL "enum"
1178fields into Oracle). Accepts a true or false value, returns the
1179current value.
1180
1181=head2 translate
1182
1183The C<translate> method calls the subroutine referenced by the
1184C<parser> data member, then calls any C<filters> and finally calls
1185the C<producer> sub routine (these members are described above).
1186It accepts as arguments a number of things, in key => value format,
1187including (potentially) a parser and a producer (they are passed
1188directly to the C<parser> and C<producer> methods).
1189
1190Here is how the parameter list to C<translate> is parsed:
1191
1192=over
1193
1194=item *
1195
11961 argument means it's the data to be parsed; which could be a string
1197(filename) or a reference to a scalar (a string stored in memory), or a
1198reference to a hash, which is parsed as being more than one argument
1199(see next section).
1200
1201 # Parse the file /path/to/datafile
1202 my $output = $tr->translate("/path/to/datafile");
1203
1204 # Parse the data contained in the string $data
1205 my $output = $tr->translate(\$data);
1206
1207=item *
1208
1209More than 1 argument means its a hash of things, and it might be
1210setting a parser, producer, or datasource (this key is named
1211"filename" or "file" if it's a file, or "data" for a SCALAR reference.
1212
1213 # As above, parse /path/to/datafile, but with different producers
1214 for my $prod ("MySQL", "XML", "Sybase") {
1215 print $tr->translate(
1216 producer => $prod,
1217 filename => "/path/to/datafile",
1218 );
1219 }
1220
1221 # The filename hash key could also be:
1222 datasource => \$data,
1223
1224You get the idea.
1225
1226=back
1227
1228=head2 filename, data
1229
1230Using the C<filename> method, the filename of the data to be parsed
1231can be set. This method can be used in conjunction with the C<data>
1232method, below. If both the C<filename> and C<data> methods are
1233invoked as mutators, the data set in the C<data> method is used.
1234
1235 $tr->filename("/my/data/files/create.sql");
1236
1237or:
1238
1239 my $create_script = do {
1240 local $/;
1241 open CREATE, "/my/data/files/create.sql" or die $!;
1242 <CREATE>;
1243 };
1244 $tr->data(\$create_script);
1245
1246C<filename> takes a string, which is interpreted as a filename.
1247C<data> takes a reference to a string, which is used as the data to be
1248parsed. If a filename is set, then that file is opened and read when
1249the C<translate> method is called, as long as the data instance
1250variable is not set.
1251
1252=head2 schema
1253
1254Returns the SQL::Translator::Schema object.
1255
1256=head2 trace
1257
1258Turns on/off the tracing option of Parse::RecDescent.
1259
1260=head2 validate
1261
1262Whether or not to validate the schema object after parsing and before
1263producing.
1264
1265=head2 version
1266
1267Returns the version of the SQL::Translator release.
1268
1269=head1 AUTHORS
1270
1271See the included AUTHORS file:
1272L<http://search.cpan.org/dist/SQL-Translator/AUTHORS>
1273
1274If you would like to contribute to the project, you can send patches
1275to the developers mailing list:
1276
1277 sqlfairy-developers@lists.sourceforge.net
1278
1279Or send us a message (with your Sourceforge username) asking to be
1280added to the project and what you'd like to contribute.
1281
1282
1283=head1 COPYRIGHT
1284
1285This program is free software; you can redistribute it and/or modify
1286it under the terms of the GNU General Public License as published by
1287the Free Software Foundation; version 2.
1288
1289This program is distributed in the hope that it will be useful, but
1290WITHOUT ANY WARRANTY; without even the implied warranty of
1291MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1292General Public License for more details.
1293
1294You should have received a copy of the GNU General Public License
1295along with this program; if not, write to the Free Software
1296Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
1297USA
1298
1299=head1 BUGS
1300
1301Please use L<http://rt.cpan.org/> for reporting bugs.
1302
1303=head1 PRAISE
1304
1305If you find this module useful, please use
1306L<http://cpanratings.perl.org/rate/?distribution=SQL-Translator> to rate it.
1307
1308=head1 SEE ALSO
1309
1310L<perl>,
1311L<SQL::Translator::Parser>,
1312L<SQL::Translator::Producer>,
1313L<Parse::RecDescent>,
1314L<GD>,
1315L<GraphViz>,
1316L<Text::RecordParser>,
1317L<Class::DBI>,
1318L<XML::Writer>.
 
# spent 89µs within SQL::Translator::CORE:match which was called 46 times, avg 2µs/call: # 12 times (16µs+0s) by SQL::Translator::_args at line 600, avg 1µs/call # 8 times (33µs+0s) by SQL::Translator::_load_sub at line 789, avg 4µs/call # 8 times (25µs+0s) by SQL::Translator::_tool at line 667, avg 3µs/call # 8 times (10µs+0s) by SQL::Translator::_tool at line 651, avg 1µs/call # 8 times (4µs+0s) by SQL::Translator::load at line 759, avg 462ns/call # 2 times (1µs+0s) by SQL::Translator::load at line 769, avg 500ns/call
sub SQL::Translator::CORE:match; # opcode
# spent 22µs within SQL::Translator::CORE:regcomp which was called 2 times, avg 11µs/call: # 2 times (22µs+0s) by SQL::Translator::load at line 769, avg 11µs/call
sub SQL::Translator::CORE:regcomp; # opcode
# spent 22µs within SQL::Translator::CORE:subst which was called 8 times, avg 3µs/call: # 8 times (22µs+0s) by SQL::Translator::load at line 764, avg 3µs/call
sub SQL::Translator::CORE:subst; # opcode