Profile of SQL/Translator.pm

← 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:22:37 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator.pm
Statements | Executed 961 statements in 11.5ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
4 | 1 | 1 | 6.35ms | 197ms | SQL::Translator::::translateSQL::Translator::translate
8 | 1 | 1 | 4.12ms | 5.85ms | SQL::Translator::::loadSQL::Translator::load
1 | 1 | 1 | 2.18ms | 19.0ms | SQL::Translator::::BEGIN@39SQL::Translator::BEGIN@39
1 | 1 | 1 | 853µs | 6.47ms | SQL::Translator::::BEGIN@37SQL::Translator::BEGIN@37
1 | 1 | 1 | 365µs | 560µs | SQL::Translator::::BEGIN@35SQL::Translator::BEGIN@35
1 | 1 | 1 | 356µs | 418µs | SQL::Translator::::BEGIN@38SQL::Translator::BEGIN@38
4 | 1 | 1 | 259µs | 6.88ms | SQL::Translator::::initSQL::Translator::init
16 | 2 | 1 | 197µs | 6.29ms | SQL::Translator::::_toolSQL::Translator::_tool
12 | 2 | 1 | 131µs | 200µs | SQL::Translator::::_argsSQL::Translator::_args
28 | 5 | 1 | 105µs | 172µs | SQL::Translator::::isaSQL::Translator::isa
8 | 1 | 1 | 95µs | 5.97ms | SQL::Translator::::_load_subSQL::Translator::_load_sub
46 | 6 | 1 | 89µs | 89µs | SQL::Translator::::CORE:matchSQL::Translator::CORE:match (opcode)
8 | 2 | 1 | 58µs | 118µs | SQL::Translator::::dataSQL::Translator::data
12 | 3 | 3 | 53µs | 327µs | SQL::Translator::::schemaSQL::Translator::schema
4 | 1 | 1 | 52µs | 52µs | SQL::Translator::::filtersSQL::Translator::filters
8 | 2 | 1 | 44µs | 44µs | SQL::Translator::::validateSQL::Translator::validate
8 | 2 | 1 | 43µs | 3.71ms | SQL::Translator::::parserSQL::Translator::parser
8 | 2 | 2 | 39µs | 220µs | SQL::Translator::::producer_argsSQL::Translator::producer_args
8 | 2 | 1 | 36µs | 2.65ms | SQL::Translator::::producerSQL::Translator::producer
8 | 2 | 2 | 25µs | 25µs | SQL::Translator::::show_warningsSQL::Translator::show_warnings
8 | 2 | 2 | 24µs | 24µs | SQL::Translator::::no_commentsSQL::Translator::no_comments
8 | 1 | 1 | 22µs | 22µs | SQL::Translator::::CORE:substSQL::Translator::CORE:subst (opcode)
2 | 1 | 1 | 22µs | 22µs | SQL::Translator::::CORE:regcompSQL::Translator::CORE:regcomp (opcode)
8 | 2 | 2 | 20µs | 20µs | SQL::Translator::::add_drop_tableSQL::Translator::add_drop_table
1 | 1 | 1 | 15µs | 20µs | SQL::Translator::::BEGIN@21SQL::Translator::BEGIN@21
4 | 1 | 1 | 12µs | 12µs | SQL::Translator::::quote_table_namesSQL::Translator::quote_table_names
4 | 1 | 1 | 12µs | 12µs | SQL::Translator::::quote_field_namesSQL::Translator::quote_field_names
4 | 1 | 1 | 11µs | 30µs | SQL::Translator::::parser_argsSQL::Translator::parser_args
1 | 1 | 1 | 11µs | 36µs | SQL::Translator::::BEGIN@34SQL::Translator::BEGIN@34
1 | 1 | 1 | 11µs | 1.12ms | SQL::Translator::::BEGIN@23SQL::Translator::BEGIN@23
4 | 1 | 1 | 11µs | 11µs | SQL::Translator::::traceSQL::Translator::trace
1 | 1 | 1 | 10µs | 41µs | SQL::Translator::::BEGIN@36SQL::Translator::BEGIN@36
1 | 1 | 1 | 10µs | 51µs | SQL::Translator::::BEGIN@31SQL::Translator::BEGIN@31
1 | 1 | 1 | 10µs | 34µs | SQL::Translator::::BEGIN@33SQL::Translator::BEGIN@33
1 | 1 | 1 | 8µs | 63µs | SQL::Translator::::BEGIN@22SQL::Translator::BEGIN@22
4 | 1 | 1 | 7µs | 7µs | SQL::Translator::::parser_typeSQL::Translator::parser_type
4 | 1 | 1 | 7µs | 7µs | SQL::Translator::::producer_typeSQL::Translator::producer_type
0 | 0 | 0 | 0s | 0s | SQL::Translator::::__ANON__[:46]SQL::Translator::__ANON__[:46]
0 | 0 | 0 | 0s | 0s | SQL::Translator::::__ANON__[:733]SQL::Translator::__ANON__[:733]
0 | 0 | 0 | 0s | 0s | SQL::Translator::::__ANON__[:832]SQL::Translator::__ANON__[:832]
0 | 0 | 0 | 0s | 0s | SQL::Translator::::_format_nameSQL::Translator::_format_name
0 | 0 | 0 | 0s | 0s | SQL::Translator::::_listSQL::Translator::_list
0 | 0 | 0 | 0s | 0s | SQL::Translator::::filenameSQL::Translator::filename
0 | 0 | 0 | 0s | 0s | SQL::Translator::::format_fk_nameSQL::Translator::format_fk_name
0 | 0 | 0 | 0s | 0s | SQL::Translator::::format_package_nameSQL::Translator::format_package_name
0 | 0 | 0 | 0s | 0s | SQL::Translator::::format_pk_nameSQL::Translator::format_pk_name
0 | 0 | 0 | 0s | 0s | SQL::Translator::::format_table_nameSQL::Translator::format_table_name
0 | 0 | 0 | 0s | 0s | SQL::Translator::::list_parsersSQL::Translator::list_parsers
0 | 0 | 0 | 0s | 0s | SQL::Translator::::list_producersSQL::Translator::list_producers
0 | 0 | 0 | 0s | 0s | SQL::Translator::::resetSQL::Translator::reset
0 | 0 | 0 | 0s | 0s | SQL::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package 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 |  |  |  |  |
21 | 3 | 26µs | 2 | 24µ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
22 | 3 | 23µs | 2 | 118µ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
23 | 3 | 44µs | 2 | 2.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 |  |  |  |  |
25 | 1 | 55µs |  |  | require 5.005;
26 |  |  |  |  |
27 | 1 | 600ns |  |  | $VERSION = '0.11010';
28 | 1 | 700ns |  |  | $DEBUG = 0 unless defined $DEBUG;
29 | 1 | 400ns |  |  | $ERROR = "";
30 |  |  |  |  |
31 | 3 | 23µs | 2 | 91µ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 |  |  |  |  |
33 | 3 | 21µs | 2 | 58µ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
34 | 3 | 23µs | 2 | 61µ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
35 | 3 | 95µs | 2 | 617µ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
36 | 3 | 21µs | 2 | 71µ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
37 | 3 | 124µs | 2 | 6.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
38 | 3 | 119µs | 1 | 418µ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
39 | 3 | 2.76ms | 1 | 19.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 |  |  |  |  | # ----------------------------------------------------------------------
46 | 1 | 2µ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 {
62 | 76 | 187µ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 |  |  |  |  | #
70 |  |  | 4 | 3.69ms | $self->parser ($config->{'parser'} || $config->{'from'} || $DEFAULT_SUB); # spent 3.69ms making 4 calls to SQL::Translator::parser, avg 922µs/call
71 |  |  | 4 | 2.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 ] ) {
86 |  |  | 4 | 106µ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 |  |  |  |  | #
107 |  |  | 4 | 110µ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 |  |  |  |  |
116 |  |  | 4 | 11µ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 |  |  |  |  |
118 |  |  | 4 | 12µs | $self->no_comments( $config->{'no_comments'} ); # spent 12µs making 4 calls to SQL::Translator::no_comments, avg 3µs/call
119 |  |  |  |  |
120 |  |  | 4 | 12µs | $self->show_warnings( $config->{'show_warnings'} ); # spent 12µs making 4 calls to SQL::Translator::show_warnings, avg 3µs/call
121 |  |  |  |  |
122 |  |  | 4 | 11µs | $self->trace( $config->{'trace'} ); # spent 11µs making 4 calls to SQL::Translator::trace, avg 3µs/call
123 |  |  |  |  |
124 |  |  | 4 | 10µs | $self->validate( $config->{'validate'} ); # spent 10µs making 4 calls to SQL::Translator::validate, avg 3µs/call
125 |  |  |  |  |
126 |  |  | 4 | 12µ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) );
128 |  |  | 4 | 12µ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 {
138 | 24 | 31µ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 {
149 | 32 | 31µ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 {
162 | 12 | 21µ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 {
173 | 12 | 16µ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({
187 | 8 | 39µs | 8 | 2.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 |  |  |  |  | # ----------------------------------------------------------------------
202 | 4 | 11µ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 |  |  |  |  | # ----------------------------------------------------------------------
214 | 8 | 40µs | 8 | 181µ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({
221 | 8 | 43µs | 8 | 3.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 |  |  |  |  |
227 | 4 | 13µ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 |  |  |  |  |
229 | 4 | 14µs | 4 | 19µ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 {
243 | 12 | 56µ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 {
266 | 32 | 38µ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
276 |  |  |  |  | sub 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 {
307 | 48 | 53µ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.
311 |  |  |  |  | if (@_) {
312 |  |  |  |  | my $data = shift;
313 |  |  | 4 | 31µ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 {
317 |  |  | 8 | 28µ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 |  |  |  |  | # ----------------------------------------------------------------------
360 |  |  |  |  | sub 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 |  |  |  |  | #
375 | 36 | 63µs |  |  | my $self = shift;
376 |  |  |  |  |
377 |  |  | 4 | 274µ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 {
388 | 16 | 14µ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 {
412 | 112 | 6.30ms |  |  | my $self = shift;
413 |  |  |  |  | my ($args, $parser, $parser_type, $producer, $producer_type);
414 |  |  |  |  | my ($parser_output, $producer_output, @producer_output);
415 |  |  |  |  |
416 |  |  |  |  | # Parse arguments
417 |  |  |  |  | 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 |  |  |  |  | # ----------------------------------------------------------------
479 |  |  | 4 | 7µ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 |  |  |  |  | }
487 |  |  | 4 | 24µs | $parser = $self->parser; # spent 24µs making 4 calls to SQL::Translator::parser, avg 6µs/call
488 |  |  | 4 | 7µ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 |  |  |  |  | }
496 |  |  | 4 | 20µs | $producer = $self->producer; # spent 20µs making 4 calls to SQL::Translator::producer, avg 5µs/call
497 |  |  | 4 | 7µ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
508 |  |  |  |  | unless ( defined $self->{'schema'} ) {
509 |  |  | 4 | 118ms | 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 |  |  |  |  | }
516 |  |  | 12 | 32.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.
519 |  |  | 4 | 33µ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;
526 |  |  | 4 | 52µ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;
537 |  |  |  |  | eval {
538 |  |  | 4 | 39.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 |  |  |  |  | # ----------------------------------------------------------------------
573 |  |  |  |  | sub 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 |  |  |  |  | # ----------------------------------------------------------------------
583 |  |  |  |  | sub 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 {
598 | 84 | 153µs |  |  | my $self = shift;
599 |  |  |  |  | my $type = shift;
600 |  |  | 12 | 16µs | $type = "${type}_args" unless $type =~ /_args$/; # spent 16µs making 12 calls to SQL::Translator::CORE:match, avg 1µs/call
601 |  |  |  |  |
602 |  |  | 4 | 34µ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 |  |  |  |  |
606 |  |  |  |  | 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 |  |  |  |  |
615 |  |  | 4 | 19µ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 {
631 | 168 | 230µ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
640 |  |  | 8 | 60µ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 {
651 |  |  | 8 | 10µ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);
653 |  |  | 8 | 5.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
667 |  |  | 8 | 25µ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;
670 |  |  | 8 | 23µ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 |  |  |  |  | # ----------------------------------------------------------------------
686 |  |  |  |  | sub _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 {
757 | 102 | 405µs |  |  | my $name = shift;
758 |  |  |  |  | my @path;
759 |  |  | 8 | 4µ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) {
763 |  |  |  |  | my $module = $_ ? "$_\::$name" : $name;
764 |  |  | 8 | 22µs | my $file = $module; $file =~ s[::][/]g; $file .= ".pm"; # spent 22µs making 8 calls to SQL::Translator::CORE:subst, avg 3µs/call
765 |  |  | 8 | 36µ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 |  |  |  |  |
768 |  |  |  |  | eval { require $file };
769 |  |  | 4 | 22µ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
770 |  |  | 1 | 23µ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 {
787 | 40 | 126µs |  |  | my ($tool, @path) = @_;
788 |  |  |  |  |
789 |  |  | 8 | 33µs | my (undef,$module,$func_name) = $tool =~ m/((.*)::)?(\w+)$/; # spent 33µs making 8 calls to SQL::Translator::CORE:match, avg 4µs/call
790 |  |  | 8 | 5.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 |  |  |  |  | # ----------------------------------------------------------------------
798 |  |  |  |  | sub format_table_name {
799 |  |  |  |  | return shift->_format_name('_format_table_name', @_);
800 |  |  |  |  | }
801 |  |  |  |  |
802 |  |  |  |  | # ----------------------------------------------------------------------
803 |  |  |  |  | sub format_package_name {
804 |  |  |  |  | return shift->_format_name('_format_package_name', @_);
805 |  |  |  |  | }
806 |  |  |  |  |
807 |  |  |  |  | # ----------------------------------------------------------------------
808 |  |  |  |  | sub format_fk_name {
809 |  |  |  |  | return shift->_format_name('_format_fk_name', @_);
810 |  |  |  |  | }
811 |  |  |  |  |
812 |  |  |  |  | # ----------------------------------------------------------------------
813 |  |  |  |  | sub 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 |  |  |  |  | # ----------------------------------------------------------------------
823 |  |  |  |  | sub _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($$) {
845 | 56 | 197µs |  |  | my ($ref, $type) = @_;
846 |  |  | 28 | 67µ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 |  |  |  |  | # ----------------------------------------------------------------------
854 |  |  |  |  | sub 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 {
861 | 24 | 79µs |  |  | my ( $self, $arg ) = @_;
862 |  |  |  |  | if ( defined $arg ) {
863 |  |  |  |  | $self->{'validate'} = $arg ? 1 : 0;
864 |  |  |  |  | }
865 |  |  |  |  | return $self->{'validate'} || 0;
866 |  |  |  |  | }
867 |  |  |  |  |
868 | 1 | 6µs |  |  | 1;
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 |  |  |  |  |
881 |  |  |  |  | SQL::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 |  |  |  |  |
922 |  |  |  |  | This documentation covers the API for SQL::Translator. For a more general
923 |  |  |  |  | discussion of how to use the modules and scripts, please see
924 |  |  |  |  | L<SQL::Translator::Manual>.
925 |  |  |  |  |
926 |  |  |  |  | SQL::Translator is a group of Perl modules that converts
927 |  |  |  |  | vendor-specific SQL table definitions into other formats, such as
928 |  |  |  |  | other vendor-specific SQL, ER diagrams, documentation (POD and HTML),
929 |  |  |  |  | XML, and Class::DBI classes. The main focus of SQL::Translator is
930 |  |  |  |  | SQL, but parsers exist for other structured data formats, including
931 |  |  |  |  | Excel spreadsheets and arbitrarily delimited text files. Through the
932 |  |  |  |  | separation of the code into parsers and producers with an object model
933 |  |  |  |  | in between, it's possible to combine any parser with any producer, to
934 |  |  |  |  | plug in custom parsers or producers, or to manipulate the parsed data
935 |  |  |  |  | via the built-in object model. Presently only the definition parts of
936 |  |  |  |  | SQL are handled (CREATE, ALTER), not the manipulation of data (INSERT,
937 |  |  |  |  | UPDATE, DELETE).
938 |  |  |  |  |
939 |  |  |  |  | =head1 CONSTRUCTOR
940 |  |  |  |  |
941 |  |  |  |  | The constructor is called C<new>, and accepts a optional hash of options.
942 |  |  |  |  | Valid options are:
943 |  |  |  |  |
944 |  |  |  |  | =over 4
945 |  |  |  |  |
946 |  |  |  |  | =item *
947 |  |  |  |  |
948 |  |  |  |  | parser / from
949 |  |  |  |  |
950 |  |  |  |  | =item *
951 |  |  |  |  |
952 |  |  |  |  | parser_args
953 |  |  |  |  |
954 |  |  |  |  | =item *
955 |  |  |  |  |
956 |  |  |  |  | producer / to
957 |  |  |  |  |
958 |  |  |  |  | =item *
959 |  |  |  |  |
960 |  |  |  |  | producer_args
961 |  |  |  |  |
962 |  |  |  |  | =item *
963 |  |  |  |  |
964 |  |  |  |  | filters
965 |  |  |  |  |
966 |  |  |  |  | =item *
967 |  |  |  |  |
968 |  |  |  |  | filename / file
969 |  |  |  |  |
970 |  |  |  |  | =item *
971 |  |  |  |  |
972 |  |  |  |  | data
973 |  |  |  |  |
974 |  |  |  |  | =item *
975 |  |  |  |  |
976 |  |  |  |  | debug
977 |  |  |  |  |
978 |  |  |  |  | =item *
979 |  |  |  |  |
980 |  |  |  |  | add_drop_table
981 |  |  |  |  |
982 |  |  |  |  | =item *
983 |  |  |  |  |
984 |  |  |  |  | quote_table_names
985 |  |  |  |  |
986 |  |  |  |  | =item *
987 |  |  |  |  |
988 |  |  |  |  | quote_field_names
989 |  |  |  |  |
990 |  |  |  |  | =item *
991 |  |  |  |  |
992 |  |  |  |  | no_comments
993 |  |  |  |  |
994 |  |  |  |  | =item *
995 |  |  |  |  |
996 |  |  |  |  | trace
997 |  |  |  |  |
998 |  |  |  |  | =item *
999 |  |  |  |  |
1000 |  |  |  |  | validate
1001 |  |  |  |  |
1002 |  |  |  |  | =back
1003 |  |  |  |  |
1004 |  |  |  |  | All options are, well, optional; these attributes can be set via
1005 |  |  |  |  | instance methods. Internally, they are; no (non-syntactical)
1006 |  |  |  |  | advantage is gained by passing options to the constructor.
1007 |  |  |  |  |
1008 |  |  |  |  | =head1 METHODS
1009 |  |  |  |  |
1010 |  |  |  |  | =head2 add_drop_table
1011 |  |  |  |  |
1012 |  |  |  |  | Toggles whether or not to add "DROP TABLE" statements just before the
1013 |  |  |  |  | create definitions.
1014 |  |  |  |  |
1015 |  |  |  |  | =head2 quote_table_names
1016 |  |  |  |  |
1017 |  |  |  |  | Toggles whether or not to quote table names with " in DROP and CREATE
1018 |  |  |  |  | statements. The default (true) is to quote them.
1019 |  |  |  |  |
1020 |  |  |  |  | =head2 quote_field_names
1021 |  |  |  |  |
1022 |  |  |  |  | Toggles whether or not to quote field names with " in most
1023 |  |  |  |  | statements. The default (true), is to quote them.
1024 |  |  |  |  |
1025 |  |  |  |  | =head2 no_comments
1026 |  |  |  |  |
1027 |  |  |  |  | Toggles whether to print comments in the output. Accepts a true or false
1028 |  |  |  |  | value, returns the current value.
1029 |  |  |  |  |
1030 |  |  |  |  | =head2 producer
1031 |  |  |  |  |
1032 |  |  |  |  | The C<producer> method is an accessor/mutator, used to retrieve or
1033 |  |  |  |  | define what subroutine is called to produce the output. A subroutine
1034 |  |  |  |  | defined as a producer will be invoked as a function (I<not a method>)
1035 |  |  |  |  | and passed its container C<SQL::Translator> instance, which it should
1036 |  |  |  |  | call the C<schema> method on, to get the C<SQL::Translator::Schema>
1037 |  |  |  |  | generated by the parser. It is expected that the function transform the
1038 |  |  |  |  | schema structure to a string. The C<SQL::Translator> instance is also useful
1039 |  |  |  |  | for informational purposes; for example, the type of the parser can be
1040 |  |  |  |  | retrieved using the C<parser_type> method, and the C<error> and
1041 |  |  |  |  | C<debug> methods can be called when needed.
1042 |  |  |  |  |
1043 |  |  |  |  | When defining a producer, one of several things can be passed in: A
1044 |  |  |  |  | module name (e.g., C<My::Groovy::Producer>), a module name relative to
1045 |  |  |  |  | the C<SQL::Translator::Producer> namespace (e.g., C<MySQL>), a module
1046 |  |  |  |  | name and function combination (C<My::Groovy::Producer::transmogrify>),
1047 |  |  |  |  | or a reference to an anonymous subroutine. If a full module name is
1048 |  |  |  |  | passed in (for the purposes of this method, a string containing "::"
1049 |  |  |  |  | is considered to be a module name), it is treated as a package, and a
1050 |  |  |  |  | function called "produce" will be invoked: C<$modulename::produce>.
1051 |  |  |  |  | If $modulename cannot be loaded, the final portion is stripped off and
1052 |  |  |  |  | treated as a function. In other words, if there is no file named
1053 |  |  |  |  | F<My/Groovy/Producer/transmogrify.pm>, C<SQL::Translator> will attempt
1054 |  |  |  |  | to load F<My/Groovy/Producer.pm> and use C<transmogrify> as the name of
1055 |  |  |  |  | the 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 |  |  |  |  |
1074 |  |  |  |  | There is also a method named C<producer_type>, which is a string
1075 |  |  |  |  | containing the classname to which the above C<produce> function
1076 |  |  |  |  | belongs. In the case of anonymous subroutines, this method returns
1077 |  |  |  |  | the string "CODE".
1078 |  |  |  |  |
1079 |  |  |  |  | Finally, there is a method named C<producer_args>, which is both an
1080 |  |  |  |  | accessor and a mutator. Arbitrary data may be stored in name => value
1081 |  |  |  |  | pairs 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 |  |  |  |  |
1089 |  |  |  |  | Extra data passed to the C<producer> method is passed to
1090 |  |  |  |  | C<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 |  |  |  |  |
1100 |  |  |  |  | The C<parser> method defines or retrieves a subroutine that will be
1101 |  |  |  |  | called to perform the parsing. The basic idea is the same as that of
1102 |  |  |  |  | C<producer> (see above), except the default subroutine name is
1103 |  |  |  |  | "parse", and will be invoked as C<$module_name::parse($tr, $data)>.
1104 |  |  |  |  | Also, the parser subroutine will be passed a string containing the
1105 |  |  |  |  | entirety 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 |  |  |  |  |
1120 |  |  |  |  | There is also C<parser_type> and C<parser_args>, which perform
1121 |  |  |  |  | analogously to C<producer_type> and C<producer_args>
1122 |  |  |  |  |
1123 |  |  |  |  | =head2 filters
1124 |  |  |  |  |
1125 |  |  |  |  | Set or retreive the filters to run over the schema during the
1126 |  |  |  |  | translation, before the producer creates its output. Filters are sub
1127 |  |  |  |  | routines called, in order, with the schema object to filter as the 1st
1128 |  |  |  |  | arg and a hash of options (passed as a list) for the rest of the args.
1129 |  |  |  |  | They are free to do whatever they want to the schema object, which will be
1130 |  |  |  |  | handed to any following filters, then used by the producer.
1131 |  |  |  |  |
1132 |  |  |  |  | Filters are set as an array, which gives the order they run in.
1133 |  |  |  |  | Like parsers and producers, they can be defined by a module name, a
1134 |  |  |  |  | module name relative to the SQL::Translator::Filter namespace, a module
1135 |  |  |  |  | name and function name together or a reference to an anonymous subroutine.
1136 |  |  |  |  | When using a module name a function called C<filter> will be invoked in
1137 |  |  |  |  | that package to do the work.
1138 |  |  |  |  |
1139 |  |  |  |  | To pass args to the filter set it as an array ref with the 1st value giving
1140 |  |  |  |  | the 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 |  |  |  |  |
1153 |  |  |  |  | Although you normally set them in the constructor, which calls
1154 |  |  |  |  | through to filters. i.e.
1155 |  |  |  |  |
1156 |  |  |  |  | my $translator = SQL::Translator->new(
1157 |  |  |  |  | ...
1158 |  |  |  |  | filters => [
1159 |  |  |  |  | sub { ... },
1160 |  |  |  |  | [ "Names", table => 'lc' ],
1161 |  |  |  |  | ],
1162 |  |  |  |  | ...
1163 |  |  |  |  | );
1164 |  |  |  |  |
1165 |  |  |  |  | See F<t/36-filters.t> for more examples.
1166 |  |  |  |  |
1167 |  |  |  |  | Multiple set calls to filters are cumulative with new filters added to
1168 |  |  |  |  | the end of the current list.
1169 |  |  |  |  |
1170 |  |  |  |  | Returns the filters as a list of array refs, the 1st value being a
1171 |  |  |  |  | reference to the filter sub and the rest its args.
1172 |  |  |  |  |
1173 |  |  |  |  | =head2 show_warnings
1174 |  |  |  |  |
1175 |  |  |  |  | Toggles whether to print warnings of name conflicts, identifier
1176 |  |  |  |  | mutations, etc. Probably only generated by producers to let the user
1177 |  |  |  |  | know when something won't translate very smoothly (e.g., MySQL "enum"
1178 |  |  |  |  | fields into Oracle). Accepts a true or false value, returns the
1179 |  |  |  |  | current value.
1180 |  |  |  |  |
1181 |  |  |  |  | =head2 translate
1182 |  |  |  |  |
1183 |  |  |  |  | The C<translate> method calls the subroutine referenced by the
1184 |  |  |  |  | C<parser> data member, then calls any C<filters> and finally calls
1185 |  |  |  |  | the C<producer> sub routine (these members are described above).
1186 |  |  |  |  | It accepts as arguments a number of things, in key => value format,
1187 |  |  |  |  | including (potentially) a parser and a producer (they are passed
1188 |  |  |  |  | directly to the C<parser> and C<producer> methods).
1189 |  |  |  |  |
1190 |  |  |  |  | Here is how the parameter list to C<translate> is parsed:
1191 |  |  |  |  |
1192 |  |  |  |  | =over
1193 |  |  |  |  |
1194 |  |  |  |  | =item *
1195 |  |  |  |  |
1196 |  |  |  |  | 1 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
1198 |  |  |  |  | reference 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 |  |  |  |  |
1209 |  |  |  |  | More than 1 argument means its a hash of things, and it might be
1210 |  |  |  |  | setting 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 |  |  |  |  |
1224 |  |  |  |  | You get the idea.
1225 |  |  |  |  |
1226 |  |  |  |  | =back
1227 |  |  |  |  |
1228 |  |  |  |  | =head2 filename, data
1229 |  |  |  |  |
1230 |  |  |  |  | Using the C<filename> method, the filename of the data to be parsed
1231 |  |  |  |  | can be set. This method can be used in conjunction with the C<data>
1232 |  |  |  |  | method, below. If both the C<filename> and C<data> methods are
1233 |  |  |  |  | invoked as mutators, the data set in the C<data> method is used.
1234 |  |  |  |  |
1235 |  |  |  |  | $tr->filename("/my/data/files/create.sql");
1236 |  |  |  |  |
1237 |  |  |  |  | or:
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 |  |  |  |  |
1246 |  |  |  |  | C<filename> takes a string, which is interpreted as a filename.
1247 |  |  |  |  | C<data> takes a reference to a string, which is used as the data to be
1248 |  |  |  |  | parsed. If a filename is set, then that file is opened and read when
1249 |  |  |  |  | the C<translate> method is called, as long as the data instance
1250 |  |  |  |  | variable is not set.
1251 |  |  |  |  |
1252 |  |  |  |  | =head2 schema
1253 |  |  |  |  |
1254 |  |  |  |  | Returns the SQL::Translator::Schema object.
1255 |  |  |  |  |
1256 |  |  |  |  | =head2 trace
1257 |  |  |  |  |
1258 |  |  |  |  | Turns on/off the tracing option of Parse::RecDescent.
1259 |  |  |  |  |
1260 |  |  |  |  | =head2 validate
1261 |  |  |  |  |
1262 |  |  |  |  | Whether or not to validate the schema object after parsing and before
1263 |  |  |  |  | producing.
1264 |  |  |  |  |
1265 |  |  |  |  | =head2 version
1266 |  |  |  |  |
1267 |  |  |  |  | Returns the version of the SQL::Translator release.
1268 |  |  |  |  |
1269 |  |  |  |  | =head1 AUTHORS
1270 |  |  |  |  |
1271 |  |  |  |  | See the included AUTHORS file:
1272 |  |  |  |  | L<http://search.cpan.org/dist/SQL-Translator/AUTHORS>
1273 |  |  |  |  |
1274 |  |  |  |  | If you would like to contribute to the project, you can send patches
1275 |  |  |  |  | to the developers mailing list:
1276 |  |  |  |  |
1277 |  |  |  |  | sqlfairy-developers@lists.sourceforge.net
1278 |  |  |  |  |
1279 |  |  |  |  | Or send us a message (with your Sourceforge username) asking to be
1280 |  |  |  |  | added to the project and what you'd like to contribute.
1281 |  |  |  |  |
1282 |  |  |  |  |
1283 |  |  |  |  | =head1 COPYRIGHT
1284 |  |  |  |  |
1285 |  |  |  |  | This program is free software; you can redistribute it and/or modify
1286 |  |  |  |  | it under the terms of the GNU General Public License as published by
1287 |  |  |  |  | the Free Software Foundation; version 2.
1288 |  |  |  |  |
1289 |  |  |  |  | This program is distributed in the hope that it will be useful, but
1290 |  |  |  |  | WITHOUT ANY WARRANTY; without even the implied warranty of
1291 |  |  |  |  | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1292 |  |  |  |  | General Public License for more details.
1293 |  |  |  |  |
1294 |  |  |  |  | You should have received a copy of the GNU General Public License
1295 |  |  |  |  | along with this program; if not, write to the Free Software
1296 |  |  |  |  | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
1297 |  |  |  |  | USA
1298 |  |  |  |  |
1299 |  |  |  |  | =head1 BUGS
1300 |  |  |  |  |
1301 |  |  |  |  | Please use L<http://rt.cpan.org/> for reporting bugs.
1302 |  |  |  |  |
1303 |  |  |  |  | =head1 PRAISE
1304 |  |  |  |  |
1305 |  |  |  |  | If you find this module useful, please use
1306 |  |  |  |  | L<http://cpanratings.perl.org/rate/?distribution=SQL-Translator> to rate it.
1307 |  |  |  |  |
1308 |  |  |  |  | =head1 SEE ALSO
1309 |  |  |  |  |
1310 |  |  |  |  | L<perl>,
1311 |  |  |  |  | L<SQL::Translator::Parser>,
1312 |  |  |  |  | L<SQL::Translator::Producer>,
1313 |  |  |  |  | L<Parse::RecDescent>,
1314 |  |  |  |  | L<GD>,
1315 |  |  |  |  | L<GraphViz>,
1316 |  |  |  |  | L<Text::RecordParser>,
1317 |  |  |  |  | L<Class::DBI>,
1318 |  |  |  |  | L<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