Profile of DBIx/Class/SQLMaker/MySQL.pm

Filename	/usr/share/perl5/DBIx/Class/SQLMaker/MySQL.pm
Statements	Executed 10 statements in 923µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	14µs	22µs	DBIx::Class::SQLMaker::MySQL::::BEGIN@4DBIx::Class::SQLMaker::MySQL::BEGIN@4
1	1	1	13µs	7.43ms	DBIx::Class::SQLMaker::MySQL::::BEGIN@7DBIx::Class::SQLMaker::MySQL::BEGIN@7
1	1	1	8µs	15µs	DBIx::Class::SQLMaker::MySQL::::BEGIN@5DBIx::Class::SQLMaker::MySQL::BEGIN@5
0	0	0	0s	0s	DBIx::Class::SQLMaker::MySQL::__ANON__[:70]
0	0	0	0s	0s	DBIx::Class::SQLMaker::MySQL::_generate_join_clause
0	0	0	0s	0s	DBIx::Class::SQLMaker::MySQL::_lock_select
0	0	0	0s	0s	DBIx::Class::SQLMaker::MySQL::::deleteDBIx::Class::SQLMaker::MySQL::delete
0	0	0	0s	0s	DBIx::Class::SQLMaker::MySQL::::insertDBIx::Class::SQLMaker::MySQL::insert
0	0	0	0s	0s	DBIx::Class::SQLMaker::MySQL::::updateDBIx::Class::SQLMaker::MySQL::update

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package # Hide from PAUSE
2					DBIx::Class::SQLMaker::MySQL;
3
4	2	36µs	2	30µs	# spent 22µs (14+8) within DBIx::Class::SQLMaker::MySQL::BEGIN@4 which was called: # once (14µs+8µs) by Class::C3::Componentised::ensure_class_loaded at line 4 use warnings; # spent 22µs making 1 call to DBIx::Class::SQLMaker::MySQL::BEGIN@4 # spent 8µs making 1 call to warnings::import
5	2	36µs	2	22µs	# spent 15µs (8+7) within DBIx::Class::SQLMaker::MySQL::BEGIN@5 which was called: # once (8µs+7µs) by Class::C3::Componentised::ensure_class_loaded at line 5 use strict; # spent 15µs making 1 call to DBIx::Class::SQLMaker::MySQL::BEGIN@5 # spent 7µs making 1 call to strict::import
6
7	2	841µs	2	14.8ms	# spent 7.43ms (13µs+7.41) within DBIx::Class::SQLMaker::MySQL::BEGIN@7 which was called: # once (13µs+7.41ms) by Class::C3::Componentised::ensure_class_loaded at line 7 use base qw( DBIx::Class::SQLMaker ); # spent 7.43ms making 1 call to DBIx::Class::SQLMaker::MySQL::BEGIN@7 # spent 7.41ms making 1 call to base::import
8
9					#
10					# MySQL does not understand the standard INSERT INTO $table DEFAULT VALUES
11					# Adjust SQL here instead
12					#
13					sub insert {
14					my $self = shift;
15
16					if (! $_[1] or (ref $_[1] eq 'HASH' and !keys %{$_[1]} ) ) {
17					my $table = $self->_quote($_[0]);
18					return "INSERT INTO ${table} () VALUES ()"
19					}
20
21					return $self->next::method (@_);
22					}
23
24					# Allow STRAIGHT_JOIN's
25					sub _generate_join_clause {
26					my ($self, $join_type) = @_;
27
28					if( $join_type && $join_type =~ /^STRAIGHT\z/i ) {
29					return ' STRAIGHT_JOIN '
30					}
31
32					return $self->next::method($join_type);
33					}
34
35	1	300ns			my $force_double_subq;
36					$force_double_subq = sub {
37					my ($self, $sql) = @_;
38
39					require Text::Balanced;
40					my $new_sql;
41					while (1) {
42
43					my ($prefix, $parenthesized);
44
45					($parenthesized, $sql, $prefix) = do {
46					# idiotic design - writes to $@ but DOES NOT throw exceptions
47					local $@;
48					Text::Balanced::extract_bracketed( $sql, '()', qr/[^\(]*/ );
49					};
50
51					# this is how an error is indicated, in addition to crapping in $@
52					last unless $parenthesized;
53
54					if ($parenthesized =~ $self->{_modification_target_referenced_re}) {
55					# is this a select subquery?
56					if ( $parenthesized =~ /^ \( \s* SELECT \s+ /xi ) {
57					$parenthesized = "( SELECT * FROM $parenthesized `_forced_double_subquery` )";
58					}
59					# then drill down until we find it (if at all)
60					else {
61					$parenthesized =~ s/^ $ (.+) $ $/$1/x;
62					$parenthesized = join ' ', '(', $self->$force_double_subq( $parenthesized ), ')';
63					}
64					}
65
66					$new_sql .= $prefix . $parenthesized;
67					}
68
69					return $new_sql . $sql;
70	1	3µs			};
71
72					sub update {
73					my $self = shift;
74
75					# short-circuit unless understood identifier
76					return $self->next::method(@_) unless $self->{_modification_target_referenced_re};
77
78					my ($sql, @bind) = $self->next::method(@_);
79
80					$sql = $self->$force_double_subq($sql)
81					if $sql =~ $self->{_modification_target_referenced_re};
82
83					return ($sql, @bind);
84					}
85
86					sub delete {
87					my $self = shift;
88
89					# short-circuit unless understood identifier
90					return $self->next::method(@_) unless $self->{_modification_target_referenced_re};
91
92					my ($sql, @bind) = $self->next::method(@_);
93
94					$sql = $self->$force_double_subq($sql)
95					if $sql =~ $self->{_modification_target_referenced_re};
96
97					return ($sql, @bind);
98					}
99
100					# LOCK IN SHARE MODE
101	1	2µs			my $for_syntax = {
102					update => 'FOR UPDATE',
103					shared => 'LOCK IN SHARE MODE'
104					};
105
106					sub _lock_select {
107					my ($self, $type) = @_;
108
109					my $sql = $for_syntax->{$type}
110					\|\| $self->throw_exception("Unknown SELECT .. FOR type '$type' requested");
111
112					return " $sql";
113					}
114
115	1	4µs			1;