| … | |
… | |
| 163 | } |
163 | } |
| 164 | |
164 | |
| 165 | sub _path2match { |
165 | sub _path2match { |
| 166 | my $re = join "|", map "\Q$_", @_; |
166 | my $re = join "|", map "\Q$_", @_; |
| 167 | |
167 | |
| 168 | $re = "(?:$re)\\/"; |
168 | $re = "^(?:$re)\\/"; |
| 169 | $re =~ s%\\[/\\]%[/\\\\]%g; # we support / and \ on all OSes, keep your fingers crossed |
169 | $re =~ s%\\[/\\]%[/\\\\]%g; # we support / and \ on all OSes, keep your fingers crossed |
| 170 | |
170 | |
| 171 | $case_tolerant |
171 | $case_tolerant |
| 172 | ? qr<$re>i |
172 | ? qr<$re>i |
| 173 | : qr<$re> |
173 | : qr<$re> |
| … | |
… | |
| 185 | or die "$path: $!"; |
185 | or die "$path: $!"; |
| 186 | |
186 | |
| 187 | while (<$fh>) { |
187 | while (<$fh>) { |
| 188 | chomp; |
188 | chomp; |
| 189 | s/ .*$//; # newer-style .packlists might contain key=value pairs |
189 | s/ .*$//; # newer-style .packlists might contain key=value pairs |
|
|
190 | |
|
|
191 | s%\\%/%g; # we only do unix-style paths internally |
| 190 | |
192 | |
| 191 | s/$pfxmatch// and exists $lib->{$_} |
193 | s/$pfxmatch// and exists $lib->{$_} |
| 192 | or next; |
194 | or next; |
| 193 | |
195 | |
| 194 | push @packlist, canonpath $_; |
196 | push @packlist, canonpath $_; |
