| 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 |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 4 | 1 | 1 | 6.35ms | 197ms | SQL::Translator::translate |
| 8 | 1 | 1 | 4.12ms | 5.85ms | SQL::Translator::load |
| 1 | 1 | 1 | 2.18ms | 19.0ms | SQL::Translator::BEGIN@39 |
| 1 | 1 | 1 | 853µs | 6.47ms | SQL::Translator::BEGIN@37 |
| 1 | 1 | 1 | 365µs | 560µs | SQL::Translator::BEGIN@35 |
| 1 | 1 | 1 | 356µs | 418µs | SQL::Translator::BEGIN@38 |
| 4 | 1 | 1 | 259µs | 6.88ms | SQL::Translator::init |
| 16 | 2 | 1 | 197µs | 6.29ms | SQL::Translator::_tool |
| 12 | 2 | 1 | 131µs | 200µs | SQL::Translator::_args |
| 28 | 5 | 1 | 105µs | 172µs | SQL::Translator::isa |
| 8 | 1 | 1 | 95µs | 5.97ms | SQL::Translator::_load_sub |
| 46 | 6 | 1 | 89µs | 89µs | SQL::Translator::CORE:match (opcode) |
| 8 | 2 | 1 | 58µs | 118µs | SQL::Translator::data |
| 12 | 3 | 3 | 53µs | 327µs | SQL::Translator::schema |
| 4 | 1 | 1 | 52µs | 52µs | SQL::Translator::filters |
| 8 | 2 | 1 | 44µs | 44µs | SQL::Translator::validate |
| 8 | 2 | 1 | 43µs | 3.71ms | SQL::Translator::parser |
| 8 | 2 | 2 | 39µs | 220µs | SQL::Translator::producer_args |
| 8 | 2 | 1 | 36µs | 2.65ms | SQL::Translator::producer |
| 8 | 2 | 2 | 25µs | 25µs | SQL::Translator::show_warnings |
| 8 | 2 | 2 | 24µs | 24µs | SQL::Translator::no_comments |
| 8 | 1 | 1 | 22µs | 22µs | SQL::Translator::CORE:subst (opcode) |
| 2 | 1 | 1 | 22µs | 22µs | SQL::Translator::CORE:regcomp (opcode) |
| 8 | 2 | 2 | 20µs | 20µs | SQL::Translator::add_drop_table |
| 1 | 1 | 1 | 15µs | 20µs | SQL::Translator::BEGIN@21 |
| 4 | 1 | 1 | 12µs | 12µs | SQL::Translator::quote_table_names |
| 4 | 1 | 1 | 12µs | 12µs | SQL::Translator::quote_field_names |
| 4 | 1 | 1 | 11µs | 30µs | SQL::Translator::parser_args |
| 1 | 1 | 1 | 11µs | 36µs | SQL::Translator::BEGIN@34 |
| 1 | 1 | 1 | 11µs | 1.12ms | SQL::Translator::BEGIN@23 |
| 4 | 1 | 1 | 11µs | 11µs | SQL::Translator::trace |
| 1 | 1 | 1 | 10µs | 41µs | SQL::Translator::BEGIN@36 |
| 1 | 1 | 1 | 10µs | 51µs | SQL::Translator::BEGIN@31 |
| 1 | 1 | 1 | 10µs | 34µs | SQL::Translator::BEGIN@33 |
| 1 | 1 | 1 | 8µs | 63µs | SQL::Translator::BEGIN@22 |
| 4 | 1 | 1 | 7µs | 7µs | SQL::Translator::parser_type |
| 4 | 1 | 1 | 7µs | 7µs | SQL::Translator::producer_type |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::__ANON__[:46] |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::__ANON__[:733] |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::__ANON__[:832] |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::_format_name |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::_list |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::filename |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::format_fk_name |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::format_package_name |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::format_pk_name |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::format_table_name |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::list_parsers |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::list_producers |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::reset |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::version |
| 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 | ||||
| 62 | 68 | 164µ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 | 8 | 23µs | 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | 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 | ||
| 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 # spent 181µs making 8 calls to SQL::Translator::_args, avg 23µs/call |
| 215 | |||||
| 216 | # ---------------------------------------------------------------------- | ||||
| 217 | # parser([$parser_spec]) | ||||
| 218 | # ---------------------------------------------------------------------- | ||||
| 219 | 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 | ||
| 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 # 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 | ||||
| 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 | ||||
| 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 | sub data { | ||||
| 307 | 32 | 29µ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 | 8 | 8µs | if (@_) { | ||
| 312 | my $data = shift; | ||||
| 313 | 8 | 16µs | 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 | ||||
| 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 | ||||
| 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 | ||||
| 412 | 88 | 6.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 | ||||
| 417 | 8 | 8µ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 | # ---------------------------------------------------------------- | ||||
| 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 | 8 | 6µs | unless ( defined $self->{'schema'} ) { | ||
| 509 | 4 | 13µs | 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 | 4 | 62µs | 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 | sub _args { | ||||
| 598 | 72 | 128µ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 | 12 | 25µ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 | |||||
| 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 | sub _tool { | ||||
| 631 | 104 | 90µ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 | 64 | 139µs | 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 | ||||
| 757 | 40 | 34µ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 | 58 | 147µs | 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 | 2 | 211µs | 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 | 2 | 14µs | 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 | ||||
| 787 | 24 | 80µ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 | 16 | 46µs | 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 | ||||
| 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 | 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 | |||||
# 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 | |||||
# 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 |