¿Cómo encontrar el archivo de clase en un sistema de archivos que no distingue entre mayúsculas y minúsculas? - perl

Caso de prueba simple (para la demostración del problema):

mkdir -p ./lib1/Class ./lib2/Class
touch ./lib1/Class/Name.pm ./lib2/Class/NAME.pm

Entonces, tenga:

./lib1/Class/Name.pm
./lib2/Class/NAME.pm

Necesita buscar el archivo correcto en el sistema de archivos que no distingue entre mayúsculas y minúsculas (OS X "s HFS +).

Lo siguiente funciona en un sistema de archivos que distingue entre mayúsculas y minúsculas,

#!/usr/bin/env perl
use 5.014;
use strict;
use warnings;

my @DIRS = qw(./lib1 ./lib2);

for my $class ( qw(Class::Name Class::NAME) ) {
my $file = findClassFile($class);
say $file;
}

sub findClassFile {
my($file) = @_;
$file =~ s|::|/|g;
$file .= ".pm";

for my $dir (@DIRS) {
return "$dir/$file" if( -e "$dir/$file" );
}
return undef;
}

y estampados

./lib1/Class/Name.pm
./lib2/Class/NAME.pm

en OS X, se imprime incorrectamente:

./lib1/Class/Name.pm
./lib1/Class/NAME.pm

¿Cómo encontrar en el sistema de archivos insensible de OSX el nombre de archivo correcto?

PD: Ahora solo me viene a la mente escribir una rutina recursiva con opendir/readdir/chdir y comprobando los nombres de los archivos de los que proceden readdir. No está mal ... ¿Existe alguna forma más fácil?

Respuestas

0 para la respuesta № 1

Mi solución actual es:

#!/usr/bin/env perl
use 5.014;
use strict;
use warnings;

my @DIRS = qw(./lib1 ./lib2 /Users/me/tmp/lib3);

for my $class ( qw(Class::Name Class::NAME CLASS::name Class::Namex) ) {
my $file = findClassFile($class);
say $file // "Not found $class";
}

sub findClassFile {
my($classname) = @_;
my $file = ($classname =~ s|::|/|gr) . ".pm";
for my $dir (@DIRS) {
return "$dir/$file" if( FileExists("$dir/$file") );
}
return undef;
}

sub FileExists {
my($path) = @_;
my $curr = $path =~ m|^/| ? "/" : ".";
for my $part (split "/", $path) {
next unless $part;
opendir(my $dfd, $curr) || return undef;
my @files = grep {/^$part$/} readdir($dfd);
closedir($dfd);
return undef unless( @files );
$curr .= "/$part";
}
return $curr;
}

lo que imprime:

./lib1/Class/Name.pm
./lib2/Class/NAME.pm
/Users/me/tmp/lib3/CLASS/name.pm
Not found Class::Namex

entonces - está funcionando, pero no me gusta ..;)

---