Master/setuptl/TLPM/reg.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

# This file belongs to TLPM v2.17, TeX Live Package Manager
# Public Domain, P.Jackowski@gust.org.pl

# regexp and mask related functions

$chr_star = '*';
$reg_star = qr/.*?/o;
$chr_qust = '?';
$reg_qust = qr/./o;

sub string2reg # DOSish wildcards to regex
{
      my @str = split('', shift @_);
      return qr/.{0}/ unless(@str); # not qr// since then grep{//} uses last match!! bleee
	my ($reg,$chr);
	foreach $chr (@str)
	{
            if($chr eq $chr_star)
            {
                  $reg .= $reg_star;
            }
            elsif($chr eq $chr_qust)
            {
                  $reg .= $reg_qust;
            }
            else
            {
                  $reg .= quotemeta $chr;
            }
	}
	$reg = qr/$reg/;
	return $reg;
}

sub string2preg
{
      my $reg = shift;
      return qr/.{0}/ if $reg eq '';
	$reg = qr/$reg/;
	return $reg;
}

$reg_method = \&string2reg;

#sub greg
#{
#	my $reg = $reg_method -> (shift);
#	return grep {/$reg/} @_;
#}

1;