line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::Class::Storage::DBI::MariaDB; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
706469
|
use strict; |
|
3
|
|
|
|
|
26
|
|
|
3
|
|
|
|
|
94
|
|
4
|
3
|
|
|
3
|
|
17
|
use warnings; |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
135
|
|
5
|
|
|
|
|
|
|
|
6
|
3
|
|
|
3
|
|
19
|
use base qw/DBIx::Class::Storage::DBI/; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
2728
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '0.1.0'; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MySQL'); |
11
|
|
|
|
|
|
|
__PACKAGE__->sql_limit_dialect('LimitXY'); |
12
|
|
|
|
|
|
|
__PACKAGE__->sql_quote_char('`'); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
__PACKAGE__->_use_multicolumn_in(1); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub with_deferred_fk_checks { |
17
|
0
|
|
|
0
|
1
|
|
my ( $self, $sub ) = @_; |
18
|
|
|
|
|
|
|
|
19
|
0
|
|
|
|
|
|
$self->_do_query('SET FOREIGN_KEY_CHECKS = 0'); |
20
|
0
|
|
|
|
|
|
$sub->(); |
21
|
0
|
|
|
|
|
|
$self->_do_query('SET FOREIGN_KEY_CHECKS = 1'); |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub connect_call_set_strict_mode { |
25
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# the @@sql_mode puts back what was previously set on the session handle |
28
|
0
|
|
|
|
|
|
$self->_do_query( |
29
|
|
|
|
|
|
|
q|SET SQL_MODE = CONCAT('ANSI,TRADITIONAL,ONLY_FULL_GROUP_BY,', @@sql_mode)| |
30
|
|
|
|
|
|
|
); |
31
|
0
|
|
|
|
|
|
$self->_do_query(q|SET SQL_AUTO_IS_NULL = 0|); |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub _dbh_last_insert_id { |
35
|
0
|
|
|
0
|
|
|
my ( $self, $dbh, $source, $col ) = @_; |
36
|
0
|
|
|
|
|
|
$dbh->{mariadb_insertid}; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub _prep_for_execute { |
40
|
0
|
|
|
0
|
|
|
my $self = shift; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# Only update and delete need special double-subquery treatment |
43
|
|
|
|
|
|
|
# Insert referencing the same table (i.e. SELECT MAX(id) + 1) seems |
44
|
|
|
|
|
|
|
# to work just fine on MariaDB |
45
|
0
|
0
|
0
|
|
|
|
return $self->next::method(@_) |
46
|
|
|
|
|
|
|
if ( $_[0] eq 'select' or $_[0] eq 'insert' ); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# FIXME FIXME FIXME - this is a terrible, gross, incomplete, MariaDB-specific |
49
|
|
|
|
|
|
|
# hack but it works rather well for the limited amount of actual use cases |
50
|
|
|
|
|
|
|
# which can not be done in any other way on MariaDB. This allows us to fix |
51
|
|
|
|
|
|
|
# some bugs without breaking MariaDB support in the process and is also |
52
|
|
|
|
|
|
|
# crucial for more complex things like Shadow to be usable |
53
|
|
|
|
|
|
|
# |
54
|
|
|
|
|
|
|
# This code is just a pre-analyzer, working in tandem with ::SQLMaker::MySQL, |
55
|
|
|
|
|
|
|
# where the possibly-set value of {_modification_target_referenced_re} is |
56
|
|
|
|
|
|
|
# used to demarcate which part of the final SQL to double-wrap in a subquery. |
57
|
|
|
|
|
|
|
# |
58
|
|
|
|
|
|
|
# This is covered extensively by "offline" tests, so that competing SQLMaker |
59
|
|
|
|
|
|
|
# implementations could benefit from the existing tests just as well. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# extract the source name, construct modification indicator re |
62
|
0
|
|
|
|
|
|
my $sm = $self->sql_maker; |
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
|
my $target_name = $_[1]->from; |
65
|
|
|
|
|
|
|
|
66
|
0
|
0
|
|
|
|
|
if ( ref $target_name ) { |
67
|
0
|
0
|
0
|
|
|
|
if ( |
68
|
|
|
|
|
|
|
ref $target_name eq 'SCALAR' |
69
|
|
|
|
|
|
|
and $$target_name =~ /^ (?: |
70
|
|
|
|
|
|
|
\` ( [^`]+ ) \` #` |
71
|
|
|
|
|
|
|
| ( [\w\-]+ ) |
72
|
|
|
|
|
|
|
) $/x |
73
|
|
|
|
|
|
|
) |
74
|
|
|
|
|
|
|
{ |
75
|
|
|
|
|
|
|
# this is just a plain-ish name, which has been literal-ed for |
76
|
|
|
|
|
|
|
# whatever reason |
77
|
0
|
0
|
|
|
|
|
$target_name = ( defined $1 ) ? $1 : $2; |
78
|
|
|
|
|
|
|
} else { |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# this is something very complex, perhaps a custom result source or whatnot |
81
|
|
|
|
|
|
|
# can't deal with it |
82
|
0
|
|
|
|
|
|
undef $target_name; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
local $sm->{_modification_target_referenced_re} = |
87
|
0
|
0
|
|
|
|
|
qr/ (?
|
88
|
|
|
|
|
|
|
if $target_name; |
89
|
|
|
|
|
|
|
|
90
|
0
|
|
|
|
|
|
$self->next::method(@_); |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# here may seem like an odd place to override, but this is the first |
94
|
|
|
|
|
|
|
# method called after we are connected *and* the driver is determined |
95
|
|
|
|
|
|
|
# ($self is reblessed). See code flow in ::Storage::DBI::_populate_dbh |
96
|
|
|
|
|
|
|
sub _run_connection_actions { |
97
|
0
|
|
|
0
|
|
|
my $self = shift; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# default mariadb_auto_reconnect to off unless explicitly set |
100
|
0
|
0
|
0
|
|
|
|
if ( $self->_dbh->{mariadb_auto_reconnect} |
101
|
|
|
|
|
|
|
and !exists $self->_dbic_connect_attributes->{mariadb_auto_reconnect} ) |
102
|
|
|
|
|
|
|
{ |
103
|
0
|
|
|
|
|
|
$self->_dbh->{mariadb_auto_reconnect} = 0; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
0
|
|
|
|
|
|
$self->next::method(@_); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# we need to figure out what mysql version we're running |
110
|
|
|
|
|
|
|
sub sql_maker { |
111
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# it is critical to get the version *before* calling next::method |
114
|
|
|
|
|
|
|
# otherwise the potential connect will obliterate the sql_maker |
115
|
|
|
|
|
|
|
# next::method will populate in the _sql_maker accessor |
116
|
0
|
|
|
|
|
|
my $mariadb_ver = $self->_server_info->{normalized_dbms_version}; |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
my $sm = $self->next::method(@_); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# mysql 3 does not understand a bare JOIN |
121
|
0
|
0
|
|
|
|
|
$sm->{_default_jointype} = 'INNER' if $mariadb_ver < 4; |
122
|
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
|
$sm; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub sqlt_type { |
127
|
|
|
|
|
|
|
# used by SQL::Translator |
128
|
0
|
|
|
0
|
1
|
|
return 'MySQL'; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub deployment_statements { |
132
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
133
|
0
|
|
|
|
|
|
my ( $schema, $type, $version, $dir, $sqltargs, @rest ) = @_; |
134
|
|
|
|
|
|
|
|
135
|
0
|
|
0
|
|
|
|
$sqltargs ||= {}; |
136
|
|
|
|
|
|
|
|
137
|
0
|
0
|
0
|
|
|
|
if ( !exists $sqltargs->{producer_args}{mysql_version} |
138
|
|
|
|
|
|
|
and my $dver = $self->_server_info->{normalized_dbms_version} ) |
139
|
|
|
|
|
|
|
{ |
140
|
0
|
|
|
|
|
|
$sqltargs->{producer_args}{mysql_version} = $dver; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
|
$self->next::method( $schema, $type, $version, $dir, $sqltargs, @rest ); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub _exec_svp_begin { |
147
|
0
|
|
|
0
|
|
|
my ( $self, $name ) = @_; |
148
|
|
|
|
|
|
|
|
149
|
0
|
|
|
|
|
|
$self->_dbh->do("SAVEPOINT $name"); |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub _exec_svp_release { |
153
|
0
|
|
|
0
|
|
|
my ( $self, $name ) = @_; |
154
|
|
|
|
|
|
|
|
155
|
0
|
|
|
|
|
|
$self->_dbh->do("RELEASE SAVEPOINT $name"); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub _exec_svp_rollback { |
159
|
0
|
|
|
0
|
|
|
my ( $self, $name ) = @_; |
160
|
|
|
|
|
|
|
|
161
|
0
|
|
|
|
|
|
$self->_dbh->do("ROLLBACK TO SAVEPOINT $name"); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub is_replicating { |
165
|
0
|
|
|
0
|
1
|
|
my $status = shift->_get_dbh->selectrow_hashref('show slave status'); |
166
|
|
|
|
|
|
|
return ( $status->{Slave_IO_Running} eq 'Yes' ) |
167
|
0
|
|
0
|
|
|
|
&& ( $status->{Slave_SQL_Running} eq 'Yes' ); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub lag_behind_master { |
171
|
|
|
|
|
|
|
return |
172
|
|
|
|
|
|
|
shift->_get_dbh->selectrow_hashref('show slave status') |
173
|
0
|
|
|
0
|
1
|
|
->{Seconds_Behind_Master}; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
1; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 NAME |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
DBIx::Class::Storage::DBI::MariaDB - Storage::DBI class implementing MariaDB specifics |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head1 DESCRIPTION |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
This module adds support for MariaDB in the DBIx::Class ORM. It supports |
185
|
|
|
|
|
|
|
exactly the same parameters as the L |
186
|
|
|
|
|
|
|
module, so check that for further documentation. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head1 USAGE |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Similar to other storage modules that are builtin to DBIx::Class, all you need |
191
|
|
|
|
|
|
|
to do is ensure DBIx::Class::Storage::DBI::MariaDB is loaded and specify |
192
|
|
|
|
|
|
|
MariaDB in the DSN. For example: |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
package MyApp::Schema; |
195
|
|
|
|
|
|
|
use base 'DBIx::Class::Schema'; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# register classes |
198
|
|
|
|
|
|
|
# ... |
199
|
|
|
|
|
|
|
# load mariadb storage |
200
|
|
|
|
|
|
|
__PACKAGE__->ensure_class_loaded('DBIx::Class::Storage::DBI::MariaDB'); |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
package MyApp; |
203
|
|
|
|
|
|
|
use MyApp::Schema; |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
my $dsn = "dbi:MariaDB:database=mydb"; |
206
|
|
|
|
|
|
|
my $user = "noone"; |
207
|
|
|
|
|
|
|
my $pass = "topsecret"; |
208
|
|
|
|
|
|
|
my $schema = MyApp::Schema->connect($dsn, $user, $pass); |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
Copyright (C) 2023 Siemplexus |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
215
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=head1 AUTHORS |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
Antonis Kalou Ea.kalou@shadowcat.co.ukE |
220
|
|
|
|
|
|
|
Jess Robinson Ej.robinson@shadowcat.co.ukE |