| File | /project/perl/lib/Class/DBI/SQL/Transformer.pm |
| Statements Executed | 69 |
| Statement Execution Time | 2.77ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 2 | 1 | 1 | 562µs | 1.55ms | Class::DBI::SQL::Transformer::_do_transformation |
| 2 | 1 | 1 | 170µs | 329µs | Class::DBI::SQL::Transformer::_expand_table |
| 2 | 1 | 1 | 93µs | 93µs | Class::DBI::SQL::Transformer::new |
| 2 | 1 | 1 | 80µs | 1.64ms | Class::DBI::SQL::Transformer::sql |
| 9 | 5 | 2 | 80µs | 80µs | Class::DBI::SQL::Transformer::CORE:subst (opcode) |
| 6 | 2 | 2 | 49µs | 49µs | Class::DBI::SQL::Transformer::CORE:substcont (opcode) |
| 2 | 1 | 1 | 45µs | 45µs | Class::DBI::SQL::Transformer::args |
| 2 | 1 | 2 | 12µs | 12µs | Class::DBI::SQL::Transformer::CORE:match (opcode) |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::SQL::Transformer::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::SQL::Transformer::__ANON__[:94] |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::SQL::Transformer::_expand_join |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Class::DBI::SQL::Transformer; | ||||
| 2 | |||||
| 3 | 3 | 90µs | 1 | 26µs | use strict; # spent 26µs making 1 call to strict::import |
| 4 | 3 | 1.60ms | 1 | 118µs | use warnings; # spent 118µs making 1 call to warnings::import |
| 5 | |||||
| 6 | =head1 NAME | ||||
| 7 | |||||
| 8 | Class::DBI::SQL::Transformer - Transform SQL | ||||
| 9 | |||||
| 10 | =head1 SYNOPSIS | ||||
| 11 | |||||
| 12 | my $trans = $tclass->new($self, $sql, @args); | ||||
| 13 | return $self->SUPER::transform_sql($trans->sql => $trans->args); | ||||
| 14 | |||||
| 15 | =head1 DESCRIPTION | ||||
| 16 | |||||
| 17 | Class::DBI hooks into the transform_sql() method in Ima::DBI to provide | ||||
| 18 | its own SQL extensions. Class::DBI::SQL::Transformer does the heavy | ||||
| 19 | lifting of these transformations. | ||||
| 20 | |||||
| 21 | =head1 CONSTRUCTOR | ||||
| 22 | |||||
| 23 | =head2 new | ||||
| 24 | |||||
| 25 | my $trans = $tclass->new($self, $sql, @args); | ||||
| 26 | |||||
| 27 | Create a new transformer for the SQL and arguments that will be used | ||||
| 28 | with the given object (or class). | ||||
| 29 | |||||
| 30 | =cut | ||||
| 31 | |||||
| 32 | # spent 93µs within Class::DBI::SQL::Transformer::new which was called 2 times, avg 46µs/call:
# 2 times (93µs+0s) by Class::DBI::transform_sql at line 153 of Class/DBI.pm, avg 46µs/call | ||||
| 33 | 4 | 100µs | my ($me, $caller, $sql, @args) = @_; | ||
| 34 | bless { | ||||
| 35 | _caller => $caller, | ||||
| 36 | _sql => $sql, | ||||
| 37 | _args => [@args], | ||||
| 38 | _transformed => 0, | ||||
| 39 | } => $me; | ||||
| 40 | } | ||||
| 41 | |||||
| 42 | =head2 sql / args | ||||
| 43 | |||||
| 44 | my $sql = $trans->sql; | ||||
| 45 | my @args = $trans->args; | ||||
| 46 | |||||
| 47 | The transformed SQL and args. | ||||
| 48 | |||||
| 49 | =cut | ||||
| 50 | |||||
| 51 | # TODO Document what the different transformations are | ||||
| 52 | # and factor out how they're called so that people can pick and mix the | ||||
| 53 | # ones they want and add new ones. | ||||
| 54 | |||||
| 55 | # spent 1.64ms (80µs+1.55) within Class::DBI::SQL::Transformer::sql which was called 2 times, avg 818µs/call:
# 2 times (80µs+1.55ms) by Class::DBI::transform_sql at line 154 of Class/DBI.pm, avg 818µs/call | ||||
| 56 | 6 | 78µs | my $self = shift; | ||
| 57 | $self->_do_transformation if !$self->{_transformed}; # spent 1.55ms making 2 calls to Class::DBI::SQL::Transformer::_do_transformation, avg 778µs/call | ||||
| 58 | return $self->{_transformed_sql}; | ||||
| 59 | } | ||||
| 60 | |||||
| 61 | # spent 45µs within Class::DBI::SQL::Transformer::args which was called 2 times, avg 22µs/call:
# 2 times (45µs+0s) by Class::DBI::transform_sql at line 154 of Class/DBI.pm, avg 22µs/call | ||||
| 62 | 6 | 57µs | my $self = shift; | ||
| 63 | $self->_do_transformation if !$self->{_transformed}; | ||||
| 64 | return @{ $self->{_transformed_args} }; | ||||
| 65 | } | ||||
| 66 | |||||
| 67 | # spent 329µs (170+159) within Class::DBI::SQL::Transformer::_expand_table which was called 2 times, avg 164µs/call:
# 2 times (170µs+159µs) by Class::DBI::SQL::Transformer::_do_transformation at line 114, avg 164µs/call | ||||
| 68 | 14 | 174µs | my $self = shift; | ||
| 69 | my ($class, $alias) = split /=/, shift, 2; | ||||
| 70 | my $caller = $self->{_caller}; | ||||
| 71 | my $table = $class ? $class->table : $caller->table; # spent 159µs making 2 calls to Class::DBI::table, avg 80µs/call | ||||
| 72 | $self->{cmap}{ $alias || $table } = $class || ref $caller || $caller; | ||||
| 73 | ($alias ||= "") &&= " $alias"; | ||||
| 74 | return $table . $alias; | ||||
| 75 | } | ||||
| 76 | |||||
| 77 | sub _expand_join { | ||||
| 78 | my $self = shift; | ||||
| 79 | my $joins = shift; | ||||
| 80 | my @table = split /\s+/, $joins; | ||||
| 81 | |||||
| 82 | my $caller = $self->{_caller}; | ||||
| 83 | my %tojoin = map { $table[$_] => $table[ $_ + 1 ] } 0 .. $#table - 1; | ||||
| 84 | my @sql; | ||||
| 85 | while (my ($t1, $t2) = each %tojoin) { | ||||
| 86 | my ($c1, $c2) = map $self->{cmap}{$_} | ||||
| 87 | || $caller->_croak("Don't understand table '$_' in JOIN"), ($t1, $t2); | ||||
| 88 | |||||
| 89 | my $join_col = sub { | ||||
| 90 | my ($c1, $c2) = @_; | ||||
| 91 | my $meta = $c1->meta_info('has_a'); | ||||
| 92 | my ($col) = grep $meta->{$_}->foreign_class eq $c2, keys %$meta; | ||||
| 93 | $col; | ||||
| 94 | }; | ||||
| 95 | |||||
| 96 | my $col = $join_col->($c1 => $c2) || do { | ||||
| 97 | ($c1, $c2) = ($c2, $c1); | ||||
| 98 | ($t1, $t2) = ($t2, $t1); | ||||
| 99 | $join_col->($c1 => $c2); | ||||
| 100 | }; | ||||
| 101 | |||||
| 102 | $caller->_croak("Don't know how to join $c1 to $c2") unless $col; | ||||
| 103 | push @sql, sprintf " %s.%s = %s.%s ", $t1, $col, $t2, $c2->primary_column; | ||||
| 104 | } | ||||
| 105 | return join " AND ", @sql; | ||||
| 106 | } | ||||
| 107 | |||||
| 108 | # spent 1.55ms (562µs+993µs) within Class::DBI::SQL::Transformer::_do_transformation which was called 2 times, avg 778µs/call:
# 2 times (562µs+993µs) by Class::DBI::SQL::Transformer::sql at line 57, avg 778µs/call | ||||
| 109 | 30 | 614µs | my $me = shift; | ||
| 110 | my $sql = $me->{_sql}; | ||||
| 111 | my @args = @{ $me->{_args} }; | ||||
| 112 | my $caller = $me->{_caller}; | ||||
| 113 | |||||
| 114 | $sql =~ s/__TABLE\(?(.*?)\)?__/$me->_expand_table($1)/eg; # spent 329µs making 2 calls to Class::DBI::SQL::Transformer::_expand_table, avg 164µs/call
# spent 35µs making 4 calls to Class::DBI::SQL::Transformer::CORE:substcont, avg 9µs/call
# spent 32µs making 2 calls to Class::DBI::SQL::Transformer::CORE:subst, avg 16µs/call | ||||
| 115 | $sql =~ s/__JOIN\((.*?)\)__/$me->_expand_join($1)/eg; # spent 12µs making 2 calls to Class::DBI::SQL::Transformer::CORE:subst, avg 6µs/call | ||||
| 116 | 1 | 26µs | 5 | 314µs | $sql =~ s/__ESSENTIAL__/join ", ", $caller->_essential/eg; # spent 287µs making 1 call to Class::DBI::_essential
# spent 14µs making 2 calls to Class::DBI::SQL::Transformer::CORE:substcont, avg 7µs/call
# spent 13µs making 2 calls to Class::DBI::SQL::Transformer::CORE:subst, avg 7µs/call |
| 117 | $sql =~ | ||||
| 118 | s/__ESSENTIAL\((.*?)\)__/join ", ", map "$1.$_", $caller->_essential/eg; # spent 12µs making 2 calls to Class::DBI::SQL::Transformer::CORE:subst, avg 6µs/call | ||||
| 119 | if ($sql =~ /__IDENTIFIER__/) { # spent 12µs making 2 calls to Class::DBI::SQL::Transformer::CORE:match, avg 6µs/call | ||||
| 120 | 1 | 11µs | 1 | 144µs | my $key_sql = join " AND ", map "$_=?", $caller->primary_columns; # spent 144µs making 1 call to Class::DBI::primary_column |
| 121 | $sql =~ s/__IDENTIFIER__/$key_sql/g; # spent 11µs making 1 call to Class::DBI::SQL::Transformer::CORE:subst | ||||
| 122 | } | ||||
| 123 | |||||
| 124 | $me->{_transformed_sql} = $sql; | ||||
| 125 | $me->{_transformed_args} = [@args]; | ||||
| 126 | $me->{_transformed} = 1; | ||||
| 127 | return 1; | ||||
| 128 | } | ||||
| 129 | |||||
| 130 | 1 | 14µs | 1; | ||
| 131 | |||||
# spent 12µs within Class::DBI::SQL::Transformer::CORE:match which was called 2 times, avg 6µs/call:
# 2 times (12µs+0s) by Class::DBI::SQL::Transformer::_do_transformation at line 119 of Class/DBI/SQL/Transformer.pm, avg 6µs/call | |||||
# spent 80µs within Class::DBI::SQL::Transformer::CORE:subst which was called 9 times, avg 9µs/call:
# 2 times (32µs+0s) by Class::DBI::SQL::Transformer::_do_transformation at line 114 of Class/DBI/SQL/Transformer.pm, avg 16µs/call
# 2 times (13µs+0s) by Class::DBI::SQL::Transformer::_do_transformation at line 116 of Class/DBI/SQL/Transformer.pm, avg 7µs/call
# 2 times (12µs+0s) by Class::DBI::SQL::Transformer::_do_transformation at line 118 of Class/DBI/SQL/Transformer.pm, avg 6µs/call
# 2 times (12µs+0s) by Class::DBI::SQL::Transformer::_do_transformation at line 115 of Class/DBI/SQL/Transformer.pm, avg 6µs/call
# once (11µs+0s) by Class::DBI::SQL::Transformer::_do_transformation at line 121 of Class/DBI/SQL/Transformer.pm | |||||
# spent 49µs within Class::DBI::SQL::Transformer::CORE:substcont which was called 6 times, avg 8µs/call:
# 4 times (35µs+0s) by Class::DBI::SQL::Transformer::_do_transformation at line 114 of Class/DBI/SQL/Transformer.pm, avg 9µs/call
# 2 times (14µs+0s) by Class::DBI::SQL::Transformer::_do_transformation at line 116 of Class/DBI/SQL/Transformer.pm, avg 7µs/call |