1# -*- cperl -*- 2# Copyright (C) 2004-2008 MySQL AB 3# Use is subject to license terms 4# 5# This program is free software; you can redistribute it and/or modify 6# it under the terms of the GNU General Public License, version 2.0, 7# as published by the Free Software Foundation. 8# 9# This program is also distributed with certain software (including 10# but not limited to OpenSSL) that is licensed under separate terms, 11# as designated in a particular file or component or in included license 12# documentation. The authors of MySQL hereby grant you an additional 13# permission to link the program and your derivative works with the 14# separately licensed software that they have included with MySQL. 15# 16# This program is distributed in the hope that it will be useful, 17# but WITHOUT ANY WARRANTY; without even the implied warranty of 18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19# GNU General Public License, version 2.0, for more details. 20# 21# You should have received a copy of the GNU General Public License 22# along with this program; if not, write to the Free Software 23# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 24 25# This is a library file used by the Perl version of mysql-test-run, 26# and is part of the translation of the Bourne shell script with the 27# same name. 28 29package mtr_match; 30use strict; 31 32use base qw(Exporter); 33our @EXPORT= qw(mtr_match_prefix 34 mtr_match_extension 35 mtr_match_substring); 36 37# 38# Match a prefix and return what is after the prefix 39# 40sub mtr_match_prefix ($$) { 41 my $string= shift; 42 my $prefix= shift; 43 44 if ( $string =~ /^\Q$prefix\E(.*)$/ ) # strncmp 45 { 46 return $1; 47 } 48 else 49 { 50 return undef; # NULL 51 } 52} 53 54 55# 56# Match extension and return the name without extension 57# 58sub mtr_match_extension ($$) { 59 my $file= shift; 60 my $ext= shift; 61 62 if ( $file =~ /^(.*)\.\Q$ext\E$/ ) # strchr+strcmp or something 63 { 64 return $1; 65 } 66 else 67 { 68 return undef; # NULL 69 } 70} 71 72 73# 74# Match a substring anywere in a string 75# 76sub mtr_match_substring ($$) { 77 my $string= shift; 78 my $substring= shift; 79 80 if ( $string =~ /(.*)\Q$substring\E(.*)$/ ) # strncmp 81 { 82 return $1; 83 } 84 else 85 { 86 return undef; # NULL 87 } 88} 89 90 91sub mtr_match_any_exact ($$) { 92 my $string= shift; 93 my $mlist= shift; 94 95 foreach my $m (@$mlist) 96 { 97 if ( $string eq $m ) 98 { 99 return 1; 100 } 101 } 102 return 0; 103} 104 1051; 106