# -- # Copyright (C) 2001-2019 OTRS AG, https://otrs.com/ # -- # This software comes with ABSOLUTELY NO WARRANTY. For details, see # the enclosed file COPYING for license information (GPL). If you # did not receive this file, see https://www.gnu.org/licenses/gpl-3.0.txt. # -- package Kernel::System::DB; ## nofilter(TidyAll::Plugin::OTRS::Perl::Pod::FunctionPod) use strict; use warnings; use DBI; use List::Util(); use Kernel::System::VariableCheck qw(:all); our @ObjectDependencies = ( 'Kernel::Config', 'Kernel::System::Encode', 'Kernel::System::Log', 'Kernel::System::Main', 'Kernel::System::DateTime', 'Kernel::System::Storable', ); our $UseSlaveDB = 0; =head1 NAME Kernel::System::DB - global database interface =head1 DESCRIPTION All database functions to connect/insert/update/delete/... to a database. =head1 PUBLIC INTERFACE =head2 new() create database object, with database connect.. Usually you do not use it directly, instead use: use Kernel::System::ObjectManager; local $Kernel::OM = Kernel::System::ObjectManager->new( 'Kernel::System::DB' => { # if you don't supply the following parameters, the ones found in # Kernel/Config.pm are used instead: DatabaseDSN => 'DBI:odbc:database=123;host=localhost;', DatabaseUser => 'user', DatabasePw => 'somepass', Type => 'mysql', Attribute => { LongTruncOk => 1, LongReadLen => 100*1024, }, }, ); my $DBObject = $Kernel::OM->Get('Kernel::System::DB'); =cut sub new { my ( $Type, %Param ) = @_; # allocate new hash for object my $Self = {}; bless( $Self, $Type ); # 0=off; 1=updates; 2=+selects; 3=+Connects; $Self->{Debug} = $Param{Debug} || 0; my $ConfigObject = $Kernel::OM->Get('Kernel::Config'); # Get config data in following order of significance: # 1 - Parameters passed to constructor # 2 - Test database configuration # 3 - Main database configuration $Self->{DSN} = $Param{DatabaseDSN} || $ConfigObject->Get('TestDatabaseDSN') || $ConfigObject->Get('DatabaseDSN'); $Self->{USER} = $Param{DatabaseUser} || $ConfigObject->Get('TestDatabaseUser') || $ConfigObject->Get('DatabaseUser'); $Self->{PW} = $Param{DatabasePw} || $ConfigObject->Get('TestDatabasePw') || $ConfigObject->Get('DatabasePw'); $Self->{IsSlaveDB} = $Param{IsSlaveDB}; $Self->{SlowLog} = $Param{'Database::SlowLog'} || $ConfigObject->Get('Database::SlowLog'); # decrypt pw (if needed) if ( $Self->{PW} =~ /^\{(.*)\}$/ ) { $Self->{PW} = $Self->_Decrypt($1); } # get database type (auto detection) if ( $Self->{DSN} =~ /:mysql/i ) { $Self->{'DB::Type'} = 'mysql'; } elsif ( $Self->{DSN} =~ /:pg/i ) { $Self->{'DB::Type'} = 'postgresql'; } elsif ( $Self->{DSN} =~ /:oracle/i ) { $Self->{'DB::Type'} = 'oracle'; } elsif ( $Self->{DSN} =~ /:db2/i ) { $Self->{'DB::Type'} = 'db2'; } elsif ( $Self->{DSN} =~ /(mssql|sybase|sql server)/i ) { $Self->{'DB::Type'} = 'mssql'; } # get database type (config option) if ( $ConfigObject->Get('Database::Type') ) { $Self->{'DB::Type'} = $ConfigObject->Get('Database::Type'); } # get database type (overwrite with params) if ( $Param{Type} ) { $Self->{'DB::Type'} = $Param{Type}; } # load backend module if ( $Self->{'DB::Type'} ) { my $GenericModule = 'Kernel::System::DB::' . $Self->{'DB::Type'}; return if !$Kernel::OM->Get('Kernel::System::Main')->Require($GenericModule); $Self->{Backend} = $GenericModule->new( %{$Self} ); # set database functions $Self->{Backend}->LoadPreferences(); } else { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'Error', Message => 'Unknown database type! Set option Database::Type in ' . 'Kernel/Config.pm to (mysql|postgresql|oracle|db2|mssql).', ); return; } # check/get extra database configuration options # (overwrite auto-detection with config options) for my $Setting ( qw( Type Limit DirectBlob Attribute QuoteSingle QuoteBack Connect Encode CaseSensitive LcaseLikeInLargeText ) ) { if ( defined $Param{$Setting} || defined $ConfigObject->Get("Database::$Setting") ) { $Self->{Backend}->{"DB::$Setting"} = $Param{$Setting} // $ConfigObject->Get("Database::$Setting"); } } return $Self; } =head2 Connect() to connect to a database $DBObject->Connect(); =cut sub Connect { my $Self = shift; # check database handle if ( $Self->{dbh} ) { my $PingTimeout = 10; # Only ping every 10 seconds (see bug#12383). my $CurrentTime = time(); ## no critic if ( $CurrentTime - ( $Self->{LastPingTime} // 0 ) < $PingTimeout ) { return $Self->{dbh}; } # Ping to see if the connection is still alive. if ( $Self->{dbh}->ping() ) { $Self->{LastPingTime} = $CurrentTime; return $Self->{dbh}; } # Ping failed: cause a reconnect. delete $Self->{dbh}; } # debug if ( $Self->{Debug} > 2 ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'debug', Message => "DB.pm->Connect: DSN: $Self->{DSN}, User: $Self->{USER}, Pw: $Self->{PW}, DB Type: $Self->{'DB::Type'};", ); } # db connect $Self->{dbh} = DBI->connect( $Self->{DSN}, $Self->{USER}, $Self->{PW}, $Self->{Backend}->{'DB::Attribute'}, ); if ( !$Self->{dbh} ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'Error', Message => $DBI::errstr, ); return; } if ( $Self->{Backend}->{'DB::Connect'} ) { $Self->Do( SQL => $Self->{Backend}->{'DB::Connect'} ); } # set utf-8 on for PostgreSQL if ( $Self->{Backend}->{'DB::Type'} eq 'postgresql' ) { $Self->{dbh}->{pg_enable_utf8} = 1; } if ( $Self->{SlaveDBObject} ) { $Self->{SlaveDBObject}->Connect(); } return $Self->{dbh}; } =head2 Disconnect() to disconnect from a database $DBObject->Disconnect(); =cut sub Disconnect { my $Self = shift; # debug if ( $Self->{Debug} > 2 ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'debug', Message => 'DB.pm->Disconnect', ); } # do disconnect if ( $Self->{dbh} ) { $Self->{dbh}->disconnect(); delete $Self->{dbh}; } if ( $Self->{SlaveDBObject} ) { $Self->{SlaveDBObject}->Disconnect(); } return 1; } =head2 Version() to get the database version my $DBVersion = $DBObject->Version(); returns: "MySQL 5.1.1"; =cut sub Version { my ( $Self, %Param ) = @_; my $Version = 'unknown'; if ( $Self->{Backend}->{'DB::Version'} ) { $Self->Prepare( SQL => $Self->{Backend}->{'DB::Version'} ); while ( my @Row = $Self->FetchrowArray() ) { $Version = $Row[0]; } } return $Version; } =head2 Quote() to quote sql parameters quote strings, date and time: ============================= my $DBString = $DBObject->Quote( "This isn't a problem!" ); my $DBString = $DBObject->Quote( "2005-10-27 20:15:01" ); quote integers: =============== my $DBString = $DBObject->Quote( 1234, 'Integer' ); quote numbers (e. g. 1, 1.4, 42342.23424): ========================================== my $DBString = $DBObject->Quote( 1234, 'Number' ); =cut sub Quote { my ( $Self, $Text, $Type ) = @_; # return undef if undef return if !defined $Text; # quote strings if ( !defined $Type ) { return ${ $Self->{Backend}->Quote( \$Text ) }; } # quote integers if ( $Type eq 'Integer' ) { if ( $Text !~ m{\A [+-]? \d{1,16} \z}xms ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'error', Message => "Invalid integer in query '$Text'!", ); return; } return $Text; } # quote numbers if ( $Type eq 'Number' ) { if ( $Text !~ m{ \A [+-]? \d{1,20} (?:\.\d{1,20})? \z}xms ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'error', Message => "Invalid number in query '$Text'!", ); return; } return $Text; } # quote like strings if ( $Type eq 'Like' ) { return ${ $Self->{Backend}->Quote( \$Text, $Type ) }; } $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'error', Message => "Invalid quote type '$Type'!", ); return; } =head2 Error() to retrieve database errors my $ErrorMessage = $DBObject->Error(); =cut sub Error { my $Self = shift; return $DBI::errstr; } =head2 Do() to insert, update or delete values $DBObject->Do( SQL => "INSERT INTO table (name) VALUES ('dog')" ); $DBObject->Do( SQL => "DELETE FROM table" ); you also can use DBI bind values (used for large strings): my $Var1 = 'dog1'; my $Var2 = 'dog2'; $DBObject->Do( SQL => "INSERT INTO table (name1, name2) VALUES (?, ?)", Bind => [ \$Var1, \$Var2 ], ); =cut sub Do { my ( $Self, %Param ) = @_; # check needed stuff if ( !$Param{SQL} ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'error', Message => 'Need SQL!', ); return; } if ( $Self->{Backend}->{'DB::PreProcessSQL'} ) { $Self->{Backend}->PreProcessSQL( \$Param{SQL} ); } # check bind params my @Array; if ( $Param{Bind} ) { for my $Data ( @{ $Param{Bind} } ) { if ( ref $Data eq 'SCALAR' ) { push @Array, $$Data; } else { $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'Error', Message => 'No SCALAR param in Bind!', ); return; } } if ( @Array && $Self->{Backend}->{'DB::PreProcessBindData'} ) { $Self->{Backend}->PreProcessBindData( \@Array ); } } # Replace current_timestamp with real time stamp. # - This avoids time inconsistencies of app and db server # - This avoids timestamp problems in Postgresql servers where # the timestamp is sometimes 1 second off the perl timestamp. $Param{SQL} =~ s{ (?<= \s | \( | , ) # lookahead current_timestamp # replace current_timestamp by 'yyyy-mm-dd hh:mm:ss' (?= \s | \) | , ) # lookbehind } { # Only calculate timestamp if it is really needed (on first invocation or if the system time changed) # for performance reasons. my $Epoch = time; if (!$Self->{TimestampEpoch} || $Self->{TimestampEpoch} != $Epoch) { $Self->{TimestampEpoch} = $Epoch; $Self->{Timestamp} = $Kernel::OM->Create('Kernel::System::DateTime')->ToString(); } "'$Self->{Timestamp}'"; }exmsg; # debug if ( $Self->{Debug} > 0 ) { $Self->{DoCounter}++; $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'debug', Message => "DB.pm->Do ($Self->{DoCounter}) SQL: '$Param{SQL}'", ); } return if !$Self->Connect(); # send sql to database if ( !$Self->{dbh}->do( $Param{SQL}, undef, @Array ) ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'error', Message => "$DBI::errstr, SQL: '$Param{SQL}'", ); return; } return 1; } sub _InitSlaveDB { my ( $Self, %Param ) = @_; # Run only once! return $Self->{SlaveDBObject} if $Self->{_InitSlaveDB}++; my $ConfigObject = $Kernel::OM->Get('Kernel::Config'); my $MasterDSN = $ConfigObject->Get('DatabaseDSN'); # Don't create slave if we are already in a slave, or if we are not in the master, # such as in an external customer user database handle. if ( $Self->{IsSlaveDB} || $MasterDSN ne $Self->{DSN} ) { return $Self->{SlaveDBObject}; } my %SlaveConfiguration = ( %{ $ConfigObject->Get('Core::MirrorDB::AdditionalMirrors') // {} }, 0 => { DSN => $ConfigObject->Get('Core::MirrorDB::DSN'), User => $ConfigObject->Get('Core::MirrorDB::User'), Password => $ConfigObject->Get('Core::MirrorDB::Password'), } ); return $Self->{SlaveDBObject} if !%SlaveConfiguration; SLAVE_INDEX: for my $SlaveIndex ( List::Util::shuffle( keys %SlaveConfiguration ) ) { my %CurrentSlave = %{ $SlaveConfiguration{$SlaveIndex} // {} }; next SLAVE_INDEX if !%CurrentSlave; # If a slave is configured and it is not already used in the current object # and we are actually in the master connection object: then create a slave. if ( $CurrentSlave{DSN} && $CurrentSlave{User} && $CurrentSlave{Password} ) { my $SlaveDBObject = Kernel::System::DB->new( DatabaseDSN => $CurrentSlave{DSN}, DatabaseUser => $CurrentSlave{User}, DatabasePw => $CurrentSlave{Password}, IsSlaveDB => 1, ); if ( $SlaveDBObject->Connect() ) { $Self->{SlaveDBObject} = $SlaveDBObject; return $Self->{SlaveDBObject}; } } } # no connect was possible. return; } =head2 Prepare() to prepare a SELECT statement $DBObject->Prepare( SQL => "SELECT id, name FROM table", Limit => 10, ); or in case you want just to get row 10 until 30 $DBObject->Prepare( SQL => "SELECT id, name FROM table", Start => 10, Limit => 20, ); in case you don't want utf-8 encoding for some columns, use this: $DBObject->Prepare( SQL => "SELECT id, name, content FROM table", Encode => [ 1, 1, 0 ], ); you also can use DBI bind values, required for large strings: my $Var1 = 'dog1'; my $Var2 = 'dog2'; $DBObject->Prepare( SQL => "SELECT id, name, content FROM table WHERE name_a = ? AND name_b = ?", Encode => [ 1, 1, 0 ], Bind => [ \$Var1, \$Var2 ], ); =cut sub Prepare { my ( $Self, %Param ) = @_; my $SQL = $Param{SQL}; my $Limit = $Param{Limit} || ''; my $Start = $Param{Start} || ''; # check needed stuff if ( !$Param{SQL} ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'error', Message => 'Need SQL!', ); return; } if ( $Param{Bind} && ref $Param{Bind} ne 'ARRAY' ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'error', Message => 'Bind must be and array reference!', ); } $Self->{_PreparedOnSlaveDB} = 0; # Route SELECT statements to the DB slave if requested and a slave is configured. if ( $UseSlaveDB && !$Self->{IsSlaveDB} && $Self->_InitSlaveDB() # this is very cheap after the first call (cached) && $SQL =~ m{\A\s*SELECT}xms ) { $Self->{_PreparedOnSlaveDB} = 1; return $Self->{SlaveDBObject}->Prepare(%Param); } if ( defined $Param{Encode} ) { $Self->{Encode} = $Param{Encode}; } else { $Self->{Encode} = undef; } $Self->{Limit} = 0; $Self->{LimitStart} = 0; $Self->{LimitCounter} = 0; # build final select query if ($Limit) { if ($Start) { $Limit = $Limit + $Start; $Self->{LimitStart} = $Start; } if ( $Self->{Backend}->{'DB::Limit'} eq 'limit' ) { $SQL .= " LIMIT $Limit"; } elsif ( $Self->{Backend}->{'DB::Limit'} eq 'top' ) { $SQL =~ s{ \A \s* (SELECT ([ ]DISTINCT|)) }{$1 TOP $Limit}xmsi; } else { $Self->{Limit} = $Limit; } } # debug if ( $Self->{Debug} > 1 ) { $Self->{PrepareCounter}++; $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'debug', Message => "DB.pm->Prepare ($Self->{PrepareCounter}/" . time() . ") SQL: '$SQL'", ); } # slow log feature my $LogTime; if ( $Self->{SlowLog} ) { $LogTime = time(); } if ( $Self->{Backend}->{'DB::PreProcessSQL'} ) { $Self->{Backend}->PreProcessSQL( \$SQL ); } # check bind params my @Array; if ( $Param{Bind} ) { for my $Data ( @{ $Param{Bind} } ) { if ( ref $Data eq 'SCALAR' ) { push @Array, $$Data; } else { $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'Error', Message => 'No SCALAR param in Bind!', ); return; } } if ( @Array && $Self->{Backend}->{'DB::PreProcessBindData'} ) { $Self->{Backend}->PreProcessBindData( \@Array ); } } return if !$Self->Connect(); # do if ( !( $Self->{Cursor} = $Self->{dbh}->prepare($SQL) ) ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'Error', Message => "$DBI::errstr, SQL: '$SQL'", ); return; } if ( !$Self->{Cursor}->execute(@Array) ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'Error', Message => "$DBI::errstr, SQL: '$SQL'", ); return; } # slow log feature if ( $Self->{SlowLog} ) { my $LogTimeTaken = time() - $LogTime; if ( $LogTimeTaken > 4 ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'error', Message => "Slow ($LogTimeTaken s) SQL: '$SQL'", ); } } return 1; } =head2 FetchrowArray() to process the results of a SELECT statement $DBObject->Prepare( SQL => "SELECT id, name FROM table", Limit => 10 ); while (my @Row = $DBObject->FetchrowArray()) { print "$Row[0]:$Row[1]\n"; } =cut sub FetchrowArray { my $Self = shift; if ( $Self->{_PreparedOnSlaveDB} ) { return $Self->{SlaveDBObject}->FetchrowArray(); } # work with cursors if database don't support limit if ( !$Self->{Backend}->{'DB::Limit'} && $Self->{Limit} ) { if ( $Self->{Limit} <= $Self->{LimitCounter} ) { $Self->{Cursor}->finish(); return; } $Self->{LimitCounter}++; } # fetch first not used rows if ( $Self->{LimitStart} ) { for ( 1 .. $Self->{LimitStart} ) { if ( !$Self->{Cursor}->fetchrow_array() ) { $Self->{LimitStart} = 0; return (); } $Self->{LimitCounter}++; } $Self->{LimitStart} = 0; } # return my @Row = $Self->{Cursor}->fetchrow_array(); if ( !$Self->{Backend}->{'DB::Encode'} ) { return @Row; } # get encode object my $EncodeObject = $Kernel::OM->Get('Kernel::System::Encode'); # e. g. set utf-8 flag my $Counter = 0; ELEMENT: for my $Element (@Row) { next ELEMENT if !defined $Element; if ( !defined $Self->{Encode} || ( $Self->{Encode} && $Self->{Encode}->[$Counter] ) ) { $EncodeObject->EncodeInput( \$Element ); } } continue { $Counter++; } return @Row; } =head2 ListTables() list all tables in the OTRS database. my @Tables = $DBObject->ListTables(); On databases like Oracle it could happen that too many tables are listed (all belonging to the current user), if the user also has permissions for other databases. So this list should only be used for verification of the presence of expected OTRS tables. =cut sub ListTables { my $Self = shift; my $SQL = $Self->GetDatabaseFunction('ListTables'); if ( !$SQL ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'Error', Message => "Database driver $Self->{'DB::Type'} does not support ListTables.", ); return; } my $Success = $Self->Prepare( SQL => $SQL, ); return if !$Success; my @Tables; while ( my @Row = $Self->FetchrowArray() ) { push @Tables, lc $Row[0]; } return @Tables; } =head2 GetColumnNames() to retrieve the column names of a database statement $DBObject->Prepare( SQL => "SELECT * FROM table", Limit => 10 ); my @Names = $DBObject->GetColumnNames(); =cut sub GetColumnNames { my $Self = shift; my $ColumnNames = $Kernel::OM->Get('Kernel::System::Encode')->EncodeInput( $Self->{Cursor}->{NAME} ); my @Result; if ( IsArrayRefWithData($ColumnNames) ) { @Result = @{$ColumnNames}; } return @Result; } =head2 SelectAll() returns all available records of a SELECT statement. In essence, this calls Prepare() and FetchrowArray() to get all records. my $ResultAsArrayRef = $DBObject->SelectAll( SQL => "SELECT id, name FROM table", Limit => 10 ); You can pass the same arguments as to the Prepare() method. Returns undef (if query failed), or an array ref (if query was successful): my $ResultAsArrayRef = [ [ 1, 'itemOne' ], [ 2, 'itemTwo' ], [ 3, 'itemThree' ], [ 4, 'itemFour' ], ]; =cut sub SelectAll { my ( $Self, %Param ) = @_; return if !$Self->Prepare(%Param); my @Records; while ( my @Row = $Self->FetchrowArray() ) { push @Records, \@Row; } return \@Records; } =head2 GetDatabaseFunction() to get database functions like - Limit - DirectBlob - QuoteSingle - QuoteBack - QuoteSemicolon - NoLikeInLargeText - CurrentTimestamp - Encode - Comment - ShellCommit - ShellConnect - Connect - LikeEscapeString my $What = $DBObject->GetDatabaseFunction('DirectBlob'); =cut sub GetDatabaseFunction { my ( $Self, $What ) = @_; return $Self->{Backend}->{ 'DB::' . $What }; } =head2 SQLProcessor() generate database-specific sql syntax (e. g. CREATE TABLE ...) my @SQL = $DBObject->SQLProcessor( Database => [ Tag => 'TableCreate', Name => 'table_name', ], [ Tag => 'Column', Name => 'col_name', Type => 'VARCHAR', Size => 150, ], [ Tag => 'Column', Name => 'col_name2', Type => 'INTEGER', ], [ Tag => 'TableEnd', ], ); =cut sub SQLProcessor { my ( $Self, %Param ) = @_; my @SQL; if ( $Param{Database} && ref $Param{Database} eq 'ARRAY' ) { # make a deep copy in order to prevent modyfing the input data # see also Bug#12764 - Database function SQLProcessor() modifies given parameter data # https://bugs.otrs.org/show_bug.cgi?id=12764 my @Database = @{ $Kernel::OM->Get('Kernel::System::Storable')->Clone( Data => $Param{Database}, ) }; my @Table; for my $Tag (@Database) { # create table if ( $Tag->{Tag} eq 'Table' || $Tag->{Tag} eq 'TableCreate' ) { if ( $Tag->{TagType} eq 'Start' ) { $Self->_NameCheck($Tag); } push @Table, $Tag; if ( $Tag->{TagType} eq 'End' ) { push @SQL, $Self->{Backend}->TableCreate(@Table); @Table = (); } } # unique elsif ( $Tag->{Tag} eq 'Unique' || $Tag->{Tag} eq 'UniqueCreate' || $Tag->{Tag} eq 'UniqueDrop' ) { push @Table, $Tag; } elsif ( $Tag->{Tag} eq 'UniqueColumn' ) { push @Table, $Tag; } # index elsif ( $Tag->{Tag} eq 'Index' || $Tag->{Tag} eq 'IndexCreate' || $Tag->{Tag} eq 'IndexDrop' ) { push @Table, $Tag; } elsif ( $Tag->{Tag} eq 'IndexColumn' ) { push @Table, $Tag; } # foreign keys elsif ( $Tag->{Tag} eq 'ForeignKey' || $Tag->{Tag} eq 'ForeignKeyCreate' || $Tag->{Tag} eq 'ForeignKeyDrop' ) { push @Table, $Tag; } elsif ( $Tag->{Tag} eq 'Reference' && $Tag->{TagType} eq 'Start' ) { push @Table, $Tag; } # alter table elsif ( $Tag->{Tag} eq 'TableAlter' ) { push @Table, $Tag; if ( $Tag->{TagType} eq 'End' ) { push @SQL, $Self->{Backend}->TableAlter(@Table); @Table = (); } } # column elsif ( $Tag->{Tag} eq 'Column' && $Tag->{TagType} eq 'Start' ) { # type check $Self->_TypeCheck($Tag); push @Table, $Tag; } elsif ( $Tag->{Tag} eq 'ColumnAdd' && $Tag->{TagType} eq 'Start' ) { # type check $Self->_TypeCheck($Tag); push @Table, $Tag; } elsif ( $Tag->{Tag} eq 'ColumnChange' && $Tag->{TagType} eq 'Start' ) { # type check $Self->_TypeCheck($Tag); push @Table, $Tag; } elsif ( $Tag->{Tag} eq 'ColumnDrop' && $Tag->{TagType} eq 'Start' ) { # type check $Self->_TypeCheck($Tag); push @Table, $Tag; } # drop table elsif ( $Tag->{Tag} eq 'TableDrop' && $Tag->{TagType} eq 'Start' ) { push @Table, $Tag; push @SQL, $Self->{Backend}->TableDrop(@Table); @Table = (); } # insert elsif ( $Tag->{Tag} eq 'Insert' ) { push @Table, $Tag; if ( $Tag->{TagType} eq 'End' ) { push @Table, $Tag; push @SQL, $Self->{Backend}->Insert(@Table); @Table = (); } } elsif ( $Tag->{Tag} eq 'Data' && $Tag->{TagType} eq 'Start' ) { push @Table, $Tag; } } } return @SQL; } =head2 SQLProcessorPost() generate database-specific sql syntax, post data of SQLProcessor(), e. g. foreign keys my @SQL = $DBObject->SQLProcessorPost(); =cut sub SQLProcessorPost { my ( $Self, %Param ) = @_; if ( $Self->{Backend}->{Post} ) { my @Return = @{ $Self->{Backend}->{Post} }; undef $Self->{Backend}->{Post}; return @Return; } return (); } =head2 QueryCondition() generate SQL condition query based on a search expression my $SQL = $DBObject->QueryCondition( Key => 'some_col', Value => '(ABC+DEF)', ); add SearchPrefix and SearchSuffix to search, in this case for "(ABC*+DEF*)" my $SQL = $DBObject->QueryCondition( Key => 'some_col', Value => '(ABC+DEF)', SearchPrefix => '', SearchSuffix => '*' Extended => 1, # use also " " as "&&", e.g. "bob smith" -> "bob&&smith" ); example of a more complex search condition my $SQL = $DBObject->QueryCondition( Key => 'some_col', Value => '((ABC&&DEF)&&!GHI)', ); for a earch condition over more columns my $SQL = $DBObject->QueryCondition( Key => [ 'some_col_a', 'some_col_b' ], Value => '((ABC&&DEF)&&!GHI)', ); Returns the SQL string or "1=0" if the query could not be parsed correctly. my $SQL = $DBObject->QueryCondition( Key => [ 'some_col_a', 'some_col_b' ], Value => '((ABC&&DEF)&&!GHI)', BindMode => 1, ); return the SQL String with ?-values and a array with values references: $BindModeResult = ( 'SQL' => 'WHERE testa LIKE ? AND testb NOT LIKE ? AND testc = ?' 'Values' => ['a', 'b', 'c'], ) Note that the comparisons are usually performed case insensitively. Only C columns with a size less or equal 3998 are supported, as for locator objects the functioning of SQL function C can't be guaranteed. =cut sub QueryCondition { my ( $Self, %Param ) = @_; # check needed stuff for (qw(Key Value)) { if ( !defined $Param{$_} ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'error', Message => "Need $_!" ); return; } } # get like escape string needed for some databases (e.g. oracle) my $LikeEscapeString = $Self->GetDatabaseFunction('LikeEscapeString'); # search prefix/suffix check my $SearchPrefix = $Param{SearchPrefix} || ''; my $SearchSuffix = $Param{SearchSuffix} || ''; my $CaseSensitive = $Param{CaseSensitive} || 0; my $BindMode = $Param{BindMode} || 0; my @BindValues; # remove leading/trailing spaces $Param{Value} =~ s/^\s+//g; $Param{Value} =~ s/\s+$//g; # add base brackets if ( $Param{Value} !~ /^(?_SpecialCharactersGet(); POSITION: for my $Position ( 0 .. $#Array ) { # find word if ($Backslash) { $Word .= $Array[$Position]; $Backslash = 0; next POSITION; } # remember if next token is a part of word elsif ( $Array[$Position] eq '\\' && $Position < $#Array && ( $SpecialCharacters->{ $Array[ $Position + 1 ] } || $Array[ $Position + 1 ] eq '\\' ) ) { $Backslash = 1; next POSITION; } # remember if it's a NOT condition elsif ( $Word eq '' && $Array[$Position] eq '!' ) { $Not = 1; next POSITION; } elsif ( $Array[$Position] eq '&' ) { if ( $Position >= 1 && $Array[ $Position - 1 ] eq '&' ) { next POSITION; } if ( $Position == $#Array || $Array[ $Position + 1 ] ne '&' ) { $Word .= $Array[$Position]; next POSITION; } } elsif ( $Array[$Position] eq '|' ) { if ( $Position >= 1 && $Array[ $Position - 1 ] eq '|' ) { next POSITION; } if ( $Position == $#Array || $Array[ $Position + 1 ] ne '|' ) { $Word .= $Array[$Position]; next POSITION; } } elsif ( !$SpecialCharacters->{ $Array[$Position] } ) { $Word .= $Array[$Position]; next POSITION; } # if word exists, do something with it if ( $Word ne '' ) { # remove escape characters from $Word $Word =~ s{\\}{}smxg; # replace word if it's an "some expression" expression if ( $Expression{$Word} ) { $Word = $Expression{$Word}; } # database quote $Word = $SearchPrefix . $Word . $SearchSuffix; $Word =~ s/\*/%/g; $Word =~ s/%%/%/g; $Word =~ s/%%/%/g; # perform quoting depending on query type (only if not in bind mode) if ( !$BindMode ) { if ( $Word =~ m/%/ ) { $Word = $Self->Quote( $Word, 'Like' ); } else { $Word = $Self->Quote($Word); } } # if it's a NOT LIKE condition if ($Not) { $Not = 0; my $SQLA; for my $Key (@Keys) { if ($SQLA) { $SQLA .= ' AND '; } # check if like is used my $Type = 'NOT LIKE'; if ( $Word !~ m/%/ ) { $Type = '!='; } my $WordSQL = $Word; if ($BindMode) { $WordSQL = "?"; } else { $WordSQL = "'" . $WordSQL . "'"; } # check if database supports LIKE in large text types # the first condition is a little bit opaque # CaseSensitive of the database defines, if the database handles case sensitivity or not # and the parameter $CaseSensitive defines, if the customer database should do case sensitive statements or not. # so if the database dont support case sensitivity or the configuration of the customer database want to do this # then we prevent the LOWER() statements. if ( !$Self->GetDatabaseFunction('CaseSensitive') || $CaseSensitive ) { $SQLA .= "$Key $Type $WordSQL"; } elsif ( $Self->GetDatabaseFunction('LcaseLikeInLargeText') ) { $SQLA .= "LCASE($Key) $Type LCASE($WordSQL)"; } else { $SQLA .= "LOWER($Key) $Type LOWER($WordSQL)"; } if ( $Type eq 'NOT LIKE' ) { $SQLA .= " $LikeEscapeString"; } if ($BindMode) { push @BindValues, $Word; } } $SQL .= '(' . $SQLA . ') '; } # if it's a LIKE condition else { my $SQLA; for my $Key (@Keys) { if ($SQLA) { $SQLA .= ' OR '; } # check if like is used my $Type = 'LIKE'; if ( $Word !~ m/%/ ) { $Type = '='; } my $WordSQL = $Word; if ($BindMode) { $WordSQL = "?"; } else { $WordSQL = "'" . $WordSQL . "'"; } # check if database supports LIKE in large text types # the first condition is a little bit opaque # CaseSensitive of the database defines, if the database handles case sensitivity or not # and the parameter $CaseSensitive defines, if the customer database should do case sensitive statements or not. # so if the database dont support case sensitivity or the configuration of the customer database want to do this # then we prevent the LOWER() statements. if ( !$Self->GetDatabaseFunction('CaseSensitive') || $CaseSensitive ) { $SQLA .= "$Key $Type $WordSQL"; } elsif ( $Self->GetDatabaseFunction('LcaseLikeInLargeText') ) { $SQLA .= "LCASE($Key) $Type LCASE($WordSQL)"; } else { $SQLA .= "LOWER($Key) $Type LOWER($WordSQL)"; } if ( $Type eq 'LIKE' ) { $SQLA .= " $LikeEscapeString"; } if ($BindMode) { push @BindValues, $Word; } } $SQL .= '(' . $SQLA . ') '; } # reset word $Word = ''; } # check AND and OR conditions if ( $Array[ $Position + 1 ] ) { # if it's an AND condition if ( $Array[$Position] eq '&' && $Array[ $Position + 1 ] eq '&' ) { if ( $SQL =~ m/ OR $/ ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'notice', Message => "Invalid condition '$Param{Value}', simultaneous usage both AND and OR conditions!", ); return "1=0"; } elsif ( $SQL !~ m/ AND $/ ) { $SQL .= ' AND '; } } # if it's an OR condition elsif ( $Array[$Position] eq '|' && $Array[ $Position + 1 ] eq '|' ) { if ( $SQL =~ m/ AND $/ ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'notice', Message => "Invalid condition '$Param{Value}', simultaneous usage both AND and OR conditions!", ); return "1=0"; } elsif ( $SQL !~ m/ OR $/ ) { $SQL .= ' OR '; } } } # add ( or ) for query if ( $Array[$Position] eq '(' ) { if ( $SQL ne '' && $SQL !~ /(?: (?:AND|OR) |\(\s*)$/ ) { $SQL .= ' AND '; } $SQL .= $Array[$Position]; # remember for syntax check $Open++; } if ( $Array[$Position] eq ')' ) { $SQL .= $Array[$Position]; if ( $Position < $#Array && ( $Position > $#Array - 1 || $Array[ $Position + 1 ] ne ')' ) && ( $Position > $#Array - 2 || $Array[ $Position + 1 ] ne '&' || $Array[ $Position + 2 ] ne '&' ) && ( $Position > $#Array - 2 || $Array[ $Position + 1 ] ne '|' || $Array[ $Position + 2 ] ne '|' ) ) { $SQL .= ' AND '; } # remember for syntax check $Close++; } } # check syntax if ( $Open != $Close ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'notice', Message => "Invalid condition '$Param{Value}', $Open open and $Close close!", ); if ($BindMode) { return ( 'SQL' => "1=0", 'Values' => [], ); } return "1=0"; } if ($BindMode) { my $BindRefList = [ map { \$_ } @BindValues ]; return ( 'SQL' => $SQL, 'Values' => $BindRefList, ); } return $SQL; } =head2 QueryInCondition() Generate a SQL IN condition query based on the given table key and values. my $SQL = $DBObject->QueryInCondition( Key => 'table.column', Values => [ 1, 2, 3, 4, 5, 6 ], QuoteType => '(undef|Integer|Number)', BindMode => (0|1), Negate => (0|1), ); Returns the SQL string: my $SQL = "ticket_id IN (1, 2, 3, 4, 5, 6)" Return a separated IN condition for more then C values: my $SQL = "( ticket_id IN ( 1, 2, 3, 4, 5, 6 ... ) OR ticket_id IN ( ... ) )" Return the SQL String with ?-values and a array with values references in bind mode: $BindModeResult = ( 'SQL' => 'ticket_id IN (?, ?, ?, ?, ?, ?)', 'Values' => [1, 2, 3, 4, 5, 6], ); or $BindModeResult = ( 'SQL' => '( ticket_id IN (?, ?, ?, ?, ?, ?) OR ticket_id IN ( ?, ... ) )', 'Values' => [1, 2, 3, 4, 5, 6, ... ], ); Returns the SQL string for a negated in condition: my $SQL = "ticket_id NOT IN (1, 2, 3, 4, 5, 6)" or my $SQL = "( ticket_id NOT IN ( 1, 2, 3, 4, 5, 6 ... ) AND ticket_id NOT IN ( ... ) )" =cut sub QueryInCondition { my ( $Self, %Param ) = @_; if ( !$Param{Key} ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'error', Message => "Need Key!", ); return; } if ( !IsArrayRefWithData( $Param{Values} ) ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'error', Message => "Need Values!", ); return; } if ( $Param{QuoteType} && $Param{QuoteType} eq 'Like' ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'error', Message => "QuoteType 'Like' is not allowed for 'IN' conditions!", ); return; } $Param{Negate} //= 0; $Param{BindMode} //= 0; # Set the flag for string because of the other handling in the sql statement with strings. my $IsString; if ( !$Param{QuoteType} ) { $IsString = 1; } my @Values = @{ $Param{Values} }; # Perform quoting depending on given quote type (only if not in bind mode) if ( !$Param{BindMode} ) { # Sort the values to cache the SQL query. if ($IsString) { @Values = sort { $a cmp $b } @Values; } else { @Values = sort { $a <=> $b } @Values; } @Values = map { $Self->Quote( $_, $Param{QuoteType} ) } @Values; # Something went wrong during the quoting, if the count is not equal. return if scalar @Values != scalar @{ $Param{Values} }; } # Set the correct operator and connector (only needed for splitted conditions). my $Operator = 'IN'; my $Connector = 'OR'; if ( $Param{Negate} ) { $Operator = 'NOT IN'; $Connector = 'AND'; } my @SQLStrings; my @BindValues; # Split IN statement with more than the defined 'MaxParamCountForInCondition' elements in more # then one statements combined with OR, because some databases e.g. oracle doesn't support more # than 1000 elements for one IN statement. while ( scalar @Values ) { my @ValuesPart; if ( $Self->GetDatabaseFunction('MaxParamCountForInCondition') ) { @ValuesPart = splice @Values, 0, $Self->GetDatabaseFunction('MaxParamCountForInCondition'); } else { @ValuesPart = splice @Values; } my $ValueString; if ( $Param{BindMode} ) { $ValueString = join ', ', ('?') x scalar @ValuesPart; push @BindValues, @ValuesPart; } elsif ($IsString) { $ValueString = join ', ', map {"'$_'"} @ValuesPart; } else { $ValueString = join ', ', @ValuesPart; } push @SQLStrings, "$Param{Key} $Operator ($ValueString)"; } my $SQL = join " $Connector ", @SQLStrings; if ( scalar @SQLStrings > 1 ) { $SQL = '( ' . $SQL . ' )'; } if ( $Param{BindMode} ) { my $BindRefList = [ map { \$_ } @BindValues ]; return ( 'SQL' => $SQL, 'Values' => $BindRefList, ); } return $SQL; } =head2 QueryStringEscape() escapes special characters within a query string my $QueryStringEscaped = $DBObject->QueryStringEscape( QueryString => 'customer with (brackets) and & and -', ); Result would be a string in which all special characters are escaped. Special characters are those which are returned by _SpecialCharactersGet(). $QueryStringEscaped = 'customer with \(brackets\) and \& and \-'; =cut sub QueryStringEscape { my ( $Self, %Param ) = @_; # check needed stuff for my $Key (qw(QueryString)) { if ( !defined $Param{$Key} ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'error', Message => "Need $Key!" ); return; } } # Merge all special characters into one string, separated by \\ my $SpecialCharacters = '\\' . join '\\', keys %{ $Self->_SpecialCharactersGet() }; # Use above string of special characters as character class # note: already escaped special characters won't be escaped again $Param{QueryString} =~ s{(?Ping( AutoConnect => 0, # default 1 ); =cut sub Ping { my ( $Self, %Param ) = @_; # debug if ( $Self->{Debug} > 2 ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Caller => 1, Priority => 'debug', Message => 'DB.pm->Ping', ); } if ( !defined $Param{AutoConnect} || $Param{AutoConnect} ) { return if !$Self->Connect(); } else { return if !$Self->{dbh}; } return $Self->{dbh}->ping(); } =begin Internal: =cut sub _Decrypt { my ( $Self, $Pw ) = @_; my $Length = length($Pw) * 4; $Pw = pack "h$Length", $1; $Pw = unpack "B$Length", $Pw; $Pw =~ s/1/A/g; $Pw =~ s/0/1/g; $Pw =~ s/A/0/g; $Pw = pack "B$Length", $Pw; return $Pw; } sub _Encrypt { my ( $Self, $Pw ) = @_; my $Length = length($Pw) * 8; chomp $Pw; # get bit code my $T = unpack( "B$Length", $Pw ); # crypt bit code $T =~ s/1/A/g; $T =~ s/0/1/g; $T =~ s/A/0/g; # get ascii code $T = pack( "B$Length", $T ); # get hex code my $H = unpack( "h$Length", $T ); return $H; } sub _TypeCheck { my ( $Self, $Tag ) = @_; if ( $Tag->{Type} && $Tag->{Type} !~ /^(DATE|SMALLINT|BIGINT|INTEGER|DECIMAL|VARCHAR|LONGBLOB)$/i ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'Error', Message => "Unknown data type '$Tag->{Type}'!", ); } return 1; } sub _NameCheck { my ( $Self, $Tag ) = @_; if ( $Tag->{Name} && length $Tag->{Name} > 30 ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'Error', Message => "Table names should not have more the 30 chars ($Tag->{Name})!", ); } return 1; } sub _SpecialCharactersGet { my ( $Self, %Param ) = @_; my %SpecialCharacter = ( '(' => 1, ')' => 1, '&' => 1, '|' => 1, ); return \%SpecialCharacter; } sub DESTROY { my $Self = shift; # cleanup open statement handle if there is any and then disconnect from DB if ( $Self->{Cursor} ) { $Self->{Cursor}->finish(); } $Self->Disconnect(); return 1; } 1; =end Internal: =head1 TERMS AND CONDITIONS This software is part of the OTRS project (L). This software comes with ABSOLUTELY NO WARRANTY. For details, see the enclosed file COPYING for license information (GPL). If you did not receive this file, see L. =cut