Buenos días.
En la charla que nos dio dayer, vimos cómo seleccionar un
comportamiento u otro según el S.O. en donde nos encontremos. Incluido
la carga de módulos distintos para Linux/Windows.
Comenté que había visto en CPAN diversas opciones para hacer eso
mismo, sobre todo evitar tener que repetir el código
if ($^O eq 'Win32') {
una y otra vez. La idea es tener una API común, y luego cada
módulo, tendrá su interfaz propia de cada S.O.
He encontrado varios ejemplos, y todos ellos muestran formas muy
distintas de solventar la cuestión. Al final del mensaje pongo un
listado con las líneas interesantes.
Aquí explicaré la solución de Audio::Beep
<https://metacpan.org/release/Audio-Beep>, que me parece el más corto y
claro donde se puede ver esta técnica.
En Beep.pm, dentro de new(), hay una línea que busca por el mejor
reproductor que exista en nuestro sistema:
$h{player} = _best_player();
Dentro de _best_player() vemos cómo cargar el módulo correspondiente a
nuestro S.O.:
|sub| |_best_player {|
|||my| |%os_modules| |= (|
|||linux| |=> [|
|||'Audio::Beep::Linux::beep'||,|
|||'Audio::Beep::Linux::PP'||,|
|||],|
|||MSWin32| |=> [|
|||'Audio::Beep::Win32::API'||,|
|||],|
|||freebsd| |=> [|
|||'Audio::Beep::BSD::beep'||,|
|||],|
|||);|
||
|||for| |my| |$mod| |( @{ ||$os_modules||{$^O} } ) {|
|||if| |(||eval| |"require $mod"||) {|
|||my| |$player| |= ||$mod||->new();|
|||return| |$player| |if| |defined| |$player||;|
|||}|
|||}|
|||return||;|
|}|
Primero carga un hash con todos los módulos de la distribución.
Luego, en el bucle for(), extrae los módulos correspondientes al
S.O. en que se está ejecutando.
Hace un eval "requiere ...", y regresa si la inicialización ha sido
correcta.
Y dentro de los módulos Audio::Beep::Linux::beep,
Audio::Beep::Linux::PP, Audio::Beep::Win32::API y
Audio::Beep::BSD::beep, lo único que hay son tres funciones básicas:
new(), para la inicialización,
play(), para tocar una nota, y
rest(), para hacer una pausa
El programa principal solo tiene que hacer llamadas basadas en esa API:
$self->player->play( _pitch(\%p), _duration(\%p) );
Resto de distribuciones que he encontrado extrayendo las líneas
interesantes:
Net::Routing <https://metacpan.org/release/Net-Routing> - manage route
entries on Operating Systems
BEGIN {
if ($^O eq 'linux') {
return $_routing_module = "Net::Routing::Linux";
}
elsif ($^O eq 'freebsd') {
return $_routing_module = "Net::Routing::FreeBSD";
}
elsif ($^O eq 'netbsd') {
return $_routing_module = "Net::Routing::NetBSD";
}
elsif ($^O eq 'darwin') {
return $_routing_module = "Net::Routing::Darwin";
}
#elsif ($^O eq 'MSWin32') {
# return $_routing_module = "Net::Routing::MSWin32";
#}
#elsif ($^O eq 'openbsd') {
# return $_routing_module = "Net::Routing::OpenBSD";
#}
die("[-] Net::Routing: Operating System not supported: $^O\n");
}
sub new {
my $self = shift->SUPER::new(
path => [ qw(/bin /sbin /usr/bin /usr/sbin /usr/local/bin
/usr/local/sbin) ],
lc_all => 'en_GB.UTF-8',
target => NR_TARGET_ALL(),
family => NR_FAMILY_INET4(),
@_,
);
$self->path([ @{$self->path}, split(':', $ENV{PATH}) ]);
eval("use $_routing_module;");
if ($@) {
chomp($@);
$Error = "unable to load routing module [$_routing_module]: $@";
return;
}
Sys::Ramdisk <https://metacpan.org/release/Sys-Ramdisk> - Create and
nuke RAM disks on various systems
Unix::Uptime <https://metacpan.org/release/Unix-Uptime> - Determine the
current uptime, in seconds, and load averages, across different *NIX
architectures
my $module = $modules{$^O}
or die "Operating system type $^O is currently unsupported";
require "Unix/Uptime/$module.pm";
our @ISA = ("Unix::Uptime::$module");
IO::Async <https://metacpan.org/release/IO-Async> - Asynchronous
event-driven programming
if( eval { require "IO/Async/OS/$^O.pm" } ) {
@ISA = "IO::Async::OS::$^O";
}
System::Info <https://metacpan.org/release/System-Info> - Factory for
system specific information objects
sub new {
my $factory = shift;
$^O =~ m/aix/i and return System::Info::AIX->new;
$^O =~ m/bsd/i and return System::Info::BSD->new;
$^O =~ m/cygwin/i and return System::Info::Cygwin->new;
$^O =~ m/darwin/i and return System::Info::Darwin->new;
$^O =~ m/haiku/ and return System::Info::Haiku->new;
$^O =~ m/hp-?ux/i and return System::Info::HPUX->new;
$^O =~ m/irix/i and return System::Info::Irix->new;
$^O =~ m/linux/i and return System::Info::Linux->new;
$^O =~ m/solaris|sunos|osf/i and return System::Info::Solaris->new;
$^O =~ m/VMS/ and return System::Info::VMS->new;
$^O =~ m/mswin32|windows/i and return System::Info::Windows->new;
return System::Info::Generic->new;
}
App::Slaughter <https://metacpan.org/release/App-Slaughter> - Perl
Automation Tool Helper
Parse::Netstat <https://metacpan.org/release/Parse-Netstat> - Parse the
output of "netstat" command
if ($flavor eq 'linux') {
require Parse::Netstat::linux;
Parse::Netstat::linux::parse_netstat(
output=>$output, tcp=>$tcp, udp=>$udp, unix=>$unix);
} elsif ($flavor eq 'freebsd') {
require Parse::Netstat::freebsd;
Parse::Netstat::freebsd::parse_netstat(
output=>$output, tcp=>$tcp, udp=>$udp, unix=>$unix);
} elsif ($flavor eq 'solaris') {
require Parse::Netstat::solaris;
Parse::Netstat::solaris::parse_netstat(
output=>$output, tcp=>$tcp, udp=>$udp, unix=>$unix);
} elsif ($flavor eq 'win32') {
require Parse::Netstat::win32;
Parse::Netstat::win32::parse_netstat(
output=>$output, tcp=>$tcp, udp=>$udp);
} else {
return [400, "Unknown flavor '$flavor', please see --help"];
}
Sys::Filesystem <https://metacpan.org/release/Sys-Filesystem> - Retrieve
list of filesystems and their properties
[ @query_order = map { __PACKAGE__ . '::' . $_ } ( ucfirst( lc $^O ), $^O =~
m/Win32/i ? 'Win32' : 'Unix', 'Dummy' ) ]
En esta última distribución, se usa Module::Pluggable, para cargar el
módulo como si fuera un "plugin" o complemento de la propia distribución.
Saludos,
--
JF^D
_______________________________________________
Madrid-pm mailing list
[email protected]
http://mail.pm.org/mailman/listinfo/madrid-pm
