[Madrid-pm] Selección de módulos dependiendo del S.O.

Joaquin Ferrero explorer en joaquinferrero.com
Lun Nov 28 02:58:11 PST 2016


     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



Más información sobre la lista de distribución Madrid-pm