61 lines
893 B
Perl
61 lines
893 B
Perl
#! /usr/bin/env perl
|
|
|
|
package Tinyglob;
|
|
|
|
use v5.10.1;
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
use Exporter 'import';
|
|
|
|
our @EXPORT = qw(tinyglob);
|
|
|
|
sub tinyglob
|
|
{
|
|
my $orig = shift;
|
|
my @str = split("", quotemeta($orig));
|
|
my $res = "";
|
|
|
|
my $metaescape = 0;
|
|
|
|
for (my $i = 0; $i <= $#str; $i++)
|
|
{
|
|
if ($str[$i] eq '\\')
|
|
{
|
|
$i += 1;
|
|
if ($str[$i] eq '\\')
|
|
{
|
|
$metaescape = ! $metaescape;
|
|
$res .= $str[$i];
|
|
}
|
|
elsif ($metaescape && ($str[$i] eq '*' || $str[$i] eq '?')) {
|
|
$res .= $str[$i];
|
|
$metaescape = 0;
|
|
}
|
|
elsif ($str[$i] eq '?') {
|
|
$res .= '.';
|
|
}
|
|
elsif ($str[$i] eq '*') {
|
|
$res .= '.*';
|
|
}
|
|
else {
|
|
croak "Invalid number of \\ in '$orig'";
|
|
}
|
|
}
|
|
else {
|
|
$res .= $str[$i];
|
|
}
|
|
}
|
|
|
|
return $res;
|
|
}
|
|
|
|
sub match
|
|
{
|
|
my $glob = tinyglob(shift);
|
|
my $str = shift;
|
|
|
|
return $str =~ /$glob/;
|
|
}
|
|
|
|
1;
|