git.shiar.nl
/
perl
/
list-index.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
TODO: non-alphabetic (.) support
[perl/list-index.git]
/
lib
/
List
/
Index.pm
diff --git
a/lib/List/Index.pm
b/lib/List/Index.pm
index 3663c2459422638225058204dbc9854f667f315f..dca0d1f3970b83ffad665fc385ea2ed00b8bd778 100644
(file)
--- a/
lib/List/Index.pm
+++ b/
lib/List/Index.pm
@@
-78,6
+78,7
@@
sub rangematch {
my ($link) = @_;
my ($s1, $s2) = $link =~ /([^-]*) - ([^-]*)/x
or return qr/^\Q$link/i;
my ($link) = @_;
my ($s1, $s2) = $link =~ /([^-]*) - ([^-]*)/x
or return qr/^\Q$link/i;
+ $s1 =~ s/\.$//;
my @allow;
if (length $s1) {
my @allow;
if (length $s1) {
@@
-88,9
+89,12
@@
sub rangematch {
my $prefix = '';
my $char;
for my $i (0 .. length($s1) - 1) {
my $prefix = '';
my $char;
for my $i (0 .. length($s1) - 1) {
+ my $lasti = $i == length($s1) - 1;
$char = substr $s1, $i, 1;
my $next = $char;
$char = substr $s1, $i, 1;
my $next = $char;
- $next = chr( ord($char) + 1 ) if length $s1 > $i + 1;
+ # do not include prefix character in final range
+ $next = chr( ord($char) + 1 ) unless $lasti;
+
my $last = 'z';
next if $next gt $last;
if (length $s2 > $i) {
my $last = 'z';
next if $next gt $last;
if (length $s2 > $i) {
@@
-101,10
+105,23
@@
sub rangematch {
next if $next gt $last;
}
}
next if $next gt $last;
}
}
+
+ if ($char eq '.') {
+ if ($last eq 'z') {
+# push @allow, $prefix if $i and $lasti;
+# next;
+ }
+# if ($last eq 'z') {
+# push @allow, $prefix if $i and $lasti;
+# next;
+# }
+ $next = 'a';
+ }
+
push @allow, $prefix."[$next-$last]";
}
continue {
push @allow, $prefix."[$next-$last]";
}
continue {
- $prefix .= $char;
+ $prefix .= $char
eq '.' ? '[^a-z]' : $char
;
}
}
}
}
@@
-120,11
+137,16
@@
sub rangematch {
next if $c1 le $char;
}
}
next if $c1 le $char;
}
}
- push @allow, $prefix."(?![$char-$last])"
+
+ if ($char eq '.') {
+ next if $i < length($s2) - 1;
+ }
+
+ push @allow, $prefix.'(?!['.($char eq '.' ? 'a' : $char)."-$last])"
if $i or $s1 eq '';
}
continue {
if $i or $s1 eq '';
}
continue {
- $prefix .= $char;
+ $prefix .= $char
eq '.' ? '[^a-z]' : $char
;
}
push @allow, $prefix
}
push @allow, $prefix