| Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Utils.pm |
| Statements | Executed 6900 statements in 13.0ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1584 | 6 | 5 | 7.46ms | 8.96ms | SQL::Translator::Utils::parse_list_arg |
| 281 | 4 | 1 | 1.37ms | 1.37ms | SQL::Translator::Utils::debug |
| 420 | 1 | 1 | 616µs | 616µs | SQL::Translator::Utils::CORE:subst (opcode) |
| 1 | 1 | 1 | 549µs | 1.00ms | SQL::Translator::Utils::BEGIN@24 |
| 4 | 1 | 1 | 109µs | 171µs | SQL::Translator::Utils::parse_dbms_version |
| 8 | 1 | 1 | 62µs | 62µs | SQL::Translator::Utils::CORE:match (opcode) |
| 1 | 1 | 1 | 13µs | 15µs | SQL::Translator::Utils::BEGIN@21 |
| 1 | 1 | 1 | 9µs | 22µs | SQL::Translator::Utils::BEGIN@25 |
| 1 | 1 | 1 | 9µs | 23µs | SQL::Translator::Utils::BEGIN@56 |
| 1 | 1 | 1 | 8µs | 53µs | SQL::Translator::Utils::BEGIN@33 |
| 1 | 1 | 1 | 7µs | 57µs | SQL::Translator::Utils::BEGIN@22 |
| 1 | 1 | 1 | 6µs | 45µs | SQL::Translator::Utils::BEGIN@23 |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Utils::header_comment |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Utils::normalize_name |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Utils::parse_mysql_version |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Utils::truncate_id_uniquely |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package SQL::Translator::Utils; | ||||
| 2 | |||||
| 3 | # ---------------------------------------------------------------------- | ||||
| 4 | # Copyright (C) 2002-2009 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 | 19µs | 2 | 17µs | # spent 15µs (13+2) within SQL::Translator::Utils::BEGIN@21 which was called:
# once (13µs+2µs) by SQL::Translator::Schema::Procedure::BEGIN@49 at line 21 # spent 15µs making 1 call to SQL::Translator::Utils::BEGIN@21
# spent 2µs making 1 call to strict::import |
| 22 | 3 | 20µs | 2 | 108µs | # spent 57µs (7+50) within SQL::Translator::Utils::BEGIN@22 which was called:
# once (7µs+50µs) by SQL::Translator::Schema::Procedure::BEGIN@49 at line 22 # spent 57µs making 1 call to SQL::Translator::Utils::BEGIN@22
# spent 50µs making 1 call to base::import |
| 23 | 3 | 19µs | 2 | 84µs | # spent 45µs (6+39) within SQL::Translator::Utils::BEGIN@23 which was called:
# once (6µs+39µs) by SQL::Translator::Schema::Procedure::BEGIN@49 at line 23 # spent 45µs making 1 call to SQL::Translator::Utils::BEGIN@23
# spent 39µs making 1 call to vars::import |
| 24 | 3 | 84µs | 2 | 1.05ms | # spent 1.00ms (549µs+454µs) within SQL::Translator::Utils::BEGIN@24 which was called:
# once (549µs+454µs) by SQL::Translator::Schema::Procedure::BEGIN@49 at line 24 # spent 1.00ms making 1 call to SQL::Translator::Utils::BEGIN@24
# spent 48µs making 1 call to Exporter::import |
| 25 | 3 | 42µs | 2 | 34µs | # spent 22µs (9+12) within SQL::Translator::Utils::BEGIN@25 which was called:
# once (9µs+12µs) by SQL::Translator::Schema::Procedure::BEGIN@49 at line 25 # spent 22µs making 1 call to SQL::Translator::Utils::BEGIN@25
# spent 12µs making 1 call to Exporter::import |
| 26 | |||||
| 27 | 1 | 600ns | $VERSION = '1.59'; | ||
| 28 | 1 | 600ns | $DEFAULT_COMMENT = '-- '; | ||
| 29 | 1 | 2µs | @EXPORT_OK = qw( | ||
| 30 | debug normalize_name header_comment parse_list_arg truncate_id_uniquely | ||||
| 31 | $DEFAULT_COMMENT parse_mysql_version parse_dbms_version | ||||
| 32 | ); | ||||
| 33 | 3 | 41µs | 2 | 97µs | # spent 53µs (8+44) within SQL::Translator::Utils::BEGIN@33 which was called:
# once (8µs+44µs) by SQL::Translator::Schema::Procedure::BEGIN@49 at line 33 # spent 53µs making 1 call to SQL::Translator::Utils::BEGIN@33
# spent 44µs making 1 call to constant::import |
| 34 | |||||
| 35 | # ---------------------------------------------------------------------- | ||||
| 36 | # debug(@msg) | ||||
| 37 | # | ||||
| 38 | # Will send debugging messages to STDERR, if the caller's $DEBUG global | ||||
| 39 | # is set. | ||||
| 40 | # | ||||
| 41 | # This debug() function has a neat feature: Occurances of the strings | ||||
| 42 | # PKG, LINE, and SUB in each message will be replaced with elements | ||||
| 43 | # from caller(): | ||||
| 44 | # | ||||
| 45 | # debug("PKG: Bad things happened on line LINE!"); | ||||
| 46 | # | ||||
| 47 | # Will be warned as: | ||||
| 48 | # | ||||
| 49 | # [SQL::Translator: Bad things happened on line 643] | ||||
| 50 | # | ||||
| 51 | # If called from Translator.pm, on line 643. | ||||
| 52 | # ---------------------------------------------------------------------- | ||||
| 53 | # spent 1.37ms within SQL::Translator::Utils::debug which was called 281 times, avg 5µs/call:
# 240 times (1.10ms+0s) by SQL::Translator::Producer::SQLite::create_field at line 263 of SQL/Translator/Producer/SQLite.pm, avg 5µs/call
# 35 times (188µs+0s) by SQL::Translator::Producer::SQLite::create_table at line 172 of SQL/Translator/Producer/SQLite.pm, avg 5µs/call
# 4 times (70µs+0s) by SQL::Translator::Producer::SQLite::produce at line 66 of SQL/Translator/Producer/SQLite.pm, avg 17µs/call
# 2 times (10µs+0s) by SQL::Translator::Producer::SQLite::create_view at line 136 of SQL/Translator/Producer/SQLite.pm, avg 5µs/call | ||||
| 54 | 562 | 772µs | my ($pkg, $file, $line, $sub) = caller(0); | ||
| 55 | { | ||||
| 56 | 3 | 732µs | 2 | 37µs | # spent 23µs (9+14) within SQL::Translator::Utils::BEGIN@56 which was called:
# once (9µs+14µs) by SQL::Translator::Schema::Procedure::BEGIN@49 at line 56 # spent 23µs making 1 call to SQL::Translator::Utils::BEGIN@56
# spent 14µs making 1 call to strict::unimport |
| 57 | 281 | 844µs | return unless ${"$pkg\::DEBUG"}; | ||
| 58 | } | ||||
| 59 | |||||
| 60 | $sub =~ s/^$pkg\:://; | ||||
| 61 | |||||
| 62 | while (@_) { | ||||
| 63 | my $x = shift; | ||||
| 64 | chomp $x; | ||||
| 65 | $x =~ s/\bPKG\b/$pkg/g; | ||||
| 66 | $x =~ s/\bLINE\b/$line/g; | ||||
| 67 | $x =~ s/\bSUB\b/$sub/g; | ||||
| 68 | #warn '[' . $x . "]\n"; | ||||
| 69 | print STDERR '[' . $x . "]\n"; | ||||
| 70 | } | ||||
| 71 | } | ||||
| 72 | |||||
| 73 | # ---------------------------------------------------------------------- | ||||
| 74 | sub normalize_name { | ||||
| 75 | my $name = shift or return ''; | ||||
| 76 | |||||
| 77 | # The name can only begin with a-zA-Z_; if there's anything | ||||
| 78 | # else, prefix with _ | ||||
| 79 | $name =~ s/^([^a-zA-Z_])/_$1/; | ||||
| 80 | |||||
| 81 | # anything other than a-zA-Z0-9_ in the non-first position | ||||
| 82 | # needs to be turned into _ | ||||
| 83 | $name =~ tr/[a-zA-Z0-9_]/_/c; | ||||
| 84 | |||||
| 85 | # All duplicated _ need to be squashed into one. | ||||
| 86 | $name =~ tr/_/_/s; | ||||
| 87 | |||||
| 88 | # Trim a trailing _ | ||||
| 89 | $name =~ s/_$//; | ||||
| 90 | |||||
| 91 | return $name; | ||||
| 92 | } | ||||
| 93 | |||||
| 94 | # ---------------------------------------------------------------------- | ||||
| 95 | sub header_comment { | ||||
| 96 | my $producer = shift || caller; | ||||
| 97 | my $comment_char = shift; | ||||
| 98 | my $now = scalar localtime; | ||||
| 99 | |||||
| 100 | $comment_char = $DEFAULT_COMMENT | ||||
| 101 | unless defined $comment_char; | ||||
| 102 | |||||
| 103 | my $header_comment =<<"HEADER_COMMENT"; | ||||
| 104 | ${comment_char} | ||||
| 105 | ${comment_char}Created by $producer | ||||
| 106 | ${comment_char}Created on $now | ||||
| 107 | ${comment_char} | ||||
| 108 | HEADER_COMMENT | ||||
| 109 | |||||
| 110 | # Any additional stuff passed in | ||||
| 111 | for my $additional_comment (@_) { | ||||
| 112 | $header_comment .= "${comment_char}${additional_comment}\n"; | ||||
| 113 | } | ||||
| 114 | |||||
| 115 | return $header_comment; | ||||
| 116 | } | ||||
| 117 | |||||
| 118 | # ---------------------------------------------------------------------- | ||||
| 119 | # parse_list_arg | ||||
| 120 | # | ||||
| 121 | # Meant to accept a list, an array reference, or a string of | ||||
| 122 | # comma-separated values. Retuns an array reference of the | ||||
| 123 | # arguments. Modified to also handle a list of references. | ||||
| 124 | # ---------------------------------------------------------------------- | ||||
| 125 | # spent 8.96ms (7.46+1.50) within SQL::Translator::Utils::parse_list_arg which was called 1584 times, avg 6µs/call:
# 578 times (2.30ms+422µs) by SQL::Translator::Schema::Table::primary_key at line 810 of SQL/Translator/Schema/Table.pm, avg 5µs/call
# 480 times (2.90ms+566µs) by SQL::Translator::Schema::Field::size at line 556 of SQL/Translator/Schema/Field.pm, avg 7µs/call
# 433 times (1.70ms+343µs) by SQL::Translator::Schema::Constraint::fields at line 238 of SQL/Translator/Schema/Constraint.pm, avg 5µs/call
# 62 times (329µs+97µs) by SQL::Translator::Schema::Index::fields at line 102 of SQL/Translator/Schema/Index.pm, avg 7µs/call
# 29 times (192µs+45µs) by SQL::Translator::Schema::Constraint::reference_fields at line 421 of SQL/Translator/Schema/Constraint.pm, avg 8µs/call
# 2 times (42µs+24µs) by SQL::Translator::Schema::View::fields at line 91 of SQL/Translator/Schema/View.pm, avg 33µs/call | ||||
| 126 | 3168 | 4.71ms | 1584 | 880µs | my $list = UNIVERSAL::isa( $_[0], 'ARRAY' ) ? shift : [ @_ ]; # spent 880µs making 1584 calls to UNIVERSAL::isa, avg 556ns/call |
| 127 | |||||
| 128 | # | ||||
| 129 | # This protects stringification of references. | ||||
| 130 | # | ||||
| 131 | 1584 | 3.72ms | if ( @$list && ref $list->[0] ) { | ||
| 132 | return $list; | ||||
| 133 | } | ||||
| 134 | # | ||||
| 135 | # This processes string-like arguments. | ||||
| 136 | # | ||||
| 137 | else { | ||||
| 138 | return [ | ||||
| 139 | 420 | 616µs | map { s/^\s+|\s+$//g; $_ } # spent 616µs making 420 calls to SQL::Translator::Utils::CORE:subst, avg 1µs/call | ||
| 140 | map { split /,/ } | ||||
| 141 | 1260 | 1.76ms | grep { defined && length } @$list | ||
| 142 | ]; | ||||
| 143 | } | ||||
| 144 | } | ||||
| 145 | |||||
| 146 | # ---------------------------------------------------------------------- | ||||
| 147 | # truncate_id_uniquely( $desired_name, $max_symbol_length ) | ||||
| 148 | # | ||||
| 149 | # Truncates the name $desired_name to the $max_symbol_length by | ||||
| 150 | # including part of the hash of the full name at the end of the | ||||
| 151 | # truncated name, giving a high probability that the symbol will be | ||||
| 152 | # unique. | ||||
| 153 | # ---------------------------------------------------------------------- | ||||
| 154 | sub truncate_id_uniquely { | ||||
| 155 | my ( $desired_name, $max_symbol_length ) = @_; | ||||
| 156 | |||||
| 157 | return $desired_name | ||||
| 158 | unless defined $desired_name && length $desired_name > $max_symbol_length; | ||||
| 159 | |||||
| 160 | my $truncated_name = substr $desired_name, 0, | ||||
| 161 | $max_symbol_length - COLLISION_TAG_LENGTH - 1; | ||||
| 162 | |||||
| 163 | # Hex isn't the most space-efficient, but it skirts around allowed | ||||
| 164 | # charset issues | ||||
| 165 | my $digest = sha1_hex($desired_name); | ||||
| 166 | my $collision_tag = substr $digest, 0, COLLISION_TAG_LENGTH; | ||||
| 167 | |||||
| 168 | return $truncated_name | ||||
| 169 | . '_' | ||||
| 170 | . $collision_tag; | ||||
| 171 | } | ||||
| 172 | |||||
| 173 | |||||
| 174 | #--------------------------------------------------------------------- | ||||
| 175 | # parse_mysql_version ( $version_string, $result_target) | ||||
| 176 | # | ||||
| 177 | # Attempts to parse an arbitrary string as a mysql version number. | ||||
| 178 | # Returns either a floating point perl style string, or a mysql style | ||||
| 179 | # 5 digit string, depending on the supplied $result_target | ||||
| 180 | #--------------------------------------------------------------------- | ||||
| 181 | sub parse_mysql_version { | ||||
| 182 | my ($v, $target) = @_; | ||||
| 183 | |||||
| 184 | return undef unless $v; | ||||
| 185 | |||||
| 186 | $target ||= 'perl'; | ||||
| 187 | |||||
| 188 | my @vers; | ||||
| 189 | |||||
| 190 | # X.Y.Z style | ||||
| 191 | if ( $v =~ / ^ (\d+) \. (\d{1,3}) (?: \. (\d{1,3}) )? $ /x ) { | ||||
| 192 | push @vers, $1, $2, $3; | ||||
| 193 | } | ||||
| 194 | |||||
| 195 | # XYYZZ (mysql) style | ||||
| 196 | elsif ( $v =~ / ^ (\d) (\d{2}) (\d{2}) $ /x ) { | ||||
| 197 | push @vers, $1, $2, $3; | ||||
| 198 | } | ||||
| 199 | |||||
| 200 | # XX.YYYZZZ (perl) style or simply X | ||||
| 201 | elsif ( $v =~ / ^ (\d+) (?: \. (\d{3}) (\d{3}) )? $ /x ) { | ||||
| 202 | push @vers, $1, $2, $3; | ||||
| 203 | } | ||||
| 204 | else { | ||||
| 205 | #how do I croak sanely here? | ||||
| 206 | die "Unparseable MySQL version '$v'"; | ||||
| 207 | } | ||||
| 208 | |||||
| 209 | if ($target eq 'perl') { | ||||
| 210 | return sprintf ('%d.%03d%03d', map { $_ || 0 } (@vers) ); | ||||
| 211 | } | ||||
| 212 | elsif ($target eq 'mysql') { | ||||
| 213 | return sprintf ('%d%02d%02d', map { $_ || 0 } (@vers) ); | ||||
| 214 | } | ||||
| 215 | else { | ||||
| 216 | #how do I croak sanely here? | ||||
| 217 | die "Unknown version target '$target'"; | ||||
| 218 | } | ||||
| 219 | } | ||||
| 220 | |||||
| 221 | #--------------------------------------------------------------------- | ||||
| 222 | # parse_dbms_version ( $version_string, $target ) | ||||
| 223 | # | ||||
| 224 | # Attempts to parse either a native or perl-style version string into | ||||
| 225 | # a version number format as specified by $target, which can be either | ||||
| 226 | # 'perl' for a perl-style version number, or 'native' for an X.X.X | ||||
| 227 | # style version number. | ||||
| 228 | #--------------------------------------------------------------------- | ||||
| 229 | # spent 171µs (109+62) within SQL::Translator::Utils::parse_dbms_version which was called 4 times, avg 43µs/call:
# 4 times (109µs+62µs) by SQL::Translator::Producer::SQLite::produce at line 61 of SQL/Translator/Producer/SQLite.pm, avg 43µs/call | ||||
| 230 | 20 | 169µs | my ($v, $target) = @_; | ||
| 231 | |||||
| 232 | return undef unless $v; | ||||
| 233 | |||||
| 234 | my @vers; | ||||
| 235 | |||||
| 236 | # X.Y.Z style | ||||
| 237 | 8 | 62µs | if ( $v =~ / ^ (\d+) \. (\d{1,3}) (?: \. (\d{1,3}) )? $ /x ) { # spent 62µs making 8 calls to SQL::Translator::Utils::CORE:match, avg 8µs/call | ||
| 238 | push @vers, $1, $2, $3; | ||||
| 239 | } | ||||
| 240 | |||||
| 241 | # XX.YYYZZZ (perl) style or simply X | ||||
| 242 | elsif ( $v =~ / ^ (\d+) (?: \. (\d{3}) (\d{3}) )? $ /x ) { | ||||
| 243 | push @vers, $1, $2, $3; | ||||
| 244 | } | ||||
| 245 | else { | ||||
| 246 | #how do I croak sanely here? | ||||
| 247 | die "Unparseable database server version '$v'"; | ||||
| 248 | } | ||||
| 249 | |||||
| 250 | if ($target eq 'perl') { | ||||
| 251 | return sprintf ('%d.%03d%03d', map { $_ || 0 } (@vers) ); | ||||
| 252 | } | ||||
| 253 | elsif ($target eq 'native') { | ||||
| 254 | return join '.' => grep defined, @vers; | ||||
| 255 | } | ||||
| 256 | else { | ||||
| 257 | #how do I croak sanely here? | ||||
| 258 | die "Unknown version target '$target'"; | ||||
| 259 | } | ||||
| 260 | } | ||||
| 261 | |||||
| 262 | 1 | 21µs | 1; | ||
| 263 | |||||
| 264 | # ---------------------------------------------------------------------- | ||||
| 265 | |||||
| 266 | =pod | ||||
| 267 | |||||
| 268 | =head1 NAME | ||||
| 269 | |||||
| 270 | SQL::Translator::Utils - SQL::Translator Utility functions | ||||
| 271 | |||||
| 272 | =head1 SYNOPSIS | ||||
| 273 | |||||
| 274 | use SQL::Translator::Utils qw(debug); | ||||
| 275 | debug("PKG: Bad things happened"); | ||||
| 276 | |||||
| 277 | =head1 DESCSIPTION | ||||
| 278 | |||||
| 279 | C<SQL::Translator::Utils> contains utility functions designed to be | ||||
| 280 | used from the other modules within the C<SQL::Translator> modules. | ||||
| 281 | |||||
| 282 | Nothing is exported by default. | ||||
| 283 | |||||
| 284 | =head1 EXPORTED FUNCTIONS AND CONSTANTS | ||||
| 285 | |||||
| 286 | =head2 debug | ||||
| 287 | |||||
| 288 | C<debug> takes 0 or more messages, which will be sent to STDERR using | ||||
| 289 | C<warn>. Occurances of the strings I<PKG>, I<SUB>, and I<LINE> | ||||
| 290 | will be replaced by the calling package, subroutine, and line number, | ||||
| 291 | respectively, as reported by C<caller(1)>. | ||||
| 292 | |||||
| 293 | For example, from within C<foo> in F<SQL/Translator.pm>, at line 666: | ||||
| 294 | |||||
| 295 | debug("PKG: Error reading file at SUB/LINE"); | ||||
| 296 | |||||
| 297 | Will warn | ||||
| 298 | |||||
| 299 | [SQL::Translator: Error reading file at foo/666] | ||||
| 300 | |||||
| 301 | The entire message is enclosed within C<[> and C<]> for visual clarity | ||||
| 302 | when STDERR is intermixed with STDOUT. | ||||
| 303 | |||||
| 304 | =head2 normalize_name | ||||
| 305 | |||||
| 306 | C<normalize_name> takes a string and ensures that it is suitable for | ||||
| 307 | use as an identifier. This means: ensure that it starts with a letter | ||||
| 308 | or underscore, and that the rest of the string consists of only | ||||
| 309 | letters, numbers, and underscores. A string that begins with | ||||
| 310 | something other than [a-zA-Z] will be prefixer with an underscore, and | ||||
| 311 | all other characters in the string will be replaced with underscores. | ||||
| 312 | Finally, a trailing underscore will be removed, because that's ugly. | ||||
| 313 | |||||
| 314 | normalize_name("Hello, world"); | ||||
| 315 | |||||
| 316 | Produces: | ||||
| 317 | |||||
| 318 | Hello_world | ||||
| 319 | |||||
| 320 | A more useful example, from the C<SQL::Translator::Parser::Excel> test | ||||
| 321 | suite: | ||||
| 322 | |||||
| 323 | normalize_name("silly field (with random characters)"); | ||||
| 324 | |||||
| 325 | returns: | ||||
| 326 | |||||
| 327 | silly_field_with_random_characters | ||||
| 328 | |||||
| 329 | =head2 header_comment | ||||
| 330 | |||||
| 331 | Create the header comment. Takes 1 mandatory argument (the producer | ||||
| 332 | classname), an optional comment character (defaults to $DEFAULT_COMMENT), | ||||
| 333 | and 0 or more additional comments, which will be appended to the header, | ||||
| 334 | prefixed with the comment character. If additional comments are provided, | ||||
| 335 | then a comment string must be provided ($DEFAULT_COMMENT is exported for | ||||
| 336 | this use). For example, this: | ||||
| 337 | |||||
| 338 | package My::Producer; | ||||
| 339 | |||||
| 340 | use SQL::Translator::Utils qw(header_comment $DEFAULT_COMMENT); | ||||
| 341 | |||||
| 342 | print header_comment(__PACKAGE__, | ||||
| 343 | $DEFAULT_COMMENT, | ||||
| 344 | "Hi mom!"); | ||||
| 345 | |||||
| 346 | produces: | ||||
| 347 | |||||
| 348 | -- | ||||
| 349 | -- Created by My::Prodcuer | ||||
| 350 | -- Created on Fri Apr 25 06:56:02 2003 | ||||
| 351 | -- | ||||
| 352 | -- Hi mom! | ||||
| 353 | -- | ||||
| 354 | |||||
| 355 | Note the gratuitous spacing. | ||||
| 356 | |||||
| 357 | =head2 parse_list_arg | ||||
| 358 | |||||
| 359 | Takes a string, list or arrayref (all of which could contain | ||||
| 360 | comma-separated values) and returns an array reference of the values. | ||||
| 361 | All of the following will return equivalent values: | ||||
| 362 | |||||
| 363 | parse_list_arg('id'); | ||||
| 364 | parse_list_arg('id', 'name'); | ||||
| 365 | parse_list_arg( 'id, name' ); | ||||
| 366 | parse_list_arg( [ 'id', 'name' ] ); | ||||
| 367 | parse_list_arg( qw[ id name ] ); | ||||
| 368 | |||||
| 369 | =head2 truncate_id_uniquely | ||||
| 370 | |||||
| 371 | Takes a string ($desired_name) and int ($max_symbol_length). Truncates | ||||
| 372 | $desired_name to $max_symbol_length by including part of the hash of | ||||
| 373 | the full name at the end of the truncated name, giving a high | ||||
| 374 | probability that the symbol will be unique. For example, | ||||
| 375 | |||||
| 376 | truncate_id_uniquely( 'a' x 100, 64 ) | ||||
| 377 | truncate_id_uniquely( 'a' x 99 . 'b', 64 ); | ||||
| 378 | truncate_id_uniquely( 'a' x 99, 64 ) | ||||
| 379 | |||||
| 380 | Will give three different results; specifically: | ||||
| 381 | |||||
| 382 | aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa_7f900025 | ||||
| 383 | aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa_6191e39a | ||||
| 384 | aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa_8cd96af2 | ||||
| 385 | |||||
| 386 | =head2 $DEFAULT_COMMENT | ||||
| 387 | |||||
| 388 | This is the default comment string, '-- ' by default. Useful for | ||||
| 389 | C<header_comment>. | ||||
| 390 | |||||
| 391 | =head2 parse_mysql_version | ||||
| 392 | |||||
| 393 | Used by both L<Parser::MySQL|SQL::Translator::Parser::MySQL> and | ||||
| 394 | L<Producer::MySQL|SQL::Translator::Producer::MySQL> in order to provide a | ||||
| 395 | consistent format for both C<< parser_args->{mysql_parser_version} >> and | ||||
| 396 | C<< producer_args->{mysql_version} >> respectively. Takes any of the following | ||||
| 397 | version specifications: | ||||
| 398 | |||||
| 399 | 5.0.3 | ||||
| 400 | 4.1 | ||||
| 401 | 3.23.2 | ||||
| 402 | 5 | ||||
| 403 | 5.001005 (perl style) | ||||
| 404 | 30201 (mysql style) | ||||
| 405 | |||||
| 406 | =head1 AUTHORS | ||||
| 407 | |||||
| 408 | Darren Chamberlain E<lt>darren@cpan.orgE<gt>, | ||||
| 409 | Ken Y. Clark E<lt>kclark@cpan.orgE<gt>. | ||||
| 410 | |||||
| 411 | =cut | ||||
# spent 62µs within SQL::Translator::Utils::CORE:match which was called 8 times, avg 8µs/call:
# 8 times (62µs+0s) by SQL::Translator::Utils::parse_dbms_version at line 237, avg 8µs/call | |||||
# spent 616µs within SQL::Translator::Utils::CORE:subst which was called 420 times, avg 1µs/call:
# 420 times (616µs+0s) by SQL::Translator::Utils::parse_list_arg at line 139, avg 1µs/call |